{-# LANGUAGE AllowAmbiguousTypes #-}

module Telescope.Asdf.Class where

import Data.List ((!?))
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Massiv.Array (Array, Prim)
import Data.Massiv.Array qualified as M
import Data.Scientific (fromFloatDigits, toRealFloat)
import Data.Text (Text, pack, unpack)
import Data.Time.Clock (UTCTime)
import Data.Time.Format.ISO8601
import Effectful
import Effectful.Fail
import GHC.Generics
import GHC.Int
import Telescope.Asdf.Encoding.File (BlockSource (..))
import Telescope.Asdf.NDArray
import Telescope.Asdf.Node
import Telescope.Data.Array
import Telescope.Data.Axes
import Telescope.Data.Binary
import Telescope.Data.Parser


{- | Convert a type to an Asdf 'Value' or 'Node'. The generic instance will encode to an 'Object' with field names matching record selectors

> data Example = Example
>   { name :: Text
>   , age :: Int
>   , tags :: [Text]
>   }
>   deriving (Generic, ToAsdf)
>
> instance ToAsdf Example where
>   schema _ = "tag:example.org/schemas/example-1.0.0"
-}
class ToAsdf a where
  -- | Specify how an object encodes to a 'Value'
  --
  -- > instance User ToAsdf where
  -- >   toValue user =
  -- >     Object
  -- >       [ ("name", toNode user.name)
  -- >       , ("age", toNode user.age)
  -- >       ]
  toValue :: a -> Value
  default toValue :: (Generic a, GToObject (Rep a)) => a -> Value
  toValue a
a = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Rep a Any -> Object
forall p. Rep a p -> Object
forall {k} (f :: k -> *) (p :: k). GToObject f => f p -> Object
gToObject (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a)


  -- | Specify the schema for a type
  --
  -- > instance ToAsdf Unit where
  -- >   schema _ = "!unit/unit-1.0.0"
  schema :: a -> SchemaTag
  default schema :: a -> SchemaTag
  schema a
_ = SchemaTag
forall a. Monoid a => a
mempty


  -- | Specify that this node be saved as an anchor
  --
  -- > instance ToAsdf Config where
  -- >   anchor _ = Just "globalConfig"
  anchor :: a -> Maybe Anchor
  default anchor :: a -> Maybe Anchor
  anchor a
_ = Maybe Anchor
forall a. Maybe a
Nothing


  -- | Manually control all aspects of how this is converted to a 'Node'
  toNode :: a -> Node
  default toNode :: a -> Node
  toNode a
a = SchemaTag -> Maybe Anchor -> Value -> Node
Node (a -> SchemaTag
forall a. ToAsdf a => a -> SchemaTag
schema a
a) (a -> Maybe Anchor
forall a. ToAsdf a => a -> Maybe Anchor
anchor a
a) (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToAsdf a => a -> Value
toValue a
a


{- | Parse an Asdf 'Value' or 'Node' into a type. The generic instance will decode an 'Object' with field names matching record selectors

> data Example = Example
>   { name :: Text
>   , age :: Int
>   , tags :: [Text]
>   }
>   deriving (Generic, FromAsdf)
-}
class FromAsdf a where
  -- | Specify how a type is parsed from a 'Value'
  --
  -- > instance FromAsdf Integer where
  -- >   parseValue = \case
  -- >     Integer n -> pure $ fromIntegral n
  -- >     node -> expected "Integer" node
  parseValue :: (Parser :> es) => Value -> Eff es a
  default parseValue :: (Generic a, GParseObject (Rep a), Parser :> es) => Value -> Eff es a
  parseValue (Object Object
o) = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Eff es (Rep a Any) -> Eff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Eff es (Rep a Any)
forall (es :: [Effect]) p.
(Parser :> es) =>
Object -> Eff es (Rep a p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GParseObject f, Parser :> es) =>
Object -> Eff es (f p)
gParseObject Object
o
  parseValue Value
val = String -> Value -> Eff es a
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Object" Value
val


instance ToAsdf Int where
  toValue :: Int -> Value
toValue Int
n = Int64 -> Value
forall a. ToAsdf a => a -> Value
toValue (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Int64 Int
n)
instance FromAsdf Int where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Int
parseValue = (Int64 -> Int) -> Eff es Int64 -> Eff es Int
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Int) (Eff es Int64 -> Eff es Int)
-> (Value -> Eff es Int64) -> Value -> Eff es Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eff es Int64
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Int64
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue


instance ToAsdf Int8 where
  toValue :: Int8 -> Value
toValue Int8
n = Integer -> Value
Integer (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
n
instance FromAsdf Int8 where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Int8
parseValue = Value -> Eff es Int8
forall a (es :: [Effect]).
(Integral a, Parser :> es) =>
Value -> Eff es a
parseInteger


instance ToAsdf Int16 where
  toValue :: Int16 -> Value
toValue Int16
n = Integer -> Value
Integer (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
n
instance FromAsdf Int16 where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Int16
parseValue = Value -> Eff es Int16
forall a (es :: [Effect]).
(Integral a, Parser :> es) =>
Value -> Eff es a
parseInteger


instance ToAsdf Int32 where
  toValue :: Int32 -> Value
toValue Int32
n = Integer -> Value
Integer (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n
instance FromAsdf Int32 where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Int32
parseValue = Value -> Eff es Int32
forall a (es :: [Effect]).
(Integral a, Parser :> es) =>
Value -> Eff es a
parseInteger


instance ToAsdf Int64 where
  toValue :: Int64 -> Value
toValue Int64
n = Integer -> Value
Integer (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
instance FromAsdf Int64 where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Int64
parseValue = Value -> Eff es Int64
forall a (es :: [Effect]).
(Integral a, Parser :> es) =>
Value -> Eff es a
parseInteger


instance ToAsdf Integer where
  toValue :: Integer -> Value
toValue Integer
n = Integer -> Value
Integer (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
instance FromAsdf Integer where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Integer
parseValue = Value -> Eff es Integer
forall a (es :: [Effect]).
(Integral a, Parser :> es) =>
Value -> Eff es a
parseInteger


instance ToAsdf Double where
  toValue :: Double -> Value
toValue Double
n = Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
n
instance FromAsdf Double where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Double
parseValue = \case
    Number Scientific
n -> Double -> Eff es Double
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Eff es Double) -> Double -> Eff es Double
forall a b. (a -> b) -> a -> b
$ Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n
    Value
node -> String -> Value -> Eff es Double
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Double" Value
node


instance ToAsdf Float where
  toValue :: Float -> Value
toValue Float
n = Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Float -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Float
n
instance FromAsdf Float where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Float
parseValue = \case
    Number Scientific
n -> Float -> Eff es Float
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Eff es Float) -> Float -> Eff es Float
forall a b. (a -> b) -> a -> b
$ Scientific -> Float
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n
    Value
node -> String -> Value -> Eff es Float
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Float" Value
node


parseInteger :: (Integral a, Parser :> es) => Value -> Eff es a
parseInteger :: forall a (es :: [Effect]).
(Integral a, Parser :> es) =>
Value -> Eff es a
parseInteger = \case
  Integer Integer
n -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Eff es a) -> a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
  Value
node -> String -> Value -> Eff es a
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Integer" Value
node


instance {-# OVERLAPPABLE #-} (FromAsdf a) => FromAsdf [a] where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es [a]
parseValue = \case
    Array [Node]
ns -> (Node -> Eff es a) -> [Node] -> Eff es [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Node -> Eff es a
parseNode @a) [Node]
ns
    Value
node -> String -> Value -> Eff es [a]
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Array" Value
node
instance {-# OVERLAPPABLE #-} (ToAsdf a) => ToAsdf [a] where
  toValue :: [a] -> Value
toValue [a]
as = [Node] -> Value
Array ([Node] -> Value) -> [Node] -> Value
forall a b. (a -> b) -> a -> b
$ (a -> Node) -> [a] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Node
forall a. ToAsdf a => a -> Node
toNode [a]
as
instance {-# OVERLAPPABLE #-} (FromAsdf a) => FromAsdf (NonEmpty a) where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (NonEmpty a)
parseValue Value
val = do
    [a]
as <- forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue @[a] Value
val
    case [a]
as of
      [] -> String -> Value -> Eff es (NonEmpty a)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"NonEmpty List" Value
val
      (a
a : [a]
rest) -> NonEmpty a -> Eff es (NonEmpty a)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
rest)
instance {-# OVERLAPPABLE #-} (ToAsdf a) => ToAsdf (NonEmpty a) where
  toValue :: NonEmpty a -> Value
toValue NonEmpty a
as = [a] -> Value
forall a. ToAsdf a => a -> Value
toValue ([a] -> Value) -> [a] -> Value
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty a
as


instance (ToAsdf a, ToAsdf b) => ToAsdf (a, b) where
  toValue :: (a, b) -> Value
toValue (a
a, b
b) = [Node] -> Value
Array [a -> Node
forall a. ToAsdf a => a -> Node
toNode a
a, b -> Node
forall a. ToAsdf a => a -> Node
toNode b
b]
instance (FromAsdf a, FromAsdf b) => FromAsdf (a, b) where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es (a, b)
parseValue = \case
    Array [Node
n1, Node
n2] -> do
      a
a <- Value -> Eff es a
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
n1.value
      b
b <- Value -> Eff es b
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es b
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
n2.value
      (a, b) -> Eff es (a, b)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)
    Value
node -> String -> Value -> Eff es (a, b)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"[a, b]" Value
node


instance (ToAsdf a, ToAsdf b, ToAsdf c) => ToAsdf (a, b, c) where
  toValue :: (a, b, c) -> Value
toValue (a
a, b
b, c
c) = [Node] -> Value
Array [a -> Node
forall a. ToAsdf a => a -> Node
toNode a
a, b -> Node
forall a. ToAsdf a => a -> Node
toNode b
b, c -> Node
forall a. ToAsdf a => a -> Node
toNode c
c]
instance (FromAsdf a, FromAsdf b, FromAsdf c) => FromAsdf (a, b, c) where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (a, b, c)
parseValue = \case
    Array [Node
na, Node
nb, Node
nc] -> do
      a
a <- Value -> Eff es a
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
na.value
      b
b <- Value -> Eff es b
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es b
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
nb.value
      c
c <- Value -> Eff es c
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es c
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
nc.value
      (a, b, c) -> Eff es (a, b, c)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c)
    Value
node -> String -> Value -> Eff es (a, b, c)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"[a, b, c]" Value
node


instance (ToAsdf a, ToAsdf b, ToAsdf c, ToAsdf d) => ToAsdf (a, b, c, d) where
  toValue :: (a, b, c, d) -> Value
toValue (a
a, b
b, c
c, d
d) = [Node] -> Value
Array [a -> Node
forall a. ToAsdf a => a -> Node
toNode a
a, b -> Node
forall a. ToAsdf a => a -> Node
toNode b
b, c -> Node
forall a. ToAsdf a => a -> Node
toNode c
c, d -> Node
forall a. ToAsdf a => a -> Node
toNode d
d]
instance (FromAsdf a, FromAsdf b, FromAsdf c, FromAsdf d) => FromAsdf (a, b, c, d) where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (a, b, c, d)
parseValue = \case
    Array [Node
na, Node
nb, Node
nc, Node
nd] -> do
      a
a <- Value -> Eff es a
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
na.value
      b
b <- Value -> Eff es b
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es b
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
nb.value
      c
c <- Value -> Eff es c
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es c
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
nc.value
      d
d <- Value -> Eff es d
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es d
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Node
nd.value
      (a, b, c, d) -> Eff es (a, b, c, d)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c, d
d)
    Value
node -> String -> Value -> Eff es (a, b, c, d)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"[a, b, c, d]" Value
node


-- they will always serialize to Array
instance FromAsdf [Text] where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es [Text]
parseValue = Value -> Eff es [Text]
forall a (es :: [Effect]).
(FromAsdf a, FromNDArray [a], Parser :> es) =>
Value -> Eff es [a]
parseAnyList
instance FromAsdf [Int] where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es [Int]
parseValue = Value -> Eff es [Int]
forall a (es :: [Effect]).
(FromAsdf a, FromNDArray [a], Parser :> es) =>
Value -> Eff es [a]
parseAnyList
instance FromAsdf [Int8] where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es [Int8]
parseValue = Value -> Eff es [Int8]
forall a (es :: [Effect]).
(FromAsdf a, FromNDArray [a], Parser :> es) =>
Value -> Eff es [a]
parseAnyList
instance FromAsdf [Int16] where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es [Int16]
parseValue = Value -> Eff es [Int16]
forall a (es :: [Effect]).
(FromAsdf a, FromNDArray [a], Parser :> es) =>
Value -> Eff es [a]
parseAnyList
instance FromAsdf [Int32] where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es [Int32]
parseValue = Value -> Eff es [Int32]
forall a (es :: [Effect]).
(FromAsdf a, FromNDArray [a], Parser :> es) =>
Value -> Eff es [a]
parseAnyList
instance FromAsdf [Int64] where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es [Int64]
parseValue = Value -> Eff es [Int64]
forall a (es :: [Effect]).
(FromAsdf a, FromNDArray [a], Parser :> es) =>
Value -> Eff es [a]
parseAnyList
instance FromAsdf [Double] where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es [Double]
parseValue = Value -> Eff es [Double]
forall a (es :: [Effect]).
(FromAsdf a, FromNDArray [a], Parser :> es) =>
Value -> Eff es [a]
parseAnyList


-- | Flexibly parse lists from either Array or NDArray
parseAnyList :: (FromAsdf a, FromNDArray [a], Parser :> es) => Value -> Eff es [a]
parseAnyList :: forall a (es :: [Effect]).
(FromAsdf a, FromNDArray [a], Parser :> es) =>
Value -> Eff es [a]
parseAnyList = \case
  Array [Node]
ns -> (Node -> Eff es a) -> [Node] -> Eff es [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Node -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Node -> Eff es a
parseNode [Node]
ns
  NDArray NDArrayData
dat -> NDArrayData -> Eff es [a]
forall (es :: [Effect]).
(Parser :> es) =>
NDArrayData -> Eff es [a]
forall a (es :: [Effect]).
(FromNDArray a, Parser :> es) =>
NDArrayData -> Eff es a
fromNDArray NDArrayData
dat
  Value
node -> String -> Value -> Eff es [a]
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"[Double]" Value
node


instance (FromAsdf a) => FromAsdf (Maybe a) where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (Maybe a)
parseValue = \case
    Value
Null -> Maybe a -> Eff es (Maybe a)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Value
val -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Eff es a -> Eff es (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue @a Value
val
instance (ToAsdf a) => ToAsdf (Maybe a) where
  schema :: Maybe a -> SchemaTag
schema = SchemaTag -> (a -> SchemaTag) -> Maybe a -> SchemaTag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SchemaTag
forall a. Monoid a => a
mempty a -> SchemaTag
forall a. ToAsdf a => a -> SchemaTag
schema
  anchor :: Maybe a -> Maybe Anchor
anchor = Maybe Anchor -> (a -> Maybe Anchor) -> Maybe a -> Maybe Anchor
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Anchor
forall a. Maybe a
Nothing a -> Maybe Anchor
forall a. ToAsdf a => a -> Maybe Anchor
anchor
  toValue :: Maybe a -> Value
toValue Maybe a
Nothing = Value
Null
  toValue (Just a
a) = a -> Value
forall a. ToAsdf a => a -> Value
toValue a
a


instance (BinaryValue a, Prim a, AxesIndex ix) => FromAsdf (Array M.D ix a) where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (Array D ix a)
parseValue = \case
    NDArray NDArrayData
a -> NDArrayData -> Eff es (Array D ix a)
forall (es :: [Effect]).
(Parser :> es) =>
NDArrayData -> Eff es (Array D ix a)
forall a (es :: [Effect]).
(FromNDArray a, Parser :> es) =>
NDArrayData -> Eff es a
fromNDArray NDArrayData
a
    Value
node -> String -> Value -> Eff es (Array D ix a)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"NDArray" Value
node
instance (BinaryValue a, IsDataType a, Prim a, AxesIndex ix, PutArray ix) => ToAsdf (Array M.D ix a) where
  toValue :: Array D ix a -> Value
toValue Array D ix a
as = NDArrayData -> Value
NDArray (NDArrayData -> Value) -> NDArrayData -> Value
forall a b. (a -> b) -> a -> b
$ Array D ix a -> NDArrayData
forall a ix.
(IsDataType a, BinaryValue a, Prim a, AxesIndex ix, PutArray ix) =>
Array D ix a -> NDArrayData
ndArrayMassiv Array D ix a
as


instance ToAsdf Text where
  toValue :: Text -> Value
toValue = Text -> Value
String
instance FromAsdf Text where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Text
parseValue = \case
    String Text
t -> Text -> Eff es Text
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
    Value
node -> String -> Value -> Eff es Text
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Text" Value
node


instance ToAsdf String where
  toValue :: String -> Value
toValue = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
instance FromAsdf String where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es String
parseValue = \case
    String Text
t -> String -> Eff es String
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Eff es String) -> String -> Eff es String
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
t
    Value
node -> String -> Value -> Eff es String
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Text" Value
node


instance ToAsdf Bool where
  toValue :: Bool -> Value
toValue = Bool -> Value
Bool
instance FromAsdf Bool where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Bool
parseValue = \case
    Bool Bool
b -> Bool -> Eff es Bool
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    Value
node -> String -> Value -> Eff es Bool
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Bool" Value
node


instance ToAsdf Value where
  toValue :: Value -> Value
toValue = Value -> Value
forall a. a -> a
id
instance FromAsdf Value where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Value
parseValue = Value -> Eff es Value
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure


instance ToAsdf Node where
  toValue :: Node -> Value
toValue (Node SchemaTag
_ Maybe Anchor
_ Value
val) = Value
val
instance FromAsdf Node where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Node
parseValue Value
val = Node -> Eff es Node
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> Eff es Node) -> Node -> Eff es Node
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Maybe Anchor -> Value -> Node
Node SchemaTag
forall a. Monoid a => a
mempty Maybe Anchor
forall a. Maybe a
Nothing Value
val


instance ToAsdf Tree where
  toValue :: Tree -> Value
toValue (Tree Object
o) = Object -> Value
Object Object
o
instance FromAsdf Tree where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Tree
parseValue = \case
    Object Object
o -> Tree -> Eff es Tree
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree -> Eff es Tree) -> Tree -> Eff es Tree
forall a b. (a -> b) -> a -> b
$ Object -> Tree
Tree Object
o
    Value
val -> String -> Value -> Eff es Tree
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Object" Value
val


instance ToAsdf NDArrayData where
  toValue :: NDArrayData -> Value
toValue = NDArrayData -> Value
NDArray
instance FromAsdf NDArrayData where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es NDArrayData
parseValue = \case
    NDArray NDArrayData
nda -> NDArrayData -> Eff es NDArrayData
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NDArrayData
nda
    Value
node -> String -> Value -> Eff es NDArrayData
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"NDArray" Value
node


instance ToAsdf DataType where
  toValue :: DataType -> Value
toValue DataType
Float64 = Value
"float64"
  toValue DataType
Float32 = Value
"float32"
  toValue DataType
Int64 = Value
"int64"
  toValue DataType
Int32 = Value
"int32"
  toValue DataType
Int16 = Value
"int16"
  toValue DataType
Int8 = Value
"int8"
  toValue DataType
Bool8 = Value
"bool8"
  toValue (Ucs4 Int
n) = [Node] -> Value
Array [Node
"ucs4", Value -> Node
fromValue (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Integer (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n]
instance FromAsdf DataType where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es DataType
parseValue = \case
    String Text
"float64" -> DataType -> Eff es DataType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataType
Float64
    String Text
"float32" -> DataType -> Eff es DataType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataType
Float32
    String Text
"int64" -> DataType -> Eff es DataType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataType
Int64
    String Text
"int32" -> DataType -> Eff es DataType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataType
Int32
    String Text
"int16" -> DataType -> Eff es DataType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataType
Int16
    String Text
"int8" -> DataType -> Eff es DataType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataType
Int8
    String Text
"bool8" -> DataType -> Eff es DataType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataType
Bool8
    Array [Node
"ucs4", Node SchemaTag
_ Maybe Anchor
_ (Integer Integer
n)] -> DataType -> Eff es DataType
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataType -> Eff es DataType) -> DataType -> Eff es DataType
forall a b. (a -> b) -> a -> b
$ Int -> DataType
Ucs4 (Int -> DataType) -> Int -> DataType
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
    Value
val -> String -> Value -> Eff es DataType
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"DataType" Value
val


instance ToAsdf ByteOrder where
  toValue :: ByteOrder -> Value
toValue = \case
    ByteOrder
BigEndian -> Value
"big"
    ByteOrder
LittleEndian -> Value
"little"
instance FromAsdf ByteOrder where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es ByteOrder
parseValue = \case
    String Text
"big" -> ByteOrder -> Eff es ByteOrder
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteOrder
BigEndian
    String Text
"little" -> ByteOrder -> Eff es ByteOrder
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteOrder
LittleEndian
    Value
node -> String -> Value -> Eff es ByteOrder
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"ByteOrder" Value
node


instance ToAsdf (Axes Row) where
  toValue :: Axes 'Row -> Value
toValue (Axes [Int]
as) = [Int] -> Value
forall a. ToAsdf a => a -> Value
toValue [Int]
as


instance ToAsdf BlockSource where
  toValue :: BlockSource -> Value
toValue (BlockSource Int
s) = Int -> Value
forall a. ToAsdf a => a -> Value
toValue Int
s


instance ToAsdf UTCTime where
  toValue :: UTCTime -> Value
toValue UTCTime
t = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
t
instance FromAsdf UTCTime where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es UTCTime
parseValue Value
v = do
    String
ts <- forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue @String Value
v
    Either String UTCTime
res <- Eff (Fail : es) UTCTime -> Eff es (Either String UTCTime)
forall (es :: [Effect]) a.
HasCallStack =>
Eff (Fail : es) a -> Eff es (Either String a)
runFail (Eff (Fail : es) UTCTime -> Eff es (Either String UTCTime))
-> Eff (Fail : es) UTCTime -> Eff es (Either String UTCTime)
forall a b. (a -> b) -> a -> b
$ String -> Eff (Fail : es) UTCTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM String
ts
    case Either String UTCTime
res of
      Left String
e -> String -> Eff es UTCTime
forall (es :: [Effect]) a. (Parser :> es) => String -> Eff es a
parseFail String
e
      Right UTCTime
a -> UTCTime -> Eff es UTCTime
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
a


-- | Parse a node, ignoring the schema tag
parseNode :: (FromAsdf a, Parser :> es) => Node -> Eff es a
parseNode :: forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Node -> Eff es a
parseNode (Node SchemaTag
_ Maybe Anchor
_ Value
v) = Value -> Eff es a
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Value
v


{- | Parse a key from an 'Object'

> instance FromAsdf User where
>   parseValue = \case
>     Object o -> do
>       name <- o .: "name"
>       age <- o .: "age"
>       pure $ User{name, age}
-}
(.:) :: (FromAsdf a, Parser :> es) => Object -> Key -> Eff es a
Object
o .: :: forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Text -> Eff es a
.: Text
k = do
  case Text -> Object -> Maybe Node
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k Object
o of
    Maybe Node
Nothing -> String -> Eff es a
forall (es :: [Effect]) a. (Parser :> es) => String -> Eff es a
parseFail (String -> Eff es a) -> String -> Eff es a
forall a b. (a -> b) -> a -> b
$ String
"key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
    Just Node
node ->
      Ref -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Parser :> es) =>
Ref -> Eff es a -> Eff es a
parseAt (Text -> Ref
Child Text
k) (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Node -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Node -> Eff es a
parseNode Node
node


-- | Parse an optional key from an 'Object'
(.:?) :: (FromAsdf a, Parser :> es) => Object -> Key -> Eff es (Maybe a)
Object
o .:? :: forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Text -> Eff es (Maybe a)
.:? Text
k = do
  case Text -> Object -> Maybe Node
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k Object
o of
    Maybe Node
Nothing -> Maybe a -> Eff es (Maybe a)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just Node
a ->
      a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Eff es a -> Eff es (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Ref -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Parser :> es) =>
Ref -> Eff es a -> Eff es a
parseAt (Text -> Ref
Child Text
k) (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Node -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Node -> Eff es a
parseNode Node
a


{- | Parse a child at the given array index
 -
> instance FromAsdf Friends where
>   parseValue = \case
>     Array ns -> do
>       best <- ns ! 0
>       second <- ns ! 1
>       other <- mapM parseNode ns
>       pure $ Friends{best, second, other}
-}
(!) :: (FromAsdf a, Parser :> es) => [Node] -> Int -> Eff es a
[Node]
ns ! :: forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
[Node] -> Int -> Eff es a
! Int
n = do
  case [Node]
ns [Node] -> Int -> Maybe Node
forall a. [a] -> Int -> Maybe a
!? Int
n of
    Maybe Node
Nothing -> String -> Eff es a
forall (es :: [Effect]) a. (Parser :> es) => String -> Eff es a
parseFail (String -> Eff es a) -> String -> Eff es a
forall a b. (a -> b) -> a -> b
$ String
"Index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
    Just Node
node ->
      Ref -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Parser :> es) =>
Ref -> Eff es a -> Eff es a
parseAt (Int -> Ref
Index Int
n) (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Node -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Node -> Eff es a
parseNode Node
node


-- | Generically serialize records to an 'Object'
class GToObject f where
  gToObject :: f p -> Object


instance (GToObject f) => GToObject (M1 D c f) where
  gToObject :: forall (p :: k). M1 D c f p -> Object
gToObject (M1 f p
f) = f p -> Object
forall (p :: k). f p -> Object
forall {k} (f :: k -> *) (p :: k). GToObject f => f p -> Object
gToObject f p
f


instance (GToObject f) => GToObject (M1 C c f) where
  gToObject :: forall (p :: k). M1 C c f p -> Object
gToObject (M1 f p
f) = f p -> Object
forall (p :: k). f p -> Object
forall {k} (f :: k -> *) (p :: k). GToObject f => f p -> Object
gToObject f p
f


instance (GToObject f, GToObject g) => GToObject (f :*: g) where
  gToObject :: forall (p :: k). (:*:) f g p -> Object
gToObject (f p
f :*: g p
g) = f p -> Object
forall (p :: k). f p -> Object
forall {k} (f :: k -> *) (p :: k). GToObject f => f p -> Object
gToObject f p
f Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> g p -> Object
forall (p :: k). g p -> Object
forall {k} (f :: k -> *) (p :: k). GToObject f => f p -> Object
gToObject g p
g


instance (GToNode f, Selector s) => GToObject (M1 S s f) where
  gToObject :: forall (p :: k). M1 S s f p -> Object
gToObject (M1 f p
f) =
    let s :: String
s = M1 S s f Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s f p
forall {p :: k}. M1 S s f p
forall a. HasCallStack => a
undefined :: M1 S s f p)
     in [(String -> Text
pack String
s, f p -> Node
forall (p :: k). f p -> Node
forall {k} (f :: k -> *) (p :: k). GToNode f => f p -> Node
gToNode f p
f)]


-- | Generically serialize record values to a 'Node'
class GToNode f where
  gToNode :: f p -> Node


instance {-# OVERLAPPABLE #-} (ToAsdf a) => GToNode (K1 R a) where
  gToNode :: forall (p :: k). K1 R a p -> Node
gToNode (K1 a
a) = a -> Node
forall a. ToAsdf a => a -> Node
toNode a
a


instance {-# OVERLAPPING #-} (ToAsdf a) => GToNode (K1 R (Maybe a)) where
  gToNode :: forall (p :: k). K1 R (Maybe a) p -> Node
gToNode (K1 Maybe a
a) = Maybe a -> Node
forall a. ToAsdf a => a -> Node
toNode Maybe a
a


-- | Generically parse 'Object's into records
class GParseObject f where
  gParseObject :: (Parser :> es) => Object -> Eff es (f p)


instance (GParseObject f) => GParseObject (M1 D c f) where
  gParseObject :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Eff es (M1 D c f p)
gParseObject Object
o = f p -> M1 D c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D c f p) -> Eff es (f p) -> Eff es (M1 D c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Eff es (f p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Eff es (f p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GParseObject f, Parser :> es) =>
Object -> Eff es (f p)
gParseObject Object
o


instance (GParseObject f) => GParseObject (M1 C c f) where
  gParseObject :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Eff es (M1 C c f p)
gParseObject Object
o = f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 C c f p) -> Eff es (f p) -> Eff es (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Eff es (f p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Eff es (f p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GParseObject f, Parser :> es) =>
Object -> Eff es (f p)
gParseObject Object
o


instance (GParseObject f, GParseObject g) => GParseObject (f :*: g) where
  gParseObject :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Eff es ((:*:) f g p)
gParseObject Object
o = do
    f p
f <- Object -> Eff es (f p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Eff es (f p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GParseObject f, Parser :> es) =>
Object -> Eff es (f p)
gParseObject Object
o
    g p
g <- Object -> Eff es (g p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Eff es (g p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GParseObject f, Parser :> es) =>
Object -> Eff es (f p)
gParseObject Object
o
    (:*:) f g p -> Eff es ((:*:) f g p)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((:*:) f g p -> Eff es ((:*:) f g p))
-> (:*:) f g p -> Eff es ((:*:) f g p)
forall a b. (a -> b) -> a -> b
$ f p
f f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
g


instance (GParseKey f, Selector s) => GParseObject (M1 S s f) where
  gParseObject :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Eff es (M1 S s f p)
gParseObject Object
o = do
    let k :: Text
k = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 S s f Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s f p
forall {p :: k}. M1 S s f p
forall a. HasCallStack => a
undefined :: M1 S s f p)
    f p -> M1 S s f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 S s f p) -> Eff es (f p) -> Eff es (M1 S s f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Text -> Eff es (f p)
forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Text -> Eff es (f p)
forall {k} (f :: k -> *) (es :: [Effect]) (p :: k).
(GParseKey f, Parser :> es) =>
Object -> Text -> Eff es (f p)
gParseKey Object
o Text
k


-- | Generically parse a key from an 'Object' into a record value
class GParseKey f where
  gParseKey :: (Parser :> es) => Object -> Key -> Eff es (f p)


instance {-# OVERLAPPABLE #-} (FromAsdf a) => GParseKey (K1 R a) where
  gParseKey :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Text -> Eff es (K1 R a p)
gParseKey Object
o Text
k = a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 R a p) -> Eff es a -> Eff es (K1 R a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Text -> Eff es a
.: Text
k


instance {-# OVERLAPPABLE #-} (FromAsdf a) => GParseKey (K1 R (Maybe a)) where
  gParseKey :: forall (es :: [Effect]) (p :: k).
(Parser :> es) =>
Object -> Text -> Eff es (K1 R (Maybe a) p)
gParseKey Object
o Text
k = Maybe a -> K1 R (Maybe a) p
forall k i c (p :: k). c -> K1 i c p
K1 (Maybe a -> K1 R (Maybe a) p)
-> Eff es (Maybe a) -> Eff es (K1 R (Maybe a) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Eff es (Maybe a)
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Text -> Eff es (Maybe a)
.:? Text
k