{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Data.EDN.Class
( ToEDN(..)
, toEDNtagged
, FromEDN(..)
, fromEDN
, withTagged
, withNoTag
, withNil
, withBoolean
, withString
, withCharacter
, withSymbol
, withKeyword
, withTextual
, withInteger
, withIntegral
, withFloating
, withFractional
, withList
, withVec
, withMap
, withSet
, unexpected
, DP.Expected
, DP.Label
, vecGet
, mapGetP
, mapGetKeyword
, mapGetString
, mapGetSymbol
, mapGetSymbolNS
) where
import Control.Applicative ((<|>))
import Data.Map (Map)
#if MIN_VERSION_base(4,12,0)
#else
import Data.Semigroup ((<>))
#endif
import Data.Set (Set)
import Data.Text (Text)
import Data.Time (UTCTime, defaultTimeLocale, formatTime, parseTimeM)
import Data.UUID.Types (UUID)
import Data.Vector (Vector)
import Data.Void (Void, absurd)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import qualified Data.UUID.Types as UUID
import qualified Data.Vector as Vector
import Data.EDN.AST.Printer (renderText)
import qualified Data.EDN.AST.Types as EDN
import qualified Data.EDN.Class.Parser as DP
class ToEDN a where
{-# MINIMAL toEDN | toEDNv #-}
toEDN :: a -> EDN.TaggedValue
toEDN = Value -> TaggedValue
forall tag a. a -> Tagged tag a
EDN.NoTag (Value -> TaggedValue) -> (a -> Value) -> a -> TaggedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToEDN a => a -> Value
toEDNv
{-# INLINE toEDN #-}
toEDNv :: a -> EDN.Value
toEDNv = TaggedValue -> Value
forall tag a. Tagged tag a -> a
EDN.stripTag (TaggedValue -> Value) -> (a -> TaggedValue) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN
{-# INLINE toEDNv #-}
toEDNtagged :: ToEDN a => Text -> Text -> a -> EDN.TaggedValue
toEDNtagged :: Text -> Text -> a -> TaggedValue
toEDNtagged Text
tagNS Text
tag = Text -> Text -> Value -> TaggedValue
forall tag a. tag -> tag -> a -> Tagged tag a
EDN.Tagged Text
tagNS Text
tag (Value -> TaggedValue) -> (a -> Value) -> a -> TaggedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToEDN a => a -> Value
toEDNv
instance ToEDN EDN.TaggedValue where
toEDN :: TaggedValue -> TaggedValue
toEDN = TaggedValue -> TaggedValue
forall a. a -> a
id
instance ToEDN EDN.Value where
toEDNv :: Value -> Value
toEDNv = Value -> Value
forall a. a -> a
id
instance ToEDN Void where
toEDNv :: Void -> Value
toEDNv = Void -> Value
forall a. Void -> a
absurd
instance ToEDN () where
toEDN :: () -> TaggedValue
toEDN () = Value -> TaggedValue
forall tag a. a -> Tagged tag a
EDN.NoTag Value
EDN.Nil
instance ToEDN Bool where
toEDNv :: Bool -> Value
toEDNv = Bool -> Value
EDN.Boolean
instance ToEDN Text where
toEDNv :: Text -> Value
toEDNv = Text -> Value
EDN.String
instance ToEDN LText.Text where
toEDNv :: Text -> Value
toEDNv = Text -> Value
EDN.String (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toStrict
instance ToEDN Char where
toEDNv :: Char -> Value
toEDNv = Char -> Value
EDN.Character
instance ToEDN Int where
toEDNv :: Int -> Value
toEDNv = Int -> Value
EDN.Integer
instance ToEDN Double where
toEDNv :: Double -> Value
toEDNv = Double -> Value
EDN.Floating
instance ToEDN a => ToEDN (Maybe a) where
toEDN :: Maybe a -> TaggedValue
toEDN Maybe a
Nothing = Value -> TaggedValue
forall tag a. a -> Tagged tag a
EDN.NoTag Value
EDN.Nil
toEDN (Just a
a) = a -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN a
a
instance ToEDN a => ToEDN [a] where
toEDNv :: [a] -> Value
toEDNv = EDNList -> Value
EDN.List (EDNList -> Value) -> ([a] -> EDNList) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> TaggedValue) -> [a] -> EDNList
forall a b. (a -> b) -> [a] -> [b]
map a -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN
instance ToEDN a => ToEDN (Vector a) where
toEDNv :: Vector a -> Value
toEDNv = EDNVec -> Value
EDN.Vec (EDNVec -> Value) -> (Vector a -> EDNVec) -> Vector a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> TaggedValue) -> Vector a -> EDNVec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN
instance ToEDN a => ToEDN (Set a) where
toEDNv :: Set a -> Value
toEDNv = EDNSet -> Value
EDN.Set (EDNSet -> Value) -> (Set a -> EDNSet) -> Set a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EDNList -> EDNSet
forall a. Ord a => [a] -> Set a
Set.fromList (EDNList -> EDNSet) -> (Set a -> EDNList) -> Set a -> EDNSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> TaggedValue) -> [a] -> EDNList
forall a b. (a -> b) -> [a] -> [b]
map a -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN ([a] -> EDNList) -> (Set a -> [a]) -> Set a -> EDNList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList
instance (ToEDN k, ToEDN v) => ToEDN (Map k v) where
toEDNv :: Map k v -> Value
toEDNv
= EDNMap -> Value
EDN.Map
(EDNMap -> Value) -> (Map k v -> EDNMap) -> Map k v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TaggedValue, TaggedValue)] -> EDNMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
([(TaggedValue, TaggedValue)] -> EDNMap)
-> (Map k v -> [(TaggedValue, TaggedValue)]) -> Map k v -> EDNMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (TaggedValue, TaggedValue))
-> [(k, v)] -> [(TaggedValue, TaggedValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k, v
v) -> (k -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN k
k, v -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN v
v))
([(k, v)] -> [(TaggedValue, TaggedValue)])
-> (Map k v -> [(k, v)]) -> Map k v -> [(TaggedValue, TaggedValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList
instance (ToEDN a, ToEDN b) => ToEDN (a, b) where
toEDNv :: (a, b) -> Value
toEDNv (a
a, b
b) = EDNVec -> Value
EDN.Vec (EDNVec -> Value) -> EDNVec -> Value
forall a b. (a -> b) -> a -> b
$ EDNList -> EDNVec
forall a. [a] -> Vector a
Vector.fromList
[ a -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN a
a
, b -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN b
b
]
instance (ToEDN a, ToEDN b, ToEDN c) => ToEDN (a, b, c) where
toEDNv :: (a, b, c) -> Value
toEDNv (a
a, b
b, c
c) = EDNVec -> Value
EDN.Vec (EDNVec -> Value) -> EDNVec -> Value
forall a b. (a -> b) -> a -> b
$ EDNList -> EDNVec
forall a. [a] -> Vector a
Vector.fromList
[ a -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN a
a
, b -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN b
b
, c -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN c
c
]
instance (ToEDN a, ToEDN b, ToEDN c, ToEDN d) => ToEDN (a, b, c, d) where
toEDNv :: (a, b, c, d) -> Value
toEDNv (a
a, b
b, c
c, d
d) = EDNVec -> Value
EDN.Vec (EDNVec -> Value) -> EDNVec -> Value
forall a b. (a -> b) -> a -> b
$ EDNList -> EDNVec
forall a. [a] -> Vector a
Vector.fromList
[ a -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN a
a
, b -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN b
b
, c -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN c
c
, d -> TaggedValue
forall a. ToEDN a => a -> TaggedValue
toEDN d
d
]
instance ToEDN UTCTime where
toEDN :: UTCTime -> TaggedValue
toEDN
= Text -> Text -> Text -> TaggedValue
forall a. ToEDN a => Text -> Text -> a -> TaggedValue
toEDNtagged Text
"" Text
"inst"
(Text -> TaggedValue)
-> (UTCTime -> Text) -> UTCTime -> TaggedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M:%S%Q%EZ"
instance ToEDN UUID where
toEDN :: UUID -> TaggedValue
toEDN = Text -> Text -> Text -> TaggedValue
forall a. ToEDN a => Text -> Text -> a -> TaggedValue
toEDNtagged Text
"" Text
"uuid" (Text -> TaggedValue) -> (UUID -> Text) -> UUID -> TaggedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText
withTagged
:: Text
-> Text
-> (EDN.Value -> DP.Parser a)
-> EDN.TaggedValue
-> DP.Parser a
withTagged :: Text -> Text -> (Value -> Parser a) -> TaggedValue -> Parser a
withTagged Text
tagNS Text
tag Value -> Parser a
p TaggedValue
tv =
case TaggedValue
tv of
EDN.Tagged Text
tagNS' Text
tag' Value
v
| Text
tagNS' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tagNS Bool -> Bool -> Bool
&& Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tag' ->
Value -> Parser a
p Value
v
| Bool
otherwise ->
String -> Parser a
forall a. String -> Parser a
DP.parserError (String -> Parser a) -> (Text -> String) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Parser a) -> Text -> Parser a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Item [Text]
"unexpected tag. "
, Item [Text]
"expecting: #"
, Text -> Text -> Text
nsToText Text
tagNS' Text
tag'
, Item [Text]
"; got: #"
, Text -> Text -> Text
nsToText Text
tagNS Text
tag
]
TaggedValue
_ ->
String -> Parser a
forall a. String -> Parser a
DP.parserError String
"expected tagged value"
withNoTag :: (EDN.Value -> DP.Parser a) -> EDN.TaggedValue -> DP.Parser a
withNoTag :: (Value -> Parser a) -> TaggedValue -> Parser a
withNoTag Value -> Parser a
p TaggedValue
tv =
case TaggedValue
tv of
EDN.NoTag Value
v ->
Value -> Parser a
p Value
v
EDN.Tagged Text
tagNS Text
tag Value
_v ->
String -> Parser a
forall a. String -> Parser a
DP.parserError (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"no tag expected, got #" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Text -> Text -> Text
nsToText Text
tagNS Text
tag)
withNil :: DP.Parser a -> EDN.Value -> DP.Parser a
withNil :: Parser a -> Value -> Parser a
withNil Parser a
p = \case
Value
EDN.Nil ->
Parser a
p
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"nil"
withBoolean :: (Bool -> DP.Parser a) -> EDN.Value -> DP.Parser a
withBoolean :: (Bool -> Parser a) -> Value -> Parser a
withBoolean Bool -> Parser a
p = \case
EDN.Boolean Bool
b ->
Bool -> Parser a
p Bool
b
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"boolean"
withString :: (Text -> DP.Parser a) -> EDN.Value -> DP.Parser a
withString :: (Text -> Parser a) -> Value -> Parser a
withString Text -> Parser a
p = \case
EDN.String Text
t ->
Text -> Parser a
p Text
t
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"string"
withCharacter :: (Char -> DP.Parser a) -> EDN.Value -> DP.Parser a
withCharacter :: (Char -> Parser a) -> Value -> Parser a
withCharacter Char -> Parser a
p = \case
EDN.Character Char
c ->
Char -> Parser a
p Char
c
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"char"
withSymbol :: (Text -> Text -> DP.Parser a) -> EDN.Value -> DP.Parser a
withSymbol :: (Text -> Text -> Parser a) -> Value -> Parser a
withSymbol Text -> Text -> Parser a
p = \case
EDN.Symbol Text
ns Text
n ->
Text -> Text -> Parser a
p Text
ns Text
n
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"symbol"
withKeyword :: (Text -> DP.Parser a) -> EDN.Value -> DP.Parser a
withKeyword :: (Text -> Parser a) -> Value -> Parser a
withKeyword Text -> Parser a
p = \case
EDN.Keyword Text
t ->
Text -> Parser a
p Text
t
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"keyword"
withTextual :: (Text -> DP.Parser a) -> EDN.Value -> DP.Parser a
withTextual :: (Text -> Parser a) -> Value -> Parser a
withTextual Text -> Parser a
p Value
tv =
(Text -> Parser a) -> Value -> Parser a
forall a. (Text -> Parser a) -> Value -> Parser a
withString Text -> Parser a
p Value
tv Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Char -> Parser a) -> Value -> Parser a
forall a. (Char -> Parser a) -> Value -> Parser a
withCharacter (Text -> Parser a
p (Text -> Parser a) -> (Char -> Text) -> Char -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton) Value
tv Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Text -> Parser a) -> Value -> Parser a
forall a. (Text -> Parser a) -> Value -> Parser a
withKeyword Text -> Parser a
p Value
tv Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Text -> Text -> Parser a) -> Value -> Parser a
forall a. (Text -> Text -> Parser a) -> Value -> Parser a
withSymbol (\Text
ns Text
n -> Text -> Parser a
p (Text -> Parser a) -> Text -> Parser a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
nsToText Text
ns Text
n) Value
tv
withInteger :: (Int -> DP.Parser a) -> EDN.Value -> DP.Parser a
withInteger :: (Int -> Parser a) -> Value -> Parser a
withInteger Int -> Parser a
p = \case
EDN.Integer Int
i ->
Int -> Parser a
p Int
i
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"integer"
withIntegral :: Integral i => (i -> DP.Parser a) -> EDN.Value -> DP.Parser a
withIntegral :: (i -> Parser a) -> Value -> Parser a
withIntegral i -> Parser a
p = \case
EDN.Integer Int
i ->
i -> Parser a
p (Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"integer"
withFloating :: (Double -> DP.Parser a) -> EDN.Value -> DP.Parser a
withFloating :: (Double -> Parser a) -> Value -> Parser a
withFloating Double -> Parser a
p = \case
EDN.Floating Double
d ->
Double -> Parser a
p Double
d
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"double"
withFractional :: Fractional f => (f -> DP.Parser a) -> EDN.Value -> DP.Parser a
withFractional :: (f -> Parser a) -> Value -> Parser a
withFractional f -> Parser a
p = \case
EDN.Floating Double
d ->
f -> Parser a
p (Double -> f
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d)
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"double"
withList :: (EDN.EDNList -> DP.Parser a) -> EDN.Value -> DP.Parser a
withList :: (EDNList -> Parser a) -> Value -> Parser a
withList EDNList -> Parser a
p = \case
EDN.List EDNList
tvs ->
EDNList -> Parser a
p EDNList
tvs
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"list"
withVec :: (EDN.EDNVec -> DP.Parser a) -> EDN.Value -> DP.Parser a
withVec :: (EDNVec -> Parser a) -> Value -> Parser a
withVec EDNVec -> Parser a
p = \case
EDN.Vec EDNVec
v ->
EDNVec -> Parser a
p EDNVec
v
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"vector"
withMap :: (EDN.EDNMap -> DP.Parser a) -> EDN.Value -> DP.Parser a
withMap :: (EDNMap -> Parser a) -> Value -> Parser a
withMap EDNMap -> Parser a
p = \case
EDN.Map EDNMap
m ->
EDNMap -> Parser a
p EDNMap
m
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"map"
withSet :: (EDN.EDNSet -> DP.Parser a) -> EDN.Value -> DP.Parser a
withSet :: (EDNSet -> Parser a) -> Value -> Parser a
withSet EDNSet -> Parser a
p = \case
EDN.Set EDNSet
m ->
EDNSet -> Parser a
p EDNSet
m
Value
got ->
Value
got Value -> String -> Parser a
forall a. Value -> String -> Parser a
`unexpected` String
"set"
unexpected :: EDN.Value -> DP.Label -> DP.Parser a
unexpected :: Value -> String -> Parser a
unexpected Value
value String
label = (forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
DP.Parser ((forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a)
-> (forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success a f r
_ks ->
Failure f r
kf (String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
label) (String -> f r) -> String -> f r
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
label'
where
label' :: String
label' = case Value
value of
Value
EDN.Nil -> String
"nil"
EDN.Boolean{} -> String
"boolean"
EDN.String{} -> String
"string"
EDN.Character{} -> String
"character"
EDN.Symbol{} -> String
"symbol"
EDN.Keyword{} -> String
"keyword"
EDN.Integer{} -> String
"integer"
EDN.Floating{} -> String
"floating"
EDN.List{} -> String
"list"
EDN.Vec{} -> String
"vector"
EDN.Map{} -> String
"map"
EDN.Set{} -> String
"set"
class FromEDN a where
{-# MINIMAL parseEDN | parseEDNv #-}
parseEDN :: EDN.TaggedValue -> DP.Parser a
parseEDN = Value -> Parser a
forall a. FromEDN a => Value -> Parser a
parseEDNv (Value -> Parser a)
-> (TaggedValue -> Value) -> TaggedValue -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaggedValue -> Value
forall tag a. Tagged tag a -> a
EDN.stripTag
{-# INLINE parseEDN #-}
parseEDNv :: EDN.Value -> DP.Parser a
parseEDNv = TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN (TaggedValue -> Parser a)
-> (Value -> TaggedValue) -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> TaggedValue
forall tag a. a -> Tagged tag a
EDN.NoTag
{-# INLINE parseEDNv #-}
fromEDN :: (FromEDN a) => EDN.TaggedValue -> Either String a
fromEDN :: TaggedValue -> Either String a
fromEDN = (TaggedValue -> Parser a) -> TaggedValue -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
DP.parseEither TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN
instance FromEDN EDN.TaggedValue where
parseEDN :: TaggedValue -> Parser TaggedValue
parseEDN = TaggedValue -> Parser TaggedValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromEDN EDN.Value where
parseEDNv :: Value -> Parser Value
parseEDNv = Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromEDN Void where
parseEDN :: TaggedValue -> Parser Void
parseEDN TaggedValue
_ = String -> Parser Void
forall a. String -> Parser a
DP.parserError String
"unable to construct Void value"
instance FromEDN () where
parseEDNv :: Value -> Parser ()
parseEDNv = Parser () -> Value -> Parser ()
forall a. Parser a -> Value -> Parser a
withNil (Parser () -> Value -> Parser ())
-> Parser () -> Value -> Parser ()
forall a b. (a -> b) -> a -> b
$ () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance FromEDN Bool where
parseEDNv :: Value -> Parser Bool
parseEDNv = (Bool -> Parser Bool) -> Value -> Parser Bool
forall a. (Bool -> Parser a) -> Value -> Parser a
withBoolean Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromEDN Text where
parseEDNv :: Value -> Parser Text
parseEDNv = (Text -> Parser Text) -> Value -> Parser Text
forall a. (Text -> Parser a) -> Value -> Parser a
withTextual Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromEDN LText.Text where
parseEDNv :: Value -> Parser Text
parseEDNv = (Text -> Parser Text) -> Value -> Parser Text
forall a. (Text -> Parser a) -> Value -> Parser a
withTextual (Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> (Text -> Text) -> Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.fromStrict)
instance FromEDN Char where
parseEDNv :: Value -> Parser Char
parseEDNv = (Char -> Parser Char) -> Value -> Parser Char
forall a. (Char -> Parser a) -> Value -> Parser a
withCharacter Char -> Parser Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromEDN Int where
parseEDNv :: Value -> Parser Int
parseEDNv = (Int -> Parser Int) -> Value -> Parser Int
forall a. (Int -> Parser a) -> Value -> Parser a
withInteger Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromEDN Double where
parseEDNv :: Value -> Parser Double
parseEDNv = (Double -> Parser Double) -> Value -> Parser Double
forall a. (Double -> Parser a) -> Value -> Parser a
withFloating Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromEDN a => FromEDN (Maybe a) where
parseEDN :: TaggedValue -> Parser (Maybe a)
parseEDN = \case
EDN.NoTag Value
EDN.Nil -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
EDN.Tagged Text
_ Text
_ Value
EDN.Nil -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
TaggedValue
tv -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN TaggedValue
tv
parseEDNv :: Value -> Parser (Maybe a)
parseEDNv = \case
Value
EDN.Nil -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Value
v -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromEDN a => Value -> Parser a
parseEDNv Value
v
instance FromEDN a => FromEDN [a] where
parseEDNv :: Value -> Parser [a]
parseEDNv = (EDNList -> Parser [a]) -> Value -> Parser [a]
forall a. (EDNList -> Parser a) -> Value -> Parser a
withList ((TaggedValue -> Parser a) -> EDNList -> Parser [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN)
instance FromEDN a => FromEDN (Vector a) where
parseEDNv :: Value -> Parser (Vector a)
parseEDNv = (EDNVec -> Parser (Vector a)) -> Value -> Parser (Vector a)
forall a. (EDNVec -> Parser a) -> Value -> Parser a
withVec ((TaggedValue -> Parser a) -> EDNVec -> Parser (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN)
vecGet
:: FromEDN a
=> Int
-> EDN.EDNVec
-> DP.Parser a
vecGet :: Int -> EDNVec -> Parser a
vecGet Int
ix EDNVec
v =
case EDNVec
v EDNVec -> Int -> Maybe TaggedValue
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
ix of
Maybe TaggedValue
Nothing ->
String -> Parser a
forall a. String -> Parser a
DP.parserError (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ Item [String]
"expected vector with at least"
, Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Enum a => a -> a
succ Int
ix)
, Item [String]
"elements"
]
Just TaggedValue
x ->
TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN TaggedValue
x
instance (FromEDN a, Ord a) => FromEDN (Set a) where
parseEDNv :: Value -> Parser (Set a)
parseEDNv = (EDNSet -> Parser (Set a)) -> Value -> Parser (Set a)
forall a. (EDNSet -> Parser a) -> Value -> Parser a
withSet ((EDNSet -> Parser (Set a)) -> Value -> Parser (Set a))
-> (EDNSet -> Parser (Set a)) -> Value -> Parser (Set a)
forall a b. (a -> b) -> a -> b
$ \EDNSet
s ->
[a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Parser [a] -> Parser (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TaggedValue -> Parser a) -> EDNList -> Parser [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN (EDNSet -> EDNList
forall a. Set a -> [a]
Set.toList EDNSet
s)
instance (FromEDN k, FromEDN v, Ord k) => FromEDN (Map k v) where
parseEDNv :: Value -> Parser (Map k v)
parseEDNv = (EDNMap -> Parser (Map k v)) -> Value -> Parser (Map k v)
forall a. (EDNMap -> Parser a) -> Value -> Parser a
withMap ((EDNMap -> Parser (Map k v)) -> Value -> Parser (Map k v))
-> (EDNMap -> Parser (Map k v)) -> Value -> Parser (Map k v)
forall a b. (a -> b) -> a -> b
$ \EDNMap
m ->
[(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Parser [(k, v)] -> Parser (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TaggedValue, TaggedValue) -> Parser (k, v))
-> [(TaggedValue, TaggedValue)] -> Parser [(k, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (TaggedValue, TaggedValue) -> Parser (k, v)
forall a a.
(FromEDN a, FromEDN a) =>
(TaggedValue, TaggedValue) -> Parser (a, a)
parsePair (EDNMap -> [(TaggedValue, TaggedValue)]
forall k a. Map k a -> [(k, a)]
Map.toList EDNMap
m)
where
parsePair :: (TaggedValue, TaggedValue) -> Parser (a, a)
parsePair (TaggedValue
k, TaggedValue
v) = (,) (a -> a -> (a, a)) -> Parser a -> Parser (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN TaggedValue
k Parser (a -> (a, a)) -> Parser a -> Parser (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN TaggedValue
v
mapGetP
:: EDN.TaggedValue
-> (EDN.TaggedValue -> DP.Parser a)
-> EDN.EDNMap
-> DP.Parser a
mapGetP :: TaggedValue -> (TaggedValue -> Parser a) -> EDNMap -> Parser a
mapGetP TaggedValue
key TaggedValue -> Parser a
inner EDNMap
m =
case TaggedValue -> EDNMap -> Maybe TaggedValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TaggedValue
key EDNMap
m of
Just TaggedValue
tv ->
TaggedValue -> Parser a
inner TaggedValue
tv
Maybe TaggedValue
Nothing ->
String -> Parser a
forall a. String -> Parser a
DP.parserError (String -> Parser a) -> (Text -> String) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Parser a) -> Text -> Parser a
forall a b. (a -> b) -> a -> b
$ Text
"key not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TaggedValue -> Text
renderText TaggedValue
key
mapGetKeyword :: FromEDN a => Text -> EDN.EDNMap -> DP.Parser a
mapGetKeyword :: Text -> EDNMap -> Parser a
mapGetKeyword Text
key = TaggedValue -> (TaggedValue -> Parser a) -> EDNMap -> Parser a
forall a.
TaggedValue -> (TaggedValue -> Parser a) -> EDNMap -> Parser a
mapGetP (Value -> TaggedValue
forall tag a. a -> Tagged tag a
EDN.NoTag (Value -> TaggedValue) -> Value -> TaggedValue
forall a b. (a -> b) -> a -> b
$ Text -> Value
EDN.Keyword Text
key) TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN
mapGetString :: FromEDN a => Text -> EDN.EDNMap -> DP.Parser a
mapGetString :: Text -> EDNMap -> Parser a
mapGetString Text
key = TaggedValue -> (TaggedValue -> Parser a) -> EDNMap -> Parser a
forall a.
TaggedValue -> (TaggedValue -> Parser a) -> EDNMap -> Parser a
mapGetP (Value -> TaggedValue
forall tag a. a -> Tagged tag a
EDN.NoTag (Value -> TaggedValue) -> Value -> TaggedValue
forall a b. (a -> b) -> a -> b
$ Text -> Value
EDN.String Text
key) TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN
mapGetSymbol :: FromEDN a => Text -> EDN.EDNMap -> DP.Parser a
mapGetSymbol :: Text -> EDNMap -> Parser a
mapGetSymbol = Text -> Text -> EDNMap -> Parser a
forall a. FromEDN a => Text -> Text -> EDNMap -> Parser a
mapGetSymbolNS Text
""
mapGetSymbolNS
:: FromEDN a
=> Text
-> Text
-> EDN.EDNMap
-> DP.Parser a
mapGetSymbolNS :: Text -> Text -> EDNMap -> Parser a
mapGetSymbolNS Text
ns Text
name = TaggedValue -> (TaggedValue -> Parser a) -> EDNMap -> Parser a
forall a.
TaggedValue -> (TaggedValue -> Parser a) -> EDNMap -> Parser a
mapGetP (Value -> TaggedValue
forall tag a. a -> Tagged tag a
EDN.NoTag (Value -> TaggedValue) -> Value -> TaggedValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Value
EDN.Symbol Text
ns Text
name) TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN
instance (FromEDN a, FromEDN b) => FromEDN (a, b) where
parseEDNv :: Value -> Parser (a, b)
parseEDNv = (EDNVec -> Parser (a, b)) -> Value -> Parser (a, b)
forall a. (EDNVec -> Parser a) -> Value -> Parser a
withVec ((EDNVec -> Parser (a, b)) -> Value -> Parser (a, b))
-> (EDNVec -> Parser (a, b)) -> Value -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ \case
[Item EDNVec
a, Item EDNVec
b] ->
(,) (a -> b -> (a, b)) -> Parser a -> Parser (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
a Parser (b -> (a, b)) -> Parser b -> Parser (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TaggedValue -> Parser b
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
b
EDNVec
_ ->
String -> Parser (a, b)
forall a. String -> Parser a
DP.parserError String
"vector of size 2 expected"
instance (FromEDN a, FromEDN b, FromEDN c) => FromEDN (a, b, c) where
parseEDNv :: Value -> Parser (a, b, c)
parseEDNv = (EDNVec -> Parser (a, b, c)) -> Value -> Parser (a, b, c)
forall a. (EDNVec -> Parser a) -> Value -> Parser a
withVec ((EDNVec -> Parser (a, b, c)) -> Value -> Parser (a, b, c))
-> (EDNVec -> Parser (a, b, c)) -> Value -> Parser (a, b, c)
forall a b. (a -> b) -> a -> b
$ \case
[Item EDNVec
a, Item EDNVec
b, Item EDNVec
c] ->
(,,) (a -> b -> c -> (a, b, c))
-> Parser a -> Parser (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
a Parser (b -> c -> (a, b, c)) -> Parser b -> Parser (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TaggedValue -> Parser b
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
b Parser (c -> (a, b, c)) -> Parser c -> Parser (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TaggedValue -> Parser c
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
c
EDNVec
_ ->
String -> Parser (a, b, c)
forall a. String -> Parser a
DP.parserError String
"vector of size 3 expected"
instance (FromEDN a, FromEDN b, FromEDN c, FromEDN d) => FromEDN (a, b, c, d) where
parseEDNv :: Value -> Parser (a, b, c, d)
parseEDNv = (EDNVec -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d)
forall a. (EDNVec -> Parser a) -> Value -> Parser a
withVec ((EDNVec -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d))
-> (EDNVec -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \case
[Item EDNVec
a, Item EDNVec
b, Item EDNVec
c, Item EDNVec
d] ->
(,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Parser a -> Parser (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TaggedValue -> Parser a
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
a Parser (b -> c -> d -> (a, b, c, d))
-> Parser b -> Parser (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TaggedValue -> Parser b
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
b Parser (c -> d -> (a, b, c, d))
-> Parser c -> Parser (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TaggedValue -> Parser c
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
c Parser (d -> (a, b, c, d)) -> Parser d -> Parser (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TaggedValue -> Parser d
forall a. FromEDN a => TaggedValue -> Parser a
parseEDN Item EDNVec
TaggedValue
d
EDNVec
_ ->
String -> Parser (a, b, c, d)
forall a. String -> Parser a
DP.parserError String
"vector of size 3 expected"
instance FromEDN UTCTime where
parseEDN :: TaggedValue -> Parser UTCTime
parseEDN TaggedValue
tv = TaggedValue -> Parser UTCTime
parseTaggedUTCTime TaggedValue
tv Parser UTCTime -> Parser UTCTime -> Parser UTCTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TaggedValue -> Parser UTCTime
parseUntaggedUTCTime TaggedValue
tv
where
parseTaggedUTCTime :: TaggedValue -> Parser UTCTime
parseTaggedUTCTime =
Text
-> Text
-> (Value -> Parser UTCTime)
-> TaggedValue
-> Parser UTCTime
forall a.
Text -> Text -> (Value -> Parser a) -> TaggedValue -> Parser a
withTagged Text
"" Text
"inst" ((Value -> Parser UTCTime) -> TaggedValue -> Parser UTCTime)
-> (Value -> Parser UTCTime) -> TaggedValue -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$ (Text -> Parser UTCTime) -> Value -> Parser UTCTime
forall a. (Text -> Parser a) -> Value -> Parser a
withString Text -> Parser UTCTime
parseUTCTime
parseUntaggedUTCTime :: TaggedValue -> Parser UTCTime
parseUntaggedUTCTime =
(Value -> Parser UTCTime) -> TaggedValue -> Parser UTCTime
forall a. (Value -> Parser a) -> TaggedValue -> Parser a
withNoTag ((Value -> Parser UTCTime) -> TaggedValue -> Parser UTCTime)
-> (Value -> Parser UTCTime) -> TaggedValue -> Parser UTCTime
forall a b. (a -> b) -> a -> b
$ (Text -> Parser UTCTime) -> Value -> Parser UTCTime
forall a. (Text -> Parser a) -> Value -> Parser a
withString Text -> Parser UTCTime
parseUTCTime
parseUTCTime :: Text -> Parser UTCTime
parseUTCTime =
Bool -> TimeLocale -> String -> String -> Parser UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M:%S%Q%Z" (String -> Parser UTCTime)
-> (Text -> String) -> Text -> Parser UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
instance FromEDN UUID where
parseEDN :: TaggedValue -> Parser UUID
parseEDN TaggedValue
tv = TaggedValue -> Parser UUID
parseTaggedUUID TaggedValue
tv Parser UUID -> Parser UUID -> Parser UUID
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TaggedValue -> Parser UUID
parseUntaggedUUID TaggedValue
tv
where
parseTaggedUUID :: TaggedValue -> Parser UUID
parseTaggedUUID = Text
-> Text -> (Value -> Parser UUID) -> TaggedValue -> Parser UUID
forall a.
Text -> Text -> (Value -> Parser a) -> TaggedValue -> Parser a
withTagged Text
"" Text
"uuid" ((Value -> Parser UUID) -> TaggedValue -> Parser UUID)
-> (Value -> Parser UUID) -> TaggedValue -> Parser UUID
forall a b. (a -> b) -> a -> b
$ (Text -> Parser UUID) -> Value -> Parser UUID
forall a. (Text -> Parser a) -> Value -> Parser a
withString Text -> Parser UUID
parseUUID
parseUntaggedUUID :: TaggedValue -> Parser UUID
parseUntaggedUUID = (Value -> Parser UUID) -> TaggedValue -> Parser UUID
forall a. (Value -> Parser a) -> TaggedValue -> Parser a
withNoTag ((Value -> Parser UUID) -> TaggedValue -> Parser UUID)
-> (Value -> Parser UUID) -> TaggedValue -> Parser UUID
forall a b. (a -> b) -> a -> b
$ (Text -> Parser UUID) -> Value -> Parser UUID
forall a. (Text -> Parser a) -> Value -> Parser a
withString Text -> Parser UUID
parseUUID
parseUUID :: Text -> Parser UUID
parseUUID Text
t =
case Text -> Maybe UUID
UUID.fromText Text
t of
Maybe UUID
Nothing ->
String -> Parser UUID
forall a. String -> Parser a
DP.parserError String
"invalid UUID string"
Just UUID
uuid ->
UUID -> Parser UUID
forall (f :: * -> *) a. Applicative f => a -> f a
pure UUID
uuid
nsToText
:: Text
-> Text
-> Text
nsToText :: Text -> Text -> Text
nsToText Text
"" Text
n = Text
n
nsToText Text
ns Text
n = Text
ns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n