{-# LANGUAGE UndecidableInstances #-}
module Data.Bytes.Size
(
Size (..),
SSize (..),
SingSize (..),
withSingSize,
ssizeToSize,
Sized (..),
NextSize,
PrevSize,
_B,
_K,
_M,
_G,
_T,
_P,
_E,
_Z,
_Y,
)
where
import Control.Applicative ((<|>))
import Control.DeepSeq (NFData (rnf))
import Data.Bytes.Class.Parser (Parser (parser))
import Data.Hashable (Hashable)
import Data.Kind (Constraint, Type)
import Data.Type.Equality (TestEquality (testEquality), (:~:) (Refl))
import GHC.Generics (Generic)
import GHC.TypeLits (ErrorMessage (Text), TypeError)
import Optics.Core (Prism', prism)
import Text.Megaparsec qualified as MP
import Text.Megaparsec.Char qualified as MPC
type Size :: Type
data Size
=
B
|
K
|
M
|
G
|
T
|
P
|
E
|
Z
|
Y
deriving stock
(
Size
Size -> Size -> Bounded Size
forall a. a -> a -> Bounded a
$cminBound :: Size
minBound :: Size
$cmaxBound :: Size
maxBound :: Size
Bounded,
Int -> Size
Size -> Int
Size -> [Size]
Size -> Size
Size -> Size -> [Size]
Size -> Size -> Size -> [Size]
(Size -> Size)
-> (Size -> Size)
-> (Int -> Size)
-> (Size -> Int)
-> (Size -> [Size])
-> (Size -> Size -> [Size])
-> (Size -> Size -> [Size])
-> (Size -> Size -> Size -> [Size])
-> Enum Size
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Size -> Size
succ :: Size -> Size
$cpred :: Size -> Size
pred :: Size -> Size
$ctoEnum :: Int -> Size
toEnum :: Int -> Size
$cfromEnum :: Size -> Int
fromEnum :: Size -> Int
$cenumFrom :: Size -> [Size]
enumFrom :: Size -> [Size]
$cenumFromThen :: Size -> Size -> [Size]
enumFromThen :: Size -> Size -> [Size]
$cenumFromTo :: Size -> Size -> [Size]
enumFromTo :: Size -> Size -> [Size]
$cenumFromThenTo :: Size -> Size -> Size -> [Size]
enumFromThenTo :: Size -> Size -> Size -> [Size]
Enum,
Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq,
(forall x. Size -> Rep Size x)
-> (forall x. Rep Size x -> Size) -> Generic Size
forall x. Rep Size x -> Size
forall x. Size -> Rep Size x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Size -> Rep Size x
from :: forall x. Size -> Rep Size x
$cto :: forall x. Rep Size x -> Size
to :: forall x. Rep Size x -> Size
Generic,
Eq Size
Eq Size =>
(Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Size -> Size -> Ordering
compare :: Size -> Size -> Ordering
$c< :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
>= :: Size -> Size -> Bool
$cmax :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
min :: Size -> Size -> Size
Ord,
Int -> Size -> [Char] -> [Char]
[Size] -> [Char] -> [Char]
Size -> [Char]
(Int -> Size -> [Char] -> [Char])
-> (Size -> [Char]) -> ([Size] -> [Char] -> [Char]) -> Show Size
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Size -> [Char] -> [Char]
showsPrec :: Int -> Size -> [Char] -> [Char]
$cshow :: Size -> [Char]
show :: Size -> [Char]
$cshowList :: [Size] -> [Char] -> [Char]
showList :: [Size] -> [Char] -> [Char]
Show
)
deriving anyclass
(
Eq Size
Eq Size => (Int -> Size -> Int) -> (Size -> Int) -> Hashable Size
Int -> Size -> Int
Size -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Size -> Int
hashWithSalt :: Int -> Size -> Int
$chash :: Size -> Int
hash :: Size -> Int
Hashable,
Size -> ()
(Size -> ()) -> NFData Size
forall a. (a -> ()) -> NFData a
$crnf :: Size -> ()
rnf :: Size -> ()
NFData
)
_B :: Prism' Size ()
_B :: Prism' Size ()
_B = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
B) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
B = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _B #-}
_K :: Prism' Size ()
_K :: Prism' Size ()
_K = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
K) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
K = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _K #-}
_M :: Prism' Size ()
_M :: Prism' Size ()
_M = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
M) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
M = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _M #-}
_G :: Prism' Size ()
_G :: Prism' Size ()
_G = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
G) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
G = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _G #-}
_T :: Prism' Size ()
_T :: Prism' Size ()
_T = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
T) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
T = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _T #-}
_P :: Prism' Size ()
_P :: Prism' Size ()
_P = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
P) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
P = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _P #-}
_E :: Prism' Size ()
_E :: Prism' Size ()
_E = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
E) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
E = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _E #-}
_Z :: Prism' Size ()
_Z :: Prism' Size ()
_Z = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
Z) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
Z = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _Z #-}
_Y :: Prism' Size ()
_Y :: Prism' Size ()
_Y = (() -> Size) -> (Size -> Either Size ()) -> Prism' Size ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Size -> () -> Size
forall a b. a -> b -> a
const Size
Y) Size -> Either Size ()
f
where
f :: Size -> Either Size ()
f Size
Y = () -> Either Size ()
forall a b. b -> Either a b
Right ()
f Size
x = Size -> Either Size ()
forall a b. a -> Either a b
Left Size
x
{-# INLINE _Y #-}
instance Parser Size where
parser :: Parsec Void Text Size
parser =
[Parsec Void Text Size] -> Parsec Void Text Size
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
MP.choice
[ Parsec Void Text Size
parseB,
Size -> Char -> Tokens Text -> Parsec Void Text Size
forall {s} {f :: * -> *} {e} {b}.
(Token s ~ Char, MonadParsec e s f, FoldCase (Tokens s),
IsString (Tokens s)) =>
b -> Char -> Tokens s -> f b
parseU Size
K Char
'k' Tokens Text
"ilobytes",
Size -> Char -> Tokens Text -> Parsec Void Text Size
forall {s} {f :: * -> *} {e} {b}.
(Token s ~ Char, MonadParsec e s f, FoldCase (Tokens s),
IsString (Tokens s)) =>
b -> Char -> Tokens s -> f b
parseU Size
M Char
'm' Tokens Text
"egabytes",
Size -> Char -> Tokens Text -> Parsec Void Text Size
forall {s} {f :: * -> *} {e} {b}.
(Token s ~ Char, MonadParsec e s f, FoldCase (Tokens s),
IsString (Tokens s)) =>
b -> Char -> Tokens s -> f b
parseU Size
G Char
'g' Tokens Text
"igabytes",
Size -> Char -> Tokens Text -> Parsec Void Text Size
forall {s} {f :: * -> *} {e} {b}.
(Token s ~ Char, MonadParsec e s f, FoldCase (Tokens s),
IsString (Tokens s)) =>
b -> Char -> Tokens s -> f b
parseU Size
T Char
't' Tokens Text
"erabytes",
Size -> Char -> Tokens Text -> Parsec Void Text Size
forall {s} {f :: * -> *} {e} {b}.
(Token s ~ Char, MonadParsec e s f, FoldCase (Tokens s),
IsString (Tokens s)) =>
b -> Char -> Tokens s -> f b
parseU Size
P Char
'p' Tokens Text
"etabytes",
Size -> Char -> Tokens Text -> Parsec Void Text Size
forall {s} {f :: * -> *} {e} {b}.
(Token s ~ Char, MonadParsec e s f, FoldCase (Tokens s),
IsString (Tokens s)) =>
b -> Char -> Tokens s -> f b
parseU Size
E Char
'e' Tokens Text
"xabytes",
Size -> Char -> Tokens Text -> Parsec Void Text Size
forall {s} {f :: * -> *} {e} {b}.
(Token s ~ Char, MonadParsec e s f, FoldCase (Tokens s),
IsString (Tokens s)) =>
b -> Char -> Tokens s -> f b
parseU Size
Z Char
'z' Tokens Text
"ettabytes",
Size -> Char -> Tokens Text -> Parsec Void Text Size
forall {s} {f :: * -> *} {e} {b}.
(Token s ~ Char, MonadParsec e s f, FoldCase (Tokens s),
IsString (Tokens s)) =>
b -> Char -> Tokens s -> f b
parseU Size
Y Char
'y' Tokens Text
"ottabytes"
]
where
parseB :: Parsec Void Text Size
parseB = do
Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MPC.char' Char
Token Text
'b'
Maybe (Tokens Text)
_ <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe (Tokens Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
MPC.string' Tokens Text
"ytes")
pure Size
B
parseU :: b -> Char -> Tokens s -> f b
parseU b
u Char
ushort Tokens s
ulong = do
Char
_ <- Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MPC.char' Char
Token s
ushort
Maybe (Tokens s)
_ <- f (Tokens s) -> f (Maybe (Tokens s))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (f (Tokens s) -> f (Tokens s)
forall a. f a -> f a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
MPC.string' Tokens s
"b") f (Tokens s) -> f (Tokens s) -> f (Tokens s)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
MPC.string' Tokens s
ulong)
pure b
u
{-# INLINEABLE parser #-}
type SSize :: Size -> Type
data SSize (s :: Size) where
SB :: SSize B
SK :: SSize K
SM :: SSize M
SG :: SSize G
ST :: SSize T
SP :: SSize P
SE :: SSize E
SZ :: SSize Z
SY :: SSize Y
instance NFData (SSize s) where
rnf :: SSize s -> ()
rnf SSize s
SB = ()
rnf SSize s
SK = ()
rnf SSize s
SM = ()
rnf SSize s
SG = ()
rnf SSize s
ST = ()
rnf SSize s
SP = ()
rnf SSize s
SE = ()
rnf SSize s
SZ = ()
rnf SSize s
SY = ()
ssizeToSize :: SSize s -> Size
ssizeToSize :: forall (s :: Size). SSize s -> Size
ssizeToSize SSize s
SB = Size
B
ssizeToSize SSize s
SK = Size
K
ssizeToSize SSize s
SM = Size
M
ssizeToSize SSize s
SG = Size
G
ssizeToSize SSize s
ST = Size
T
ssizeToSize SSize s
SP = Size
P
ssizeToSize SSize s
SE = Size
E
ssizeToSize SSize s
SZ = Size
Z
ssizeToSize SSize s
SY = Size
Y
{-# INLINEABLE ssizeToSize #-}
instance TestEquality SSize where
testEquality :: forall (a :: Size) (b :: Size).
SSize a -> SSize b -> Maybe (a :~: b)
testEquality SSize a
x SSize b
y = case (SSize a
x, SSize b
y) of
(SSize a
SB, SSize b
SB) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a
SK, SSize b
SK) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a
SM, SSize b
SM) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a
SG, SSize b
SG) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a
ST, SSize b
ST) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a
SP, SSize b
SP) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a
SE, SSize b
SE) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a
SZ, SSize b
SZ) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a
SY, SSize b
SY) -> (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
(SSize a, SSize b)
_ -> Maybe (a :~: b)
forall a. Maybe a
Nothing
{-# INLINEABLE testEquality #-}
deriving stock instance Show (SSize s)
type SingSize :: Size -> Constraint
class SingSize (s :: Size) where
singSize :: SSize s
instance SingSize B where
singSize :: SSize 'B
singSize = SSize 'B
SB
{-# INLINE singSize #-}
instance SingSize K where
singSize :: SSize 'K
singSize = SSize 'K
SK
{-# INLINE singSize #-}
instance SingSize M where
singSize :: SSize 'M
singSize = SSize 'M
SM
{-# INLINE singSize #-}
instance SingSize G where
singSize :: SSize 'G
singSize = SSize 'G
SG
{-# INLINE singSize #-}
instance SingSize T where
singSize :: SSize 'T
singSize = SSize 'T
ST
{-# INLINE singSize #-}
instance SingSize P where
singSize :: SSize 'P
singSize = SSize 'P
SP
{-# INLINE singSize #-}
instance SingSize E where
singSize :: SSize 'E
singSize = SSize 'E
SE
{-# INLINE singSize #-}
instance SingSize Z where
singSize :: SSize 'Z
singSize = SSize 'Z
SZ
{-# INLINE singSize #-}
instance SingSize Y where
singSize :: SSize 'Y
singSize = SSize 'Y
SY
{-# INLINE singSize #-}
withSingSize :: SSize s -> ((SingSize s) => r) -> r
withSingSize :: forall (s :: Size) r. SSize s -> (SingSize s => r) -> r
withSingSize SSize s
s SingSize s => r
x = case SSize s
s of
SSize s
SB -> r
SingSize s => r
x
SSize s
SK -> r
SingSize s => r
x
SSize s
SM -> r
SingSize s => r
x
SSize s
SG -> r
SingSize s => r
x
SSize s
ST -> r
SingSize s => r
x
SSize s
SP -> r
SingSize s => r
x
SSize s
SE -> r
SingSize s => r
x
SSize s
SZ -> r
SingSize s => r
x
SSize s
SY -> r
SingSize s => r
x
{-# INLINEABLE withSingSize #-}
type NextSize :: Size -> Size
type family NextSize (s :: Size) = (t :: Size) where
NextSize B = K
NextSize K = M
NextSize M = G
NextSize G = T
NextSize T = P
NextSize P = E
NextSize E = Z
NextSize Z = Y
NextSize Y = TypeError ('Text "The byte unit Y does not have a 'next size'.")
type PrevSize :: Size -> Size
type family PrevSize (s :: Size) = (t :: Size) where
PrevSize B = TypeError ('Text "The byte unit B does not have a 'previous size'.")
PrevSize K = B
PrevSize M = K
PrevSize G = M
PrevSize T = G
PrevSize P = T
PrevSize E = P
PrevSize Z = E
PrevSize Y = Z
class Sized a where
type HideSize a
sizeOf :: a -> Size
hideSize :: a -> HideSize a