{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Toml.Codec.Generic
( genericCodec
, genericCodecWithOptions
, stripTypeNameCodec
, TomlOptions (..)
, GenericOptions (..)
, stripTypeNameOptions
, stripTypeNamePrefix
, HasCodec (..)
, HasItemCodec (..)
, GenericCodec (..)
, ByteStringAsText (..)
, ByteStringAsBytes (..)
, LByteStringAsText (..)
, LByteStringAsBytes (..)
, TomlTable (..)
, TomlTableStrip (..)
) where
import Data.ByteString (ByteString)
import Data.Char (isLower, toLower)
import Data.Coerce (coerce)
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.Hashable (Hashable)
import Data.IntMap.Strict (IntMap)
import Data.IntSet (IntSet)
import Data.Kind (Type)
import Data.List (stripPrefix)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.Monoid (All (..), Any (..), First (..), Last (..), Product (..), Sum (..))
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
import Data.Typeable (Typeable, typeRep)
import Data.Word (Word8)
import GHC.Generics (C1, D1, Generic (..), K1 (..), M1 (..), Rec0, S1, Selector (..), (:*:) (..),
(:+:))
import GHC.TypeLits (ErrorMessage (..), TypeError)
import Numeric.Natural (Natural)
import Toml.Codec.BiMap (TomlBiMap)
import Toml.Codec.Di (diwrap, (.=))
import Toml.Codec.Types (TomlCodec)
import Toml.Type.AnyValue (AnyValue)
import Toml.Type.Key (Key)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Lazy as L
import qualified Toml.Codec.BiMap.Conversion as Toml
import qualified Toml.Codec.Combinator as Toml
import qualified Toml.Codec.Di as Toml
genericCodec :: (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec :: forall a. (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec = (a -> Rep a Any)
-> (Rep a Any -> a) -> TomlCodec (Rep a Any) -> TomlCodec a
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (TomlCodec (Rep a Any) -> TomlCodec a)
-> TomlCodec (Rep a Any) -> TomlCodec a
forall a b. (a -> b) -> a -> b
$ GenericOptions -> TomlCodec (Rep a Any)
forall p. GenericOptions -> TomlCodec (Rep a p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec ((String -> String) -> GenericOptions
GenericOptions String -> String
forall a. a -> a
id)
{-# INLINE genericCodec #-}
genericCodecWithOptions
:: forall a
. (Generic a, GenericCodec (Rep a), Typeable a)
=> TomlOptions a
-> TomlCodec a
genericCodecWithOptions :: forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlOptions a -> TomlCodec a
genericCodecWithOptions = (a -> Rep a Any)
-> (Rep a Any -> a) -> TomlCodec (Rep a Any) -> TomlCodec a
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (TomlCodec (Rep a Any) -> TomlCodec a)
-> (TomlOptions a -> TomlCodec (Rep a Any))
-> TomlOptions a
-> TomlCodec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> TomlCodec (Rep a Any)
forall p. GenericOptions -> TomlCodec (Rep a p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec (GenericOptions -> TomlCodec (Rep a Any))
-> (TomlOptions a -> GenericOptions)
-> TomlOptions a
-> TomlCodec (Rep a Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => TomlOptions a -> GenericOptions
forall {k} (a :: k). Typeable a => TomlOptions a -> GenericOptions
toGenericOptions @a
{-# INLINE genericCodecWithOptions #-}
stripTypeNameCodec
:: forall a
. (Generic a, GenericCodec (Rep a), Typeable a)
=> TomlCodec a
stripTypeNameCodec :: forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlCodec a
stripTypeNameCodec = TomlOptions a -> TomlCodec a
forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlOptions a -> TomlCodec a
genericCodecWithOptions (TomlOptions a -> TomlCodec a) -> TomlOptions a -> TomlCodec a
forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => TomlOptions a
forall {k} (a :: k). Typeable a => TomlOptions a
stripTypeNameOptions @a
{-# INLINE stripTypeNameCodec #-}
data TomlOptions a = TomlOptions
{ forall {k} (a :: k).
TomlOptions a -> Typeable a => Proxy a -> String -> String
tomlOptionsFieldModifier :: Typeable a => Proxy a -> String -> String
}
newtype GenericOptions = GenericOptions
{ GenericOptions -> String -> String
genericOptionsFieldModifier :: String -> String
}
toGenericOptions :: forall a . Typeable a => TomlOptions a -> GenericOptions
toGenericOptions :: forall {k} (a :: k). Typeable a => TomlOptions a -> GenericOptions
toGenericOptions TomlOptions{Typeable a => Proxy a -> String -> String
tomlOptionsFieldModifier :: forall {k} (a :: k).
TomlOptions a -> Typeable a => Proxy a -> String -> String
tomlOptionsFieldModifier :: Typeable a => Proxy a -> String -> String
..} = GenericOptions
{ genericOptionsFieldModifier :: String -> String
genericOptionsFieldModifier = Typeable a => Proxy a -> String -> String
Proxy a -> String -> String
tomlOptionsFieldModifier (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
}
stripTypeNameOptions :: Typeable a => TomlOptions a
stripTypeNameOptions :: forall {k} (a :: k). Typeable a => TomlOptions a
stripTypeNameOptions = TomlOptions
{ tomlOptionsFieldModifier :: Typeable a => Proxy a -> String -> String
tomlOptionsFieldModifier = Typeable a => Proxy a -> String -> String
Proxy a -> String -> String
forall {k} (a :: k). Typeable a => Proxy a -> String -> String
stripTypeNamePrefix
}
stripTypeNamePrefix :: forall a . Typeable a => Proxy a -> String -> String
stripTypeNamePrefix :: forall {k} (a :: k). Typeable a => Proxy a -> String -> String
stripTypeNamePrefix Proxy a
_ String
fieldName =
case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (String -> String
headToLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ forall (a :: k). Typeable a => String
forall {k} (a :: k). Typeable a => String
typeName @a) String
fieldName of
Just String
rest -> String -> String
leaveIfEmpty String
rest
Maybe String
Nothing -> String -> String
leaveIfEmpty ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isLower String
fieldName)
where
headToLower :: String -> String
headToLower :: String -> String
headToLower = \case
[] -> String -> String
forall a. HasCallStack => String -> a
error String
"Cannot use 'headToLower' on empty Text"
Char
x:String
xs -> Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
leaveIfEmpty :: String -> String
leaveIfEmpty :: String -> String
leaveIfEmpty String
rest = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest then String
fieldName else String -> String
headToLower String
rest
typeName :: forall a . Typeable a => String
typeName :: forall {k} (a :: k). Typeable a => String
typeName = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
class GenericCodec (f :: k -> Type) where
genericTomlCodec :: GenericOptions -> TomlCodec (f p)
instance GenericCodec f => GenericCodec (D1 d f) where
genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec (D1 d f p)
genericTomlCodec = (D1 d f p -> f p)
-> (f p -> D1 d f p) -> TomlCodec (f p) -> TomlCodec (D1 d f p)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap D1 d f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 f p -> D1 d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (TomlCodec (f p) -> TomlCodec (D1 d f p))
-> (GenericOptions -> TomlCodec (f p))
-> GenericOptions
-> TomlCodec (D1 d f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> TomlCodec (f p)
forall (p :: k). GenericOptions -> TomlCodec (f p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec
{-# INLINE genericTomlCodec #-}
type GenericSumTomlNotSupported =
'Text "Generic TOML deriving for arbitrary sum types is not supported currently."
instance (TypeError GenericSumTomlNotSupported) => GenericCodec (f :+: g) where
genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec ((:+:) f g p)
genericTomlCodec = String -> GenericOptions -> TomlCodec ((:+:) f g p)
forall a. HasCallStack => String -> a
error String
"Not supported"
instance GenericCodec f => GenericCodec (C1 c f) where
genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec (C1 c f p)
genericTomlCodec = (C1 c f p -> f p)
-> (f p -> C1 c f p) -> TomlCodec (f p) -> TomlCodec (C1 c f p)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap C1 c f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 f p -> C1 c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (TomlCodec (f p) -> TomlCodec (C1 c f p))
-> (GenericOptions -> TomlCodec (f p))
-> GenericOptions
-> TomlCodec (C1 c f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> TomlCodec (f p)
forall (p :: k). GenericOptions -> TomlCodec (f p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec
{-# INLINE genericTomlCodec #-}
instance (GenericCodec f, GenericCodec g) => GenericCodec (f :*: g) where
genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec ((:*:) f g p)
genericTomlCodec GenericOptions
options = f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
(f p -> g p -> (:*:) f g p)
-> Codec ((:*:) f g p) (f p)
-> Codec ((:*:) f g p) (g p -> (:*:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericOptions -> TomlCodec (f p)
forall (p :: k). GenericOptions -> TomlCodec (f p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec GenericOptions
options TomlCodec (f p)
-> ((:*:) f g p -> f p) -> Codec ((:*:) f g p) (f p)
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= (:*:) f g p -> f p
forall (p :: k). (:*:) f g p -> f p
fstG
Codec ((:*:) f g p) (g p -> (:*:) f g p)
-> Codec ((:*:) f g p) (g p) -> Codec ((:*:) f g p) ((:*:) f g p)
forall a b.
Codec ((:*:) f g p) (a -> b)
-> Codec ((:*:) f g p) a -> Codec ((:*:) f g p) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenericOptions -> TomlCodec (g p)
forall (p :: k). GenericOptions -> TomlCodec (g p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec GenericOptions
options TomlCodec (g p)
-> ((:*:) f g p -> g p) -> Codec ((:*:) f g p) (g p)
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= (:*:) f g p -> g p
forall (p :: k). (:*:) f g p -> g p
sndG
where
fstG :: (f :*: g) p -> f p
fstG :: forall (p :: k). (:*:) f g p -> f p
fstG (f p
f :*: g p
_) = f p
f
sndG :: (f :*: g) p -> g p
sndG :: forall (p :: k). (:*:) f g p -> g p
sndG (f p
_ :*: g p
g) = g p
g
{-# INLINE genericTomlCodec #-}
instance (Selector s, HasCodec a) => GenericCodec (S1 s (Rec0 a)) where
genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec (S1 s (Rec0 a) p)
genericTomlCodec GenericOptions{String -> String
genericOptionsFieldModifier :: GenericOptions -> String -> String
genericOptionsFieldModifier :: String -> String
..} = TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
forall {k} (p :: k). TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
genericWrap (TomlCodec a -> TomlCodec (S1 s (Rec0 a) p))
-> TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
forall a b. (a -> b) -> a -> b
$ forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a Key
fieldName
where
genericWrap :: TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
genericWrap :: forall {k} (p :: k). TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
genericWrap = (S1 s (Rec0 a) p -> a)
-> (a -> S1 s (Rec0 a) p)
-> TomlCodec a
-> TomlCodec (S1 s (Rec0 a) p)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap (K1 R a p -> a
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R a p -> a)
-> (S1 s (Rec0 a) p -> K1 R a p) -> S1 s (Rec0 a) p -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 s (Rec0 a) p -> K1 R a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1) (K1 R a p -> S1 s (Rec0 a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R a p -> S1 s (Rec0 a) p)
-> (a -> K1 R a p) -> a -> S1 s (Rec0 a) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1)
fieldName :: Key
fieldName :: Key
fieldName =
String -> Key
forall a. IsString a => String -> a
fromString
(String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String -> String
genericOptionsFieldModifier
(String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 S s Proxy () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t s f a -> String
selName (String -> M1 S s Proxy ()
forall a. HasCallStack => String -> a
error String
"S1" :: S1 s Proxy ())
{-# INLINE genericTomlCodec #-}
class HasItemCodec a where
hasItemCodec :: Either (TomlBiMap a AnyValue) (TomlCodec a)
instance HasItemCodec Bool where
hasItemCodec :: Either (TomlBiMap Bool AnyValue) (TomlCodec Bool)
hasItemCodec = TomlBiMap Bool AnyValue
-> Either (TomlBiMap Bool AnyValue) (TomlCodec Bool)
forall a b. a -> Either a b
Left TomlBiMap Bool AnyValue
Toml._Bool
{-# INLINE hasItemCodec #-}
instance HasItemCodec Int where
hasItemCodec :: Either (TomlBiMap Int AnyValue) (TomlCodec Int)
hasItemCodec = TomlBiMap Int AnyValue
-> Either (TomlBiMap Int AnyValue) (TomlCodec Int)
forall a b. a -> Either a b
Left TomlBiMap Int AnyValue
Toml._Int
{-# INLINE hasItemCodec #-}
instance HasItemCodec Word where
hasItemCodec :: Either (TomlBiMap Word AnyValue) (TomlCodec Word)
hasItemCodec = TomlBiMap Word AnyValue
-> Either (TomlBiMap Word AnyValue) (TomlCodec Word)
forall a b. a -> Either a b
Left TomlBiMap Word AnyValue
Toml._Word
{-# INLINE hasItemCodec #-}
instance HasItemCodec Word8 where
hasItemCodec :: Either (TomlBiMap Word8 AnyValue) (TomlCodec Word8)
hasItemCodec = TomlBiMap Word8 AnyValue
-> Either (TomlBiMap Word8 AnyValue) (TomlCodec Word8)
forall a b. a -> Either a b
Left TomlBiMap Word8 AnyValue
Toml._Word8
{-# INLINE hasItemCodec #-}
instance HasItemCodec Integer where
hasItemCodec :: Either (TomlBiMap Integer AnyValue) (TomlCodec Integer)
hasItemCodec = TomlBiMap Integer AnyValue
-> Either (TomlBiMap Integer AnyValue) (TomlCodec Integer)
forall a b. a -> Either a b
Left TomlBiMap Integer AnyValue
Toml._Integer
{-# INLINE hasItemCodec #-}
instance HasItemCodec Natural where
hasItemCodec :: Either (TomlBiMap Natural AnyValue) (TomlCodec Natural)
hasItemCodec = TomlBiMap Natural AnyValue
-> Either (TomlBiMap Natural AnyValue) (TomlCodec Natural)
forall a b. a -> Either a b
Left TomlBiMap Natural AnyValue
Toml._Natural
{-# INLINE hasItemCodec #-}
instance HasItemCodec Double where
hasItemCodec :: Either (TomlBiMap Double AnyValue) (TomlCodec Double)
hasItemCodec = TomlBiMap Double AnyValue
-> Either (TomlBiMap Double AnyValue) (TomlCodec Double)
forall a b. a -> Either a b
Left TomlBiMap Double AnyValue
Toml._Double
{-# INLINE hasItemCodec #-}
instance HasItemCodec Float where
hasItemCodec :: Either (TomlBiMap Float AnyValue) (TomlCodec Float)
hasItemCodec = TomlBiMap Float AnyValue
-> Either (TomlBiMap Float AnyValue) (TomlCodec Float)
forall a b. a -> Either a b
Left TomlBiMap Float AnyValue
Toml._Float
{-# INLINE hasItemCodec #-}
instance HasItemCodec Text where
hasItemCodec :: Either (TomlBiMap Text AnyValue) (TomlCodec Text)
hasItemCodec = TomlBiMap Text AnyValue
-> Either (TomlBiMap Text AnyValue) (TomlCodec Text)
forall a b. a -> Either a b
Left TomlBiMap Text AnyValue
Toml._Text
{-# INLINE hasItemCodec #-}
instance HasItemCodec L.Text where
hasItemCodec :: Either (TomlBiMap Text AnyValue) (TomlCodec Text)
hasItemCodec = TomlBiMap Text AnyValue
-> Either (TomlBiMap Text AnyValue) (TomlCodec Text)
forall a b. a -> Either a b
Left TomlBiMap Text AnyValue
Toml._LText
{-# INLINE hasItemCodec #-}
instance HasItemCodec ByteStringAsText where
hasItemCodec :: Either
(TomlBiMap ByteStringAsText AnyValue) (TomlCodec ByteStringAsText)
hasItemCodec = TomlBiMap ByteStringAsText AnyValue
-> Either
(TomlBiMap ByteStringAsText AnyValue) (TomlCodec ByteStringAsText)
forall a b. a -> Either a b
Left (TomlBiMap ByteStringAsText AnyValue
-> Either
(TomlBiMap ByteStringAsText AnyValue) (TomlCodec ByteStringAsText))
-> TomlBiMap ByteStringAsText AnyValue
-> Either
(TomlBiMap ByteStringAsText AnyValue) (TomlCodec ByteStringAsText)
forall a b. (a -> b) -> a -> b
$ TomlBiMap ByteString AnyValue
-> TomlBiMap ByteStringAsText AnyValue
forall a b. Coercible a b => a -> b
coerce TomlBiMap ByteString AnyValue
Toml._ByteString
{-# INLINE hasItemCodec #-}
instance HasItemCodec ByteStringAsBytes where
hasItemCodec :: Either
(TomlBiMap ByteStringAsBytes AnyValue)
(TomlCodec ByteStringAsBytes)
hasItemCodec = TomlBiMap ByteStringAsBytes AnyValue
-> Either
(TomlBiMap ByteStringAsBytes AnyValue)
(TomlCodec ByteStringAsBytes)
forall a b. a -> Either a b
Left (TomlBiMap ByteStringAsBytes AnyValue
-> Either
(TomlBiMap ByteStringAsBytes AnyValue)
(TomlCodec ByteStringAsBytes))
-> TomlBiMap ByteStringAsBytes AnyValue
-> Either
(TomlBiMap ByteStringAsBytes AnyValue)
(TomlCodec ByteStringAsBytes)
forall a b. (a -> b) -> a -> b
$ TomlBiMap ByteString AnyValue
-> TomlBiMap ByteStringAsBytes AnyValue
forall a b. Coercible a b => a -> b
coerce TomlBiMap ByteString AnyValue
Toml._ByteStringArray
{-# INLINE hasItemCodec #-}
instance HasItemCodec LByteStringAsText where
hasItemCodec :: Either
(TomlBiMap LByteStringAsText AnyValue)
(TomlCodec LByteStringAsText)
hasItemCodec = TomlBiMap LByteStringAsText AnyValue
-> Either
(TomlBiMap LByteStringAsText AnyValue)
(TomlCodec LByteStringAsText)
forall a b. a -> Either a b
Left (TomlBiMap LByteStringAsText AnyValue
-> Either
(TomlBiMap LByteStringAsText AnyValue)
(TomlCodec LByteStringAsText))
-> TomlBiMap LByteStringAsText AnyValue
-> Either
(TomlBiMap LByteStringAsText AnyValue)
(TomlCodec LByteStringAsText)
forall a b. (a -> b) -> a -> b
$ TomlBiMap ByteString AnyValue
-> TomlBiMap LByteStringAsText AnyValue
forall a b. Coercible a b => a -> b
coerce TomlBiMap ByteString AnyValue
Toml._LByteString
{-# INLINE hasItemCodec #-}
instance HasItemCodec LByteStringAsBytes where
hasItemCodec :: Either
(TomlBiMap LByteStringAsBytes AnyValue)
(TomlCodec LByteStringAsBytes)
hasItemCodec = TomlBiMap LByteStringAsBytes AnyValue
-> Either
(TomlBiMap LByteStringAsBytes AnyValue)
(TomlCodec LByteStringAsBytes)
forall a b. a -> Either a b
Left (TomlBiMap LByteStringAsBytes AnyValue
-> Either
(TomlBiMap LByteStringAsBytes AnyValue)
(TomlCodec LByteStringAsBytes))
-> TomlBiMap LByteStringAsBytes AnyValue
-> Either
(TomlBiMap LByteStringAsBytes AnyValue)
(TomlCodec LByteStringAsBytes)
forall a b. (a -> b) -> a -> b
$ TomlBiMap ByteString AnyValue
-> TomlBiMap LByteStringAsBytes AnyValue
forall a b. Coercible a b => a -> b
coerce TomlBiMap ByteString AnyValue
Toml._LByteStringArray
{-# INLINE hasItemCodec #-}
instance HasItemCodec ZonedTime where
hasItemCodec :: Either (TomlBiMap ZonedTime AnyValue) (TomlCodec ZonedTime)
hasItemCodec = TomlBiMap ZonedTime AnyValue
-> Either (TomlBiMap ZonedTime AnyValue) (TomlCodec ZonedTime)
forall a b. a -> Either a b
Left TomlBiMap ZonedTime AnyValue
Toml._ZonedTime
{-# INLINE hasItemCodec #-}
instance HasItemCodec LocalTime where
hasItemCodec :: Either (TomlBiMap LocalTime AnyValue) (TomlCodec LocalTime)
hasItemCodec = TomlBiMap LocalTime AnyValue
-> Either (TomlBiMap LocalTime AnyValue) (TomlCodec LocalTime)
forall a b. a -> Either a b
Left TomlBiMap LocalTime AnyValue
Toml._LocalTime
{-# INLINE hasItemCodec #-}
instance HasItemCodec Day where
hasItemCodec :: Either (TomlBiMap Day AnyValue) (TomlCodec Day)
hasItemCodec = TomlBiMap Day AnyValue
-> Either (TomlBiMap Day AnyValue) (TomlCodec Day)
forall a b. a -> Either a b
Left TomlBiMap Day AnyValue
Toml._Day
{-# INLINE hasItemCodec #-}
instance HasItemCodec TimeOfDay where
hasItemCodec :: Either (TomlBiMap TimeOfDay AnyValue) (TomlCodec TimeOfDay)
hasItemCodec = TomlBiMap TimeOfDay AnyValue
-> Either (TomlBiMap TimeOfDay AnyValue) (TomlCodec TimeOfDay)
forall a b. a -> Either a b
Left TomlBiMap TimeOfDay AnyValue
Toml._TimeOfDay
{-# INLINE hasItemCodec #-}
instance HasItemCodec IntSet where
hasItemCodec :: Either (TomlBiMap IntSet AnyValue) (TomlCodec IntSet)
hasItemCodec = TomlBiMap IntSet AnyValue
-> Either (TomlBiMap IntSet AnyValue) (TomlCodec IntSet)
forall a b. a -> Either a b
Left TomlBiMap IntSet AnyValue
Toml._IntSet
{-# INLINE hasItemCodec #-}
instance (HasItemCodec a, Typeable a) => HasItemCodec [a] where
hasItemCodec :: Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
hasItemCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
Left TomlBiMap a AnyValue
prim -> TomlBiMap [a] AnyValue
-> Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
forall a b. a -> Either a b
Left (TomlBiMap [a] AnyValue
-> Either (TomlBiMap [a] AnyValue) (TomlCodec [a]))
-> TomlBiMap [a] AnyValue
-> Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
forall a b. (a -> b) -> a -> b
$ TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
Toml._Array TomlBiMap a AnyValue
prim
Right TomlCodec a
codec -> TomlCodec [a] -> Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
forall a b. b -> Either a b
Right (TomlCodec [a] -> Either (TomlBiMap [a] AnyValue) (TomlCodec [a]))
-> TomlCodec [a] -> Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> Key -> TomlCodec [a]
forall a. TomlCodec a -> Key -> TomlCodec [a]
Toml.list TomlCodec a
codec (String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => String
forall {k} (a :: k). Typeable a => String
typeName @a)
{-# INLINE hasItemCodec #-}
class HasCodec a where
hasCodec :: Key -> TomlCodec a
instance HasCodec Bool where
hasCodec :: Key -> TomlCodec Bool
hasCodec = Key -> TomlCodec Bool
Toml.bool
{-# INLINE hasCodec #-}
instance HasCodec Int where
hasCodec :: Key -> TomlCodec Int
hasCodec = Key -> TomlCodec Int
Toml.int
{-# INLINE hasCodec #-}
instance HasCodec Word where
hasCodec :: Key -> TomlCodec Word
hasCodec = Key -> TomlCodec Word
Toml.word
{-# INLINE hasCodec #-}
instance HasCodec Word8 where
hasCodec :: Key -> TomlCodec Word8
hasCodec = Key -> TomlCodec Word8
Toml.word8
{-# INLINE hasCodec #-}
instance HasCodec Integer where
hasCodec :: Key -> TomlCodec Integer
hasCodec = Key -> TomlCodec Integer
Toml.integer
{-# INLINE hasCodec #-}
instance HasCodec Natural where
hasCodec :: Key -> TomlCodec Natural
hasCodec = Key -> TomlCodec Natural
Toml.natural
{-# INLINE hasCodec #-}
instance HasCodec Double where
hasCodec :: Key -> TomlCodec Double
hasCodec = Key -> TomlCodec Double
Toml.double
{-# INLINE hasCodec #-}
instance HasCodec Float where
hasCodec :: Key -> TomlCodec Float
hasCodec = Key -> TomlCodec Float
Toml.float
{-# INLINE hasCodec #-}
instance HasCodec Text where
hasCodec :: Key -> TomlCodec Text
hasCodec = Key -> TomlCodec Text
Toml.text
{-# INLINE hasCodec #-}
instance HasCodec L.Text where
hasCodec :: Key -> TomlCodec Text
hasCodec = Key -> TomlCodec Text
Toml.lazyText
{-# INLINE hasCodec #-}
instance HasCodec ByteStringAsText where
hasCodec :: Key -> TomlCodec ByteStringAsText
hasCodec = TomlCodec ByteString -> TomlCodec ByteStringAsText
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
diwrap (TomlCodec ByteString -> TomlCodec ByteStringAsText)
-> (Key -> TomlCodec ByteString)
-> Key
-> TomlCodec ByteStringAsText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec ByteString
Toml.byteString
{-# INLINE hasCodec #-}
instance HasCodec ByteStringAsBytes where
hasCodec :: Key -> TomlCodec ByteStringAsBytes
hasCodec = TomlCodec ByteString -> TomlCodec ByteStringAsBytes
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
diwrap (TomlCodec ByteString -> TomlCodec ByteStringAsBytes)
-> (Key -> TomlCodec ByteString)
-> Key
-> TomlCodec ByteStringAsBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec ByteString
Toml.byteStringArray
{-# INLINE hasCodec #-}
instance HasCodec LByteStringAsText where
hasCodec :: Key -> TomlCodec LByteStringAsText
hasCodec = TomlCodec ByteString -> TomlCodec LByteStringAsText
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
diwrap (TomlCodec ByteString -> TomlCodec LByteStringAsText)
-> (Key -> TomlCodec ByteString)
-> Key
-> TomlCodec LByteStringAsText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec ByteString
Toml.lazyByteString
{-# INLINE hasCodec #-}
instance HasCodec LByteStringAsBytes where
hasCodec :: Key -> TomlCodec LByteStringAsBytes
hasCodec = TomlCodec ByteString -> TomlCodec LByteStringAsBytes
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
diwrap (TomlCodec ByteString -> TomlCodec LByteStringAsBytes)
-> (Key -> TomlCodec ByteString)
-> Key
-> TomlCodec LByteStringAsBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec ByteString
Toml.lazyByteStringArray
{-# INLINE hasCodec #-}
instance HasCodec ZonedTime where
hasCodec :: Key -> TomlCodec ZonedTime
hasCodec = Key -> TomlCodec ZonedTime
Toml.zonedTime
{-# INLINE hasCodec #-}
instance HasCodec LocalTime where
hasCodec :: Key -> TomlCodec LocalTime
hasCodec = Key -> TomlCodec LocalTime
Toml.localTime
{-# INLINE hasCodec #-}
instance HasCodec Day where
hasCodec :: Key -> TomlCodec Day
hasCodec = Key -> TomlCodec Day
Toml.day
{-# INLINE hasCodec #-}
instance HasCodec TimeOfDay where
hasCodec :: Key -> TomlCodec TimeOfDay
hasCodec = Key -> TomlCodec TimeOfDay
Toml.timeOfDay
{-# INLINE hasCodec #-}
instance HasCodec IntSet where
hasCodec :: Key -> TomlCodec IntSet
hasCodec = Key -> TomlCodec IntSet
Toml.arrayIntSet
{-# INLINE hasCodec #-}
instance HasCodec a => HasCodec (Maybe a) where
hasCodec :: Key -> TomlCodec (Maybe a)
hasCodec = TomlCodec a -> TomlCodec (Maybe a)
forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional (TomlCodec a -> TomlCodec (Maybe a))
-> (Key -> TomlCodec a) -> Key -> TomlCodec (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a
{-# INLINE hasCodec #-}
instance HasItemCodec a => HasCodec [a] where
hasCodec :: Key -> TomlCodec [a]
hasCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
Left TomlBiMap a AnyValue
prim -> TomlBiMap a AnyValue -> Key -> TomlCodec [a]
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec [a]
Toml.arrayOf TomlBiMap a AnyValue
prim
Right TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec [a]
forall a. TomlCodec a -> Key -> TomlCodec [a]
Toml.list TomlCodec a
codec
{-# INLINE hasCodec #-}
instance HasItemCodec a => HasCodec (NonEmpty a) where
hasCodec :: Key -> TomlCodec (NonEmpty a)
hasCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
Left TomlBiMap a AnyValue
prim -> TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a)
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a)
Toml.arrayNonEmptyOf TomlBiMap a AnyValue
prim
Right TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec (NonEmpty a)
forall a. TomlCodec a -> Key -> TomlCodec (NonEmpty a)
Toml.nonEmpty TomlCodec a
codec
{-# INLINE hasCodec #-}
instance (Ord a, HasItemCodec a) => HasCodec (Set a) where
hasCodec :: Key -> TomlCodec (Set a)
hasCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
Left TomlBiMap a AnyValue
prim -> TomlBiMap a AnyValue -> Key -> TomlCodec (Set a)
forall a. Ord a => TomlBiMap a AnyValue -> Key -> TomlCodec (Set a)
Toml.arraySetOf TomlBiMap a AnyValue
prim
Right TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec (Set a)
forall a. Ord a => TomlCodec a -> Key -> TomlCodec (Set a)
Toml.set TomlCodec a
codec
{-# INLINE hasCodec #-}
#if MIN_VERSION_hashable(1,4,0)
instance (Hashable a, HasItemCodec a)
#else
instance (Hashable a, Eq a, HasItemCodec a)
#endif
=> HasCodec (HashSet a) where
hasCodec :: Key -> TomlCodec (HashSet a)
hasCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
Left TomlBiMap a AnyValue
prim -> TomlBiMap a AnyValue -> Key -> TomlCodec (HashSet a)
forall a.
Hashable a =>
TomlBiMap a AnyValue -> Key -> TomlCodec (HashSet a)
Toml.arrayHashSetOf TomlBiMap a AnyValue
prim
Right TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec (HashSet a)
forall a. Hashable a => TomlCodec a -> Key -> TomlCodec (HashSet a)
Toml.hashSet TomlCodec a
codec
{-# INLINE hasCodec #-}
instance (Ord k, HasCodec k, HasCodec v) => HasCodec (Map k v) where
hasCodec :: Key -> TomlCodec (Map k v)
hasCodec = TomlCodec k -> TomlCodec v -> Key -> TomlCodec (Map k v)
forall k v.
Ord k =>
TomlCodec k -> TomlCodec v -> Key -> TomlCodec (Map k v)
Toml.map (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @k Key
"key") (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @v Key
"val")
{-# INLINE hasCodec #-}
#if MIN_VERSION_hashable(1,4,0)
instance (Hashable k, HasCodec k, HasCodec v)
#else
instance (Hashable k, Eq k, HasCodec k, HasCodec v)
#endif
=> HasCodec (HashMap k v) where
hasCodec :: Key -> TomlCodec (HashMap k v)
hasCodec = TomlCodec k -> TomlCodec v -> Key -> TomlCodec (HashMap k v)
forall k v.
Hashable k =>
TomlCodec k -> TomlCodec v -> Key -> TomlCodec (HashMap k v)
Toml.hashMap (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @k Key
"key") (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @v Key
"val")
{-# INLINE hasCodec #-}
instance (HasCodec v) => HasCodec (IntMap v) where
hasCodec :: Key -> TomlCodec (IntMap v)
hasCodec = TomlCodec Int -> TomlCodec v -> Key -> TomlCodec (IntMap v)
forall v.
TomlCodec Int -> TomlCodec v -> Key -> TomlCodec (IntMap v)
Toml.intMap (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @Int Key
"key") (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @v Key
"val")
{-# INLINE hasCodec #-}
instance HasCodec All where
hasCodec :: Key -> TomlCodec All
hasCodec = Key -> TomlCodec All
Toml.all
{-# INLINE hasCodec #-}
instance HasCodec Any where
hasCodec :: Key -> TomlCodec Any
hasCodec = Key -> TomlCodec Any
Toml.any
{-# INLINE hasCodec #-}
instance (Num a, HasCodec a) => HasCodec (Sum a) where
hasCodec :: Key -> TomlCodec (Sum a)
hasCodec = (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)
forall a. Num a => (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)
Toml.sum (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a)
{-# INLINE hasCodec #-}
instance (Num a, HasCodec a) => HasCodec (Product a) where
hasCodec :: Key -> TomlCodec (Product a)
hasCodec = (Key -> TomlCodec a) -> Key -> TomlCodec (Product a)
forall a.
Num a =>
(Key -> TomlCodec a) -> Key -> TomlCodec (Product a)
Toml.product (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a)
{-# INLINE hasCodec #-}
instance HasCodec a => HasCodec (First a) where
hasCodec :: Key -> TomlCodec (First a)
hasCodec = (Key -> TomlCodec a) -> Key -> TomlCodec (First a)
forall a. (Key -> TomlCodec a) -> Key -> TomlCodec (First a)
Toml.first (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a)
{-# INLINE hasCodec #-}
instance HasCodec a => HasCodec (Last a) where
hasCodec :: Key -> TomlCodec (Last a)
hasCodec = (Key -> TomlCodec a) -> Key -> TomlCodec (Last a)
forall a. (Key -> TomlCodec a) -> Key -> TomlCodec (Last a)
Toml.last (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a)
{-# INLINE hasCodec #-}
newtype TomlTable a = TomlTable
{ forall a. TomlTable a -> a
unTomlTable :: a
}
instance (Generic a, GenericCodec (Rep a)) => HasCodec (TomlTable a) where
hasCodec :: Key -> TomlCodec (TomlTable a)
hasCodec :: Key -> TomlCodec (TomlTable a)
hasCodec = TomlCodec a -> TomlCodec (TomlTable a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec a -> TomlCodec (TomlTable a))
-> (Key -> TomlCodec a) -> Key -> TomlCodec (TomlTable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> Key -> TomlCodec a
forall a. TomlCodec a -> Key -> TomlCodec a
Toml.table (forall a. (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec @a)
{-# INLINE hasCodec #-}
instance (Generic a, GenericCodec (Rep a)) => HasItemCodec (TomlTable a) where
hasItemCodec :: Either (TomlBiMap (TomlTable a) AnyValue) (TomlCodec (TomlTable a))
hasItemCodec = TomlCodec (TomlTable a)
-> Either
(TomlBiMap (TomlTable a) AnyValue) (TomlCodec (TomlTable a))
forall a b. b -> Either a b
Right (TomlCodec (TomlTable a)
-> Either
(TomlBiMap (TomlTable a) AnyValue) (TomlCodec (TomlTable a)))
-> TomlCodec (TomlTable a)
-> Either
(TomlBiMap (TomlTable a) AnyValue) (TomlCodec (TomlTable a))
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> TomlCodec (TomlTable a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec a -> TomlCodec (TomlTable a))
-> TomlCodec a -> TomlCodec (TomlTable a)
forall a b. (a -> b) -> a -> b
$ forall a. (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec @a
{-# INLINE hasItemCodec #-}
newtype TomlTableStrip a = TomlTableStrip
{ forall a. TomlTableStrip a -> a
unTomlTableStrip :: a
}
instance (Generic a, GenericCodec (Rep a), Typeable a) => HasCodec (TomlTableStrip a) where
hasCodec :: Key -> TomlCodec (TomlTableStrip a)
hasCodec :: Key -> TomlCodec (TomlTableStrip a)
hasCodec = TomlCodec a -> TomlCodec (TomlTableStrip a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec a -> TomlCodec (TomlTableStrip a))
-> (Key -> TomlCodec a) -> Key -> TomlCodec (TomlTableStrip a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> Key -> TomlCodec a
forall a. TomlCodec a -> Key -> TomlCodec a
Toml.table (forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlCodec a
stripTypeNameCodec @a)
{-# INLINE hasCodec #-}
instance (Generic a, GenericCodec (Rep a), Typeable a) => HasItemCodec (TomlTableStrip a) where
hasItemCodec :: Either
(TomlBiMap (TomlTableStrip a) AnyValue)
(TomlCodec (TomlTableStrip a))
hasItemCodec = TomlCodec (TomlTableStrip a)
-> Either
(TomlBiMap (TomlTableStrip a) AnyValue)
(TomlCodec (TomlTableStrip a))
forall a b. b -> Either a b
Right (TomlCodec (TomlTableStrip a)
-> Either
(TomlBiMap (TomlTableStrip a) AnyValue)
(TomlCodec (TomlTableStrip a)))
-> TomlCodec (TomlTableStrip a)
-> Either
(TomlBiMap (TomlTableStrip a) AnyValue)
(TomlCodec (TomlTableStrip a))
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> TomlCodec (TomlTableStrip a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec a -> TomlCodec (TomlTableStrip a))
-> TomlCodec a -> TomlCodec (TomlTableStrip a)
forall a b. (a -> b) -> a -> b
$ forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlCodec a
stripTypeNameCodec @a
{-# INLINE hasItemCodec #-}
newtype ByteStringAsText = ByteStringAsText
{ ByteStringAsText -> ByteString
unByteStringAsText :: ByteString
} deriving newtype (Int -> ByteStringAsText -> String -> String
[ByteStringAsText] -> String -> String
ByteStringAsText -> String
(Int -> ByteStringAsText -> String -> String)
-> (ByteStringAsText -> String)
-> ([ByteStringAsText] -> String -> String)
-> Show ByteStringAsText
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ByteStringAsText -> String -> String
showsPrec :: Int -> ByteStringAsText -> String -> String
$cshow :: ByteStringAsText -> String
show :: ByteStringAsText -> String
$cshowList :: [ByteStringAsText] -> String -> String
showList :: [ByteStringAsText] -> String -> String
Show, ByteStringAsText -> ByteStringAsText -> Bool
(ByteStringAsText -> ByteStringAsText -> Bool)
-> (ByteStringAsText -> ByteStringAsText -> Bool)
-> Eq ByteStringAsText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByteStringAsText -> ByteStringAsText -> Bool
== :: ByteStringAsText -> ByteStringAsText -> Bool
$c/= :: ByteStringAsText -> ByteStringAsText -> Bool
/= :: ByteStringAsText -> ByteStringAsText -> Bool
Eq)
newtype ByteStringAsBytes = ByteStringAsBytes
{ ByteStringAsBytes -> ByteString
unByteStringAsBytes :: ByteString
} deriving newtype (Int -> ByteStringAsBytes -> String -> String
[ByteStringAsBytes] -> String -> String
ByteStringAsBytes -> String
(Int -> ByteStringAsBytes -> String -> String)
-> (ByteStringAsBytes -> String)
-> ([ByteStringAsBytes] -> String -> String)
-> Show ByteStringAsBytes
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ByteStringAsBytes -> String -> String
showsPrec :: Int -> ByteStringAsBytes -> String -> String
$cshow :: ByteStringAsBytes -> String
show :: ByteStringAsBytes -> String
$cshowList :: [ByteStringAsBytes] -> String -> String
showList :: [ByteStringAsBytes] -> String -> String
Show, ByteStringAsBytes -> ByteStringAsBytes -> Bool
(ByteStringAsBytes -> ByteStringAsBytes -> Bool)
-> (ByteStringAsBytes -> ByteStringAsBytes -> Bool)
-> Eq ByteStringAsBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByteStringAsBytes -> ByteStringAsBytes -> Bool
== :: ByteStringAsBytes -> ByteStringAsBytes -> Bool
$c/= :: ByteStringAsBytes -> ByteStringAsBytes -> Bool
/= :: ByteStringAsBytes -> ByteStringAsBytes -> Bool
Eq)
newtype LByteStringAsText = LByteStringAsText
{ LByteStringAsText -> ByteString
unLByteStringAsText :: LBS.ByteString
} deriving newtype (Int -> LByteStringAsText -> String -> String
[LByteStringAsText] -> String -> String
LByteStringAsText -> String
(Int -> LByteStringAsText -> String -> String)
-> (LByteStringAsText -> String)
-> ([LByteStringAsText] -> String -> String)
-> Show LByteStringAsText
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LByteStringAsText -> String -> String
showsPrec :: Int -> LByteStringAsText -> String -> String
$cshow :: LByteStringAsText -> String
show :: LByteStringAsText -> String
$cshowList :: [LByteStringAsText] -> String -> String
showList :: [LByteStringAsText] -> String -> String
Show, LByteStringAsText -> LByteStringAsText -> Bool
(LByteStringAsText -> LByteStringAsText -> Bool)
-> (LByteStringAsText -> LByteStringAsText -> Bool)
-> Eq LByteStringAsText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LByteStringAsText -> LByteStringAsText -> Bool
== :: LByteStringAsText -> LByteStringAsText -> Bool
$c/= :: LByteStringAsText -> LByteStringAsText -> Bool
/= :: LByteStringAsText -> LByteStringAsText -> Bool
Eq)
newtype LByteStringAsBytes = LByteStringAsBytes
{ LByteStringAsBytes -> ByteString
unLByteStringAsBytes :: LBS.ByteString
} deriving newtype (Int -> LByteStringAsBytes -> String -> String
[LByteStringAsBytes] -> String -> String
LByteStringAsBytes -> String
(Int -> LByteStringAsBytes -> String -> String)
-> (LByteStringAsBytes -> String)
-> ([LByteStringAsBytes] -> String -> String)
-> Show LByteStringAsBytes
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LByteStringAsBytes -> String -> String
showsPrec :: Int -> LByteStringAsBytes -> String -> String
$cshow :: LByteStringAsBytes -> String
show :: LByteStringAsBytes -> String
$cshowList :: [LByteStringAsBytes] -> String -> String
showList :: [LByteStringAsBytes] -> String -> String
Show, LByteStringAsBytes -> LByteStringAsBytes -> Bool
(LByteStringAsBytes -> LByteStringAsBytes -> Bool)
-> (LByteStringAsBytes -> LByteStringAsBytes -> Bool)
-> Eq LByteStringAsBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LByteStringAsBytes -> LByteStringAsBytes -> Bool
== :: LByteStringAsBytes -> LByteStringAsBytes -> Bool
$c/= :: LByteStringAsBytes -> LByteStringAsBytes -> Bool
/= :: LByteStringAsBytes -> LByteStringAsBytes -> Bool
Eq)