{-# 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

-- * Encoding

-- | A type that can be converted to EDN AST.
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

-- * Decoding

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"

-- | Report an decoding error due to unexpected AST node given.
-- The 'DP.Parser' combines and reports alternatives expected.
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"

-- | A type that can be converted from EDN, with a possibility of failure.
--
-- When writing an instance, use 'unexpected' or 'fail' to make a
-- conversion fail, e.g. if an 'Map.Map' is missing a required key, or
-- the value is of the wrong type.
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 #-}

-- | Apply appropriate parsers for a value to decode AST.
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)

-- | Get ix-th element of 'EDN.EDNVec' or fail with appropriate message.
vecGet
  :: FromEDN a
  => Int         -- ^ Element index
  -> EDN.EDNVec  -- ^ 'Vector.Vector' of EDN values
  -> 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

-- | Get a value from 'EDN.EDNMap' and apply a parser to it
mapGetP
  :: EDN.TaggedValue                  -- ^ Map key
  -> (EDN.TaggedValue -> DP.Parser a) -- ^ Parser to apply to a value
  -> EDN.EDNMap                       -- ^ Map with EDN keys and values
  -> 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

-- | Get a value from 'EDN.EDNMap' for a 'EDN.Keyword' 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

-- | Get a value from 'EDN.EDNMap' for a 'EDN.String' key.
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

-- | Get a value from 'EDN.EDNMap' for a 'EDN.Symbol' (empty namespace) key.
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
""

-- | Get a value from 'EDN.EDNMap' for a 'EDN.Symbol' (empty namespace) key.
mapGetSymbolNS
  :: FromEDN a
  => Text        -- ^ Symbol namespace
  -> Text        -- ^ Symbol name
  -> 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 -- ^ Namespace
  -> Text -- ^ Name
  -> Text -- ^ Resulting 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