{-# LANGUAGE GADTs #-}
module Toml.Codec.BiMap.Conversion
(
_Bool
, _Int
, _Word
, _Word8
, _Integer
, _Natural
, _Double
, _Float
, _Text
, _LText
, _ByteString
, _LByteString
, _String
, _ZonedTime
, _LocalTime
, _Day
, _TimeOfDay
, _Array
, _NonEmpty
, _Set
, _HashSet
, _IntSet
, _ByteStringArray
, _LByteStringArray
, _Coerce
, _EnumBounded
, _Read
, _TextBy
, _Validate
, _Hardcoded
, _KeyText
, _KeyString
, _KeyInt
, _Just
, _Left
, _Right
, _LTextText
, _NaturalInteger
, _NonEmptyList
, _StringText
, _ReadString
, _BoundedInteger
, _EnumBoundedText
, _ByteStringText
, _LByteStringText
) where
import Control.Category ((>>>))
import Control.Monad ((>=>))
import Data.Bifunctor (bimap, first)
import Data.ByteString (ByteString)
import Data.Coerce (Coercible, coerce)
import Data.Hashable (Hashable)
import Data.Map (Map)
import Data.Text (Text)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
import Data.Word (Word8)
import Numeric.Natural (Natural)
import Text.Read (readEither)
import Toml.Codec.BiMap (BiMap (..), TomlBiMap, TomlBiMapError (..), iso, mkAnyValueBiMap, prism,
tShow, wrongConstructor)
import Toml.Parser (TomlParseError (..), parseKey)
import Toml.Type.AnyValue (AnyValue (..), applyAsToAny, matchBool, matchDay, matchDouble,
matchHours, matchInteger, matchLocal, matchText, matchZoned,
mkMatchError, toMArray)
import Toml.Type.Key (Key (..))
import Toml.Type.Printer (prettyKey)
import Toml.Type.Value (TValue (..), Value (..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.HashSet as HS
import qualified Data.IntSet as IS
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
_Bool :: TomlBiMap Bool AnyValue
_Bool :: TomlBiMap Bool AnyValue
_Bool = forall a (tag :: TValue).
(forall (t :: TValue). Value t -> Either MatchError a)
-> (a -> Value tag) -> TomlBiMap a AnyValue
mkAnyValueBiMap forall (t :: TValue). Value t -> Either MatchError Bool
matchBool Bool -> Value 'TBool
Bool
{-# INLINE _Bool #-}
_Integer :: TomlBiMap Integer AnyValue
_Integer :: TomlBiMap Integer AnyValue
_Integer = forall a (tag :: TValue).
(forall (t :: TValue). Value t -> Either MatchError a)
-> (a -> Value tag) -> TomlBiMap a AnyValue
mkAnyValueBiMap forall (t :: TValue). Value t -> Either MatchError Integer
matchInteger Integer -> Value 'TInteger
Integer
{-# INLINE _Integer #-}
_Double :: TomlBiMap Double AnyValue
_Double :: TomlBiMap Double AnyValue
_Double = forall a (tag :: TValue).
(forall (t :: TValue). Value t -> Either MatchError a)
-> (a -> Value tag) -> TomlBiMap a AnyValue
mkAnyValueBiMap forall (t :: TValue). Value t -> Either MatchError Double
matchDouble Double -> Value 'TDouble
Double
{-# INLINE _Double #-}
_Text :: TomlBiMap Text AnyValue
_Text :: TomlBiMap Text AnyValue
_Text = forall a (tag :: TValue).
(forall (t :: TValue). Value t -> Either MatchError a)
-> (a -> Value tag) -> TomlBiMap a AnyValue
mkAnyValueBiMap forall (t :: TValue). Value t -> Either MatchError Text
matchText Text -> Value 'TText
Text
{-# INLINE _Text #-}
_LTextText :: BiMap e TL.Text Text
_LTextText :: forall e. BiMap e Text Text
_LTextText = forall a b e. (a -> b) -> (b -> a) -> BiMap e a b
iso Text -> Text
TL.toStrict Text -> Text
TL.fromStrict
{-# INLINE _LTextText #-}
_LText :: TomlBiMap TL.Text AnyValue
_LText :: TomlBiMap Text AnyValue
_LText = forall e. BiMap e Text Text
_LTextText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Text AnyValue
_Text
{-# INLINE _LText #-}
_ZonedTime :: TomlBiMap ZonedTime AnyValue
_ZonedTime :: TomlBiMap ZonedTime AnyValue
_ZonedTime = forall a (tag :: TValue).
(forall (t :: TValue). Value t -> Either MatchError a)
-> (a -> Value tag) -> TomlBiMap a AnyValue
mkAnyValueBiMap forall (t :: TValue). Value t -> Either MatchError ZonedTime
matchZoned ZonedTime -> Value 'TZoned
Zoned
{-# INLINE _ZonedTime #-}
_LocalTime :: TomlBiMap LocalTime AnyValue
_LocalTime :: TomlBiMap LocalTime AnyValue
_LocalTime = forall a (tag :: TValue).
(forall (t :: TValue). Value t -> Either MatchError a)
-> (a -> Value tag) -> TomlBiMap a AnyValue
mkAnyValueBiMap forall (t :: TValue). Value t -> Either MatchError LocalTime
matchLocal LocalTime -> Value 'TLocal
Local
{-# INLINE _LocalTime #-}
_Day :: TomlBiMap Day AnyValue
_Day :: TomlBiMap Day AnyValue
_Day = forall a (tag :: TValue).
(forall (t :: TValue). Value t -> Either MatchError a)
-> (a -> Value tag) -> TomlBiMap a AnyValue
mkAnyValueBiMap forall (t :: TValue). Value t -> Either MatchError Day
matchDay Day -> Value 'TDay
Day
{-# INLINE _Day #-}
_TimeOfDay :: TomlBiMap TimeOfDay AnyValue
_TimeOfDay :: TomlBiMap TimeOfDay AnyValue
_TimeOfDay = forall a (tag :: TValue).
(forall (t :: TValue). Value t -> Either MatchError a)
-> (a -> Value tag) -> TomlBiMap a AnyValue
mkAnyValueBiMap forall (t :: TValue). Value t -> Either MatchError TimeOfDay
matchHours TimeOfDay -> Value 'THours
Hours
{-# INLINE _TimeOfDay #-}
_StringText :: BiMap e String Text
_StringText :: forall e. BiMap e String Text
_StringText = forall a b e. (a -> b) -> (b -> a) -> BiMap e a b
iso String -> Text
T.pack Text -> String
T.unpack
{-# INLINE _StringText #-}
_String :: TomlBiMap String AnyValue
_String :: TomlBiMap String AnyValue
_String = forall e. BiMap e String Text
_StringText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Text AnyValue
_Text
{-# INLINE _String #-}
_NaturalInteger :: TomlBiMap Natural Integer
_NaturalInteger :: TomlBiMap Natural Integer
_NaturalInteger = forall e a b. (a -> Either e b) -> (b -> Either e a) -> BiMap e a b
BiMap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger) Integer -> Either TomlBiMapError Natural
eitherInteger
where
eitherInteger :: Integer -> Either TomlBiMapError Natural
eitherInteger :: Integer -> Either TomlBiMapError Natural
eitherInteger Integer
n
| Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> TomlBiMapError
ArbitraryError forall a b. (a -> b) -> a -> b
$ Text
"Value is below zero, but expected Natural: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Integer
n
| Bool
otherwise = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
_Natural :: TomlBiMap Natural AnyValue
_Natural :: TomlBiMap Natural AnyValue
_Natural = TomlBiMap Natural Integer
_NaturalInteger forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Integer AnyValue
_Integer
{-# INLINE _Natural #-}
_BoundedInteger :: (Integral a, Bounded a, Show a) => TomlBiMap a Integer
_BoundedInteger :: forall a. (Integral a, Bounded a, Show a) => TomlBiMap a Integer
_BoundedInteger = forall e a b. (a -> Either e b) -> (b -> Either e a) -> BiMap e a b
BiMap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger) forall a.
(Integral a, Bounded a, Show a) =>
Integer -> Either TomlBiMapError a
eitherBounded
where
eitherBounded :: forall a. (Integral a, Bounded a, Show a) => Integer -> Either TomlBiMapError a
eitherBounded :: forall a.
(Integral a, Bounded a, Show a) =>
Integer -> Either TomlBiMapError a
eitherBounded Integer
n
| Integer
n forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound @a) =
let msg :: Text
msg = Text
"Value " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Integer
n forall a. Semigroup a => a -> a -> a
<> Text
" is less than minBound: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow (forall a. Bounded a => a
minBound @a)
in forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> TomlBiMapError
ArbitraryError Text
msg
| Integer
n forall a. Ord a => a -> a -> Bool
> forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound @a) =
let msg :: Text
msg = Text
"Value " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow Integer
n forall a. Semigroup a => a -> a -> a
<> Text
" is greater than maxBound: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tShow (forall a. Bounded a => a
maxBound @a)
in forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> TomlBiMapError
ArbitraryError Text
msg
| Bool
otherwise = forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
_Word :: TomlBiMap Word AnyValue
_Word :: TomlBiMap Word AnyValue
_Word = forall a. (Integral a, Bounded a, Show a) => TomlBiMap a Integer
_BoundedInteger forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Integer AnyValue
_Integer
{-# INLINE _Word #-}
_Word8 :: TomlBiMap Word8 AnyValue
_Word8 :: TomlBiMap Word8 AnyValue
_Word8 = forall a. (Integral a, Bounded a, Show a) => TomlBiMap a Integer
_BoundedInteger forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Integer AnyValue
_Integer
{-# INLINE _Word8 #-}
_Int :: TomlBiMap Int AnyValue
_Int :: TomlBiMap Int AnyValue
_Int = forall a. (Integral a, Bounded a, Show a) => TomlBiMap a Integer
_BoundedInteger forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Integer AnyValue
_Integer
{-# INLINE _Int #-}
_Float :: TomlBiMap Float AnyValue
_Float :: TomlBiMap Float AnyValue
_Float = forall a b e. (a -> b) -> (b -> a) -> BiMap e a b
iso forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (Real a, Fractional b) => a -> b
realToFrac forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Double AnyValue
_Double
{-# INLINE _Float #-}
_ByteStringText :: TomlBiMap ByteString Text
_ByteStringText :: TomlBiMap ByteString Text
_ByteStringText = forall field object error.
(field -> object)
-> (object -> Either error field) -> BiMap error object field
prism Text -> ByteString
T.encodeUtf8 ByteString -> Either TomlBiMapError Text
eitherText
where
eitherText :: ByteString -> Either TomlBiMapError Text
eitherText :: ByteString -> Either TomlBiMapError Text
eitherText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\UnicodeException
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> TomlBiMapError
ArbitraryError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tShow UnicodeException
err) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8'
{-# INLINE _ByteStringText #-}
_ByteString :: TomlBiMap ByteString AnyValue
_ByteString :: TomlBiMap ByteString AnyValue
_ByteString = TomlBiMap ByteString Text
_ByteStringText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Text AnyValue
_Text
{-# INLINE _ByteString #-}
_LByteStringText :: TomlBiMap BL.ByteString Text
_LByteStringText :: TomlBiMap ByteString Text
_LByteStringText = forall field object error.
(field -> object)
-> (object -> Either error field) -> BiMap error object field
prism (Text -> ByteString
TL.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict) ByteString -> Either TomlBiMapError Text
eitherText
where
eitherText :: BL.ByteString -> Either TomlBiMapError Text
eitherText :: ByteString -> Either TomlBiMapError Text
eitherText = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> TomlBiMapError
ArbitraryError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
tShow) Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TL.decodeUtf8'
{-# INLINE _LByteStringText #-}
_LByteString :: TomlBiMap BL.ByteString AnyValue
_LByteString :: TomlBiMap ByteString AnyValue
_LByteString = TomlBiMap ByteString Text
_LByteStringText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Text AnyValue
_Text
{-# INLINE _LByteString #-}
_ByteStringArray :: TomlBiMap ByteString AnyValue
_ByteStringArray :: TomlBiMap ByteString AnyValue
_ByteStringArray = forall a b e. (a -> b) -> (b -> a) -> BiMap e a b
iso ByteString -> [Word8]
BS.unpack [Word8] -> ByteString
BS.pack forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array TomlBiMap Word8 AnyValue
_Word8
{-# INLINE _ByteStringArray #-}
_LByteStringArray :: TomlBiMap BL.ByteString AnyValue
_LByteStringArray :: TomlBiMap ByteString AnyValue
_LByteStringArray = forall a b e. (a -> b) -> (b -> a) -> BiMap e a b
iso ByteString -> [Word8]
BL.unpack [Word8] -> ByteString
BL.pack forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array TomlBiMap Word8 AnyValue
_Word8
{-# INLINE _LByteStringArray #-}
_Array :: forall a . TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array :: forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array TomlBiMap a AnyValue
elementBimap = forall e a b. (a -> Either e b) -> (b -> Either e a) -> BiMap e a b
BiMap [a] -> Either TomlBiMapError AnyValue
toAnyValue AnyValue -> Either TomlBiMapError [a]
fromAnyValue
where
toAnyValue :: [a] -> Either TomlBiMapError AnyValue
toAnyValue :: [a] -> Either TomlBiMapError AnyValue
toAnyValue = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall e a b. BiMap e a b -> a -> Either e b
forward TomlBiMap a AnyValue
elementBimap) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap MatchError -> TomlBiMapError
WrongValue forall (t :: TValue). Value t -> AnyValue
AnyValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AnyValue] -> Either MatchError (Value 'TArray)
toMArray
fromAnyValue :: AnyValue -> Either TomlBiMapError [a]
fromAnyValue :: AnyValue -> Either TomlBiMapError [a]
fromAnyValue (AnyValue Value t
v) = forall (t :: TValue).
(AnyValue -> Either TomlBiMapError a)
-> Value t -> Either TomlBiMapError [a]
matchElements (forall e a b. BiMap e a b -> b -> Either e a
backward TomlBiMap a AnyValue
elementBimap) Value t
v
matchElements :: (AnyValue -> Either TomlBiMapError a) -> Value t -> Either TomlBiMapError [a]
matchElements :: forall (t :: TValue).
(AnyValue -> Either TomlBiMapError a)
-> Value t -> Either TomlBiMapError [a]
matchElements AnyValue -> Either TomlBiMapError a
match (Array [Value t]
a) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall r (t :: TValue). (AnyValue -> r) -> Value t -> r
applyAsToAny AnyValue -> Either TomlBiMapError a
match) [Value t]
a
matchElements AnyValue -> Either TomlBiMapError a
_ Value t
val = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MatchError -> TomlBiMapError
WrongValue forall a b. (a -> b) -> a -> b
$ forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TArray Value t
val
_NonEmpty :: TomlBiMap a AnyValue -> TomlBiMap (NE.NonEmpty a) AnyValue
_NonEmpty :: forall a. TomlBiMap a AnyValue -> TomlBiMap (NonEmpty a) AnyValue
_NonEmpty TomlBiMap a AnyValue
bi = forall a. TomlBiMap (NonEmpty a) [a]
_NonEmptyList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array TomlBiMap a AnyValue
bi
{-# INLINE _NonEmpty #-}
_NonEmptyList :: TomlBiMap (NE.NonEmpty a) [a]
_NonEmptyList :: forall a. TomlBiMap (NonEmpty a) [a]
_NonEmptyList = BiMap
{ forward :: NonEmpty a -> Either TomlBiMapError [a]
forward = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList
, backward :: [a] -> Either TomlBiMapError (NonEmpty a)
backward = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> TomlBiMapError
ArbitraryError Text
"Empty array list, but expected NonEmpty") forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
}
{-# INLINE _NonEmptyList #-}
_Set :: (Ord a) => TomlBiMap a AnyValue -> TomlBiMap (S.Set a) AnyValue
_Set :: forall a.
Ord a =>
TomlBiMap a AnyValue -> TomlBiMap (Set a) AnyValue
_Set TomlBiMap a AnyValue
bi = forall a b e. (a -> b) -> (b -> a) -> BiMap e a b
iso forall a. Set a -> [a]
S.toList forall a. Ord a => [a] -> Set a
S.fromList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array TomlBiMap a AnyValue
bi
{-# INLINE _Set #-}
_HashSet :: (Eq a, Hashable a) => TomlBiMap a AnyValue -> TomlBiMap (HS.HashSet a) AnyValue
_HashSet :: forall a.
(Eq a, Hashable a) =>
TomlBiMap a AnyValue -> TomlBiMap (HashSet a) AnyValue
_HashSet TomlBiMap a AnyValue
bi = forall a b e. (a -> b) -> (b -> a) -> BiMap e a b
iso forall a. HashSet a -> [a]
HS.toList forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array TomlBiMap a AnyValue
bi
{-# INLINE _HashSet #-}
_IntSet :: TomlBiMap IS.IntSet AnyValue
_IntSet :: TomlBiMap IntSet AnyValue
_IntSet = forall a b e. (a -> b) -> (b -> a) -> BiMap e a b
iso IntSet -> [Int]
IS.toList [Int] -> IntSet
IS.fromList forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array TomlBiMap Int AnyValue
_Int
{-# INLINE _IntSet #-}
_Coerce :: (Coercible a b) => TomlBiMap a AnyValue -> TomlBiMap b AnyValue
_Coerce :: forall a b.
Coercible a b =>
TomlBiMap a AnyValue -> TomlBiMap b AnyValue
_Coerce = coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE _Coerce #-}
_ReadString :: (Show a, Read a) => TomlBiMap a String
_ReadString :: forall a. (Show a, Read a) => TomlBiMap a String
_ReadString = forall e a b. (a -> Either e b) -> (b -> Either e a) -> BiMap e a b
BiMap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> TomlBiMapError
ArbitraryError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Either String a
readEither)
{-# INLINE _ReadString #-}
_Read :: (Show a, Read a) => TomlBiMap a AnyValue
_Read :: forall a. (Show a, Read a) => TomlBiMap a AnyValue
_Read = forall a. (Show a, Read a) => TomlBiMap a String
_ReadString forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap String AnyValue
_String
{-# INLINE _Read #-}
_TextBy
:: forall a .
(a -> Text)
-> (Text -> Either Text a)
-> TomlBiMap a AnyValue
_TextBy :: forall a.
(a -> Text) -> (Text -> Either Text a) -> TomlBiMap a AnyValue
_TextBy a -> Text
toText Text -> Either Text a
parseText = forall e a b. (a -> Either e b) -> (b -> Either e a) -> BiMap e a b
BiMap a -> Either TomlBiMapError AnyValue
toAnyValue AnyValue -> Either TomlBiMapError a
fromAnyValue
where
toAnyValue :: a -> Either TomlBiMapError AnyValue
toAnyValue :: a -> Either TomlBiMapError AnyValue
toAnyValue = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: TValue). Value t -> AnyValue
AnyValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value 'TText
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
toText
fromAnyValue :: AnyValue -> Either TomlBiMapError a
fromAnyValue :: AnyValue -> Either TomlBiMapError a
fromAnyValue (AnyValue Value t
v) =
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MatchError -> TomlBiMapError
WrongValue (forall (t :: TValue). Value t -> Either MatchError Text
matchText Value t
v) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> TomlBiMapError
ArbitraryError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text a
parseText
_Validate :: forall a . (a -> Either Text a) -> TomlBiMap a AnyValue -> TomlBiMap a AnyValue
_Validate :: forall a.
(a -> Either Text a)
-> TomlBiMap a AnyValue -> TomlBiMap a AnyValue
_Validate a -> Either Text a
p BiMap{a -> Either TomlBiMapError AnyValue
AnyValue -> Either TomlBiMapError a
backward :: AnyValue -> Either TomlBiMapError a
forward :: a -> Either TomlBiMapError AnyValue
backward :: forall e a b. BiMap e a b -> b -> Either e a
forward :: forall e a b. BiMap e a b -> a -> Either e b
..} = forall e a b. (a -> Either e b) -> (b -> Either e a) -> BiMap e a b
BiMap a -> Either TomlBiMapError AnyValue
forward AnyValue -> Either TomlBiMapError a
backwardWithValidation
where
backwardWithValidation :: AnyValue -> Either TomlBiMapError a
backwardWithValidation :: AnyValue -> Either TomlBiMapError a
backwardWithValidation AnyValue
anyVal = AnyValue -> Either TomlBiMapError a
backward AnyValue
anyVal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> TomlBiMapError
ArbitraryError forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either Text a
p
_EnumBoundedText :: forall a. (Show a, Enum a, Bounded a) => TomlBiMap a Text
_EnumBoundedText :: forall a. (Show a, Enum a, Bounded a) => TomlBiMap a Text
_EnumBoundedText = BiMap
{ forward :: a -> Either TomlBiMapError Text
forward = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
tShow
, backward :: Text -> Either TomlBiMapError a
backward = Text -> Either TomlBiMapError a
toEnumBounded
}
where
toEnumBounded :: Text -> Either TomlBiMapError a
toEnumBounded :: Text -> Either TomlBiMapError a
toEnumBounded Text
value = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
value Map Text a
enumOptions of
Just a
a -> forall a b. b -> Either a b
Right a
a
Maybe a
Nothing ->
let msg :: Text
msg = Text
"Value is '" forall a. Semigroup a => a -> a -> a
<> Text
value forall a. Semigroup a => a -> a -> a
<> Text
"' but expected one of: " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
options
in forall a b. a -> Either a b
Left (Text -> TomlBiMapError
ArbitraryError Text
msg)
where
enumOptions :: Map Text a
enumOptions :: Map Text a
enumOptions = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
options [a]
enums
options :: [Text]
options = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> Text
tShow [a]
enums
enums :: [a]
enums = [forall a. Bounded a => a
minBound @a .. forall a. Bounded a => a
maxBound @a]
_EnumBounded :: (Show a, Enum a, Bounded a) => TomlBiMap a AnyValue
_EnumBounded :: forall a. (Show a, Enum a, Bounded a) => TomlBiMap a AnyValue
_EnumBounded = forall a. (Show a, Enum a, Bounded a) => TomlBiMap a Text
_EnumBoundedText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TomlBiMap Text AnyValue
_Text
{-# INLINE _EnumBounded #-}
_Hardcoded :: forall a . (Show a, Eq a) => a -> TomlBiMap a a
_Hardcoded :: forall a. (Show a, Eq a) => a -> TomlBiMap a a
_Hardcoded a
a = BiMap
{ forward :: a -> Either TomlBiMapError a
forward = forall a b. a -> b -> a
const (forall a b. b -> Either a b
Right a
a)
, backward :: a -> Either TomlBiMapError a
backward = a -> Either TomlBiMapError a
checkValue
}
where
checkValue :: a -> Either TomlBiMapError a
checkValue :: a -> Either TomlBiMapError a
checkValue a
v = if a
v forall a. Eq a => a -> a -> Bool
== a
a
then forall a b. b -> Either a b
Right a
v
else forall a b. a -> Either a b
Left (Text -> TomlBiMapError
ArbitraryError Text
msg)
where
msg :: Text
msg :: Text
msg = Text
"Value '" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show a
v)
forall a. Semigroup a => a -> a -> a
<> Text
"' doesn't align with the hardcoded value '"
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show a
a) forall a. Semigroup a => a -> a -> a
<> Text
"'"
_KeyText :: TomlBiMap Key Text
_KeyText :: TomlBiMap Key Text
_KeyText = BiMap
{ forward :: Key -> Either TomlBiMapError Text
forward = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
prettyKey
, backward :: Text -> Either TomlBiMapError Key
backward = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> TomlBiMapError
ArbitraryError forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlParseError -> Text
unTomlParseError) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TomlParseError Key
parseKey
}
_KeyString :: TomlBiMap Key String
_KeyString :: TomlBiMap Key String
_KeyString = BiMap
{ forward :: Key -> Either TomlBiMapError String
forward = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
prettyKey
, backward :: String -> Either TomlBiMapError Key
backward = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> TomlBiMapError
ArbitraryError forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlParseError -> Text
unTomlParseError) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TomlParseError Key
parseKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
}
_KeyInt :: TomlBiMap Key Int
_KeyInt :: TomlBiMap Key Int
_KeyInt = BiMap
{ forward :: Key -> Either TomlBiMapError Int
forward = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> TomlBiMapError
ArbitraryError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Either String a
readEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
prettyKey
, backward :: Int -> Either TomlBiMapError Key
backward = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> TomlBiMapError
ArbitraryError forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlParseError -> Text
unTomlParseError) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TomlParseError Key
parseKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
tShow
}
_Left :: (Show l, Show r) => TomlBiMap (Either l r) l
_Left :: forall l r. (Show l, Show r) => TomlBiMap (Either l r) l
_Left = forall field object error.
(field -> object)
-> (object -> Either error field) -> BiMap error object field
prism forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ \case
Left l
l -> forall a b. b -> Either a b
Right l
l
Either l r
x -> forall a b. Show a => Text -> a -> Either TomlBiMapError b
wrongConstructor Text
"Left" Either l r
x
_Right :: (Show l, Show r) => TomlBiMap (Either l r) r
_Right :: forall l r. (Show l, Show r) => TomlBiMap (Either l r) r
_Right = forall field object error.
(field -> object)
-> (object -> Either error field) -> BiMap error object field
prism forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \case
Right r
r -> forall a b. b -> Either a b
Right r
r
Either l r
x -> forall a b. Show a => Text -> a -> Either TomlBiMapError b
wrongConstructor Text
"Right" Either l r
x
_Just :: Show r => TomlBiMap (Maybe r) r
_Just :: forall r. Show r => TomlBiMap (Maybe r) r
_Just = forall field object error.
(field -> object)
-> (object -> Either error field) -> BiMap error object field
prism forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \case
Just r
r -> forall a b. b -> Either a b
Right r
r
Maybe r
x -> forall a b. Show a => Text -> a -> Either TomlBiMapError b
wrongConstructor Text
"Just" Maybe r
x