{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-} -- for the custom type error
--------------------------------------------------------------------------------
-- |
-- Module      : Typson.JsonTree
-- Description : Provides the core type classes and data structures for JSON
--   representation
-- Copyright   : (c) Aaron Allen, 2020
-- Maintainer  : Aaron Allen <aaronallen8455@gmail.com>
-- License     : BSD-style (see the file LICENSE)
-- Stability   : experimental
-- Portability : non-portable
--
--------------------------------------------------------------------------------
module Typson.JsonTree
  ( -- * Schema Semantics
    -- | Type classes and type-level data structures for representing the
    -- JSON structure of data.

    -- ** Defining JSON Schemas
    ObjectSYM(..)
  , FieldSYM(..)
  , UnionSYM(..)
  , JsonSchema
  , key
    -- ** Core Interpreters
    -- | A single schema can be interpreted in different ways. This allows it to
    -- be used as both an encoder and decoder.
    -- Because the schema semantics are using the final tagless style, users are
    -- able to write their own interpreters.
  , ObjectEncoder(..)
  , ObjectDecoder(..)
  , ObjectTree(..)
  -- ** Specialized Indexed Free Applicative
  , TreeBuilder
  , (<<$>)
  , (<<*>)
  , runAp
  , runAp_
    -- ** Core Data Structure
  , type Tree(..)
  , type Edge(..)
  , type Aggregator(..)
  , type Multiplicity(..)
  , NoDuplicateKeys
  ) where

import           Control.Monad ((<=<))
import           Data.Aeson ((.:), (.:?), (.=), FromJSON, ToJSON, FromJSONKey, ToJSONKey)
import qualified Data.Aeson.Types as Aeson
import           Data.Functor.Identity (Identity(..))
import qualified Data.HashMap.Strict as HM
import           Data.Kind (Constraint, Type)
import qualified Data.Map.Strict as M
import           Data.Proxy (Proxy(..))
import qualified Data.Set as S
import           Data.String (IsString)
import qualified Data.Text as T
import qualified Data.Vector as V
import           GHC.TypeLits (ErrorMessage(..), KnownSymbol, Nat, Symbol, TypeError, symbolVal)

--------------------------------------------------------------------------------
-- Type-level JSON Tree Representation
--------------------------------------------------------------------------------

-- | This is the data structure used to represent the JSON form of a haskell type. It is
-- only used at the type level via the @DataKinds@ extension. You shouldn't write
-- this type yourself, instead it's recommended that you let the compiler infer
-- it using the @PartialTypeSignatures@ extension and turning off warnings for
-- partial signatures using @-fno-warn-partial-type-signatures@. The @Tree@
-- argument in the type signatures of your schemas can then be filled with @_@.
--
-- @
--    personJ :: JsonSchema _ Person
-- @
data Tree = Node Aggregator [Edge] -- Invariant: [Edge] is non-empty
          | IndexedNode Type Tree
          -- ^ A node representing a container indexed by some kind
          | Leaf

data Edge
  = Edge
      Symbol       -- ^ The json field key
      Multiplicity -- ^ The multiplicity of the field's value
      Type         -- ^ The type of the value at the key
      Tree         -- ^ 'Tree' for the value's type

data Aggregator
  = Product -- ^ Object has all fields from a list
  | Sum     -- ^ Object has exactly one field from a list of possible fields

data Multiplicity
  = Singleton -- ^ A non-null field
  | Nullable  -- ^ A field that can be @null@

--------------------------------------------------------------------------------
-- Final-tagless "Symantics" for Object Construction
--------------------------------------------------------------------------------

-- | Used to interpret JSON trees for haskell record types.
class FieldSYM repr => ObjectSYM (repr :: Tree -> Type -> Type) where
  -- | Declares the schema for a record type.
  --
  -- @
  --    data Person =
  --      Person
  --        { name :: Text
  --        , age  :: Int
  --        }
  --
  --    personJ :: JsonSchema _ Person
  --    personJ = object \"Person\" $
  --      Person
  --        \<\<$> field (key \@\"name\") name prim
  --        \<\<*> field (key \@\"age\") age prim
  -- @
  object :: ( tree ~ 'Node 'Product edges
            , NoDuplicateKeys o edges
            )
         => String -- ^ Name of the object as it will appear in parse errors
         -> TreeBuilder (Field repr o) tree o -- ^ The collection of fields
         -> repr tree o

  -- | Serves as a schema for a type that cannot itself be broken down into
  -- named fields. The type must have 'FromJSON' and 'ToJSON' instances.
  prim :: ( FromJSON v
          , ToJSON v
          )
       => repr 'Leaf v

  -- | Given a schema for some type @a@, create a schema for @[a]@.
  --
  -- This will allow you to write queries specifying an index into the list:
  --
  -- @
  --    type ListQuery = \"foo\" :-> \"bar\" :-> 3 :-> \"baz\"
  -- @
  list :: repr tree o -- ^ Element schema
       -> repr ('IndexedNode Nat tree) [o]

  -- | Produces a schema for a 'Map' given a schema for it's elements type. The
  -- key of the map should be some sort of string.
  -- You can have arbitrary keys when constructing a query path into a @textMap@
  -- schema.
  textMap :: (FromJSONKey k, ToJSONKey k, IsString k, Ord k)
          => repr tree o -- ^ Element schema
          -> repr ('IndexedNode Symbol tree) (M.Map k o)

  -- | Construct a 'Set' schema given a schema for it's elements.
  set :: Ord o
      => repr tree o -- ^ Element schema
      -> repr ('IndexedNode Nat tree) (S.Set o)

  -- | Construct a 'Vector' schema given a schema for it's elements.
  vector :: repr tree o -- ^ Element schema
         -> repr ('IndexedNode Nat tree) (V.Vector o)

class FieldSYM repr where
  data Field repr :: Type -> Tree -> Type -> Type

  -- | Defines a required field
  field :: ( KnownSymbol key
           , edge ~ 'Edge key 'Singleton field subTree
           , tree ~ 'Node 'Product '[edge]
           )
        => proxy key -- ^ The 'Symbol' to use as the key in the JSON object
        -> (obj -> field) -- ^ The accessor for the field
        -> repr subTree field -- ^ Schema for the type of the field
        -> Field repr obj tree field

  -- | Defines an optional field. Will parse 'Nothing' for either a @null@ JSON
  -- value or if the key is missing. Will encode 'Nothing' as @null@.
  optField :: ( KnownSymbol key
              , edge ~ 'Edge key 'Nullable field subTree
              , tree ~ 'Node 'Product '[edge]
              )
           => proxy key -- ^ The 'Symbol' to use as the key in the JSON object
           -> (obj -> Maybe field) -- ^ The accessor for the field
           -> repr subTree field -- ^ Schema for the type of the field
           -> Field repr obj tree (Maybe field)

  -- | Defines an optional field where parsing will emit the given default value
  -- if the field is @null@ or the key is absent.
  optFieldDef :: ( KnownSymbol key
                 , edge ~ 'Edge key 'Singleton field subTree
                 , tree ~ 'Node 'Product '[edge]
                 )
              => proxy key -- ^ The 'Symbol' to use as the key in the JSON object
              -> (obj -> field) -- ^ The accessor for the field
              -> field -- ^ Default value to emit
              -> repr subTree field -- ^ Schema for the type of the field
              -> Field repr obj tree field
  optFieldDef p :: proxy key
p getter :: obj -> field
getter _ sub :: repr subTree field
sub = proxy key
-> (obj -> field)
-> repr subTree field
-> Field repr obj tree field
forall (repr :: Tree -> * -> *) (key :: Symbol) (edge :: Edge)
       field (subTree :: Tree) (tree :: Tree) (proxy :: Symbol -> *) obj.
(FieldSYM repr, KnownSymbol key,
 edge ~ 'Edge key 'Singleton field subTree,
 tree ~ 'Node 'Product '[edge]) =>
proxy key
-> (obj -> field)
-> repr subTree field
-> Field repr obj tree field
field proxy key
p obj -> field
getter repr subTree field
sub

-- | Used to interpret JSON trees for haskell sum types.
class UnionSYM (repr :: Tree -> Type -> Type) where
  -- | The result produced from each tag
  type Result repr union :: Type
  data Tag repr :: Type -> Tree -> Type -> Type

  -- | Declares a schema for a tagged sum type
  --
  -- @
  --    data Classifier
  --      = Flora Plant
  --      | Fauna Animal
  --
  --    classifierJ :: JsonSchema _ Classifier
  --    classifierJ = union \"Classifier\" $
  --      classifierTags
  --        \<\<$> tag (key \@\"flora\") Flora plantJ
  --        \<\<*> tag (key \@"\fauna\") Fauna animalJ
  -- @
  --
  -- The resulting JSON is an object with a single field with a key/value pair
  -- corresponding to one of the branches of the sum type.
  union :: ( tree ~ 'Node 'Sum edges
           , NoDuplicateKeys union edges
           )
        => String -- ^ Name of the union as it will appear in parse errors
        -> TreeBuilder (Tag repr union) tree (union -> Result repr union)
           -- ^ A collection of tags, one for each branch of the union
        -> repr tree union

  -- | Used to declare a single branch of a sum type. The constructor for the
  -- branch should take a single argument. If you require more than one argument
  -- then you should package them up into a separate record type.
  tag :: ( KnownSymbol name
         , edge ~ 'Edge name 'Nullable v subTree
         , tree ~ 'Node 'Sum '[edge]
         )
      => proxy name -- ^ 'Symbol' used as the JSON key for the field
      -> (v -> union) -- ^ Data constructor
      -> repr subTree v -- ^ Schema for the value that this branch tags
      -> Tag repr union tree (v -> Result repr union)

-- | A rank-N type synonym used in the type signature of JSON schemas
type JsonSchema t a = forall repr. (ObjectSYM repr, UnionSYM repr) => repr t a

-- | A synonym for 'Proxy' that takes a 'Symbol'. Intended to be used in 'field'
-- and 'tag' definitions.
key :: Proxy (key :: Symbol)
key :: Proxy key
key = Proxy key
forall k (t :: k). Proxy t
Proxy

--------------------------------------------------------------------------------
-- Tree Proxy
--------------------------------------------------------------------------------

data TreeProxy (t :: Tree) o = TreeProxy

-- | Used to pass a 'Tree' around at the value level.
newtype ObjectTree (t :: Tree) o =
  ObjectTree { ObjectTree t o -> TreeProxy t o
getObjectTree :: TreeProxy t o }

instance ObjectSYM ObjectTree where
  object :: String
-> TreeBuilder (Field ObjectTree o) tree o -> ObjectTree tree o
object _ _ = TreeProxy tree o -> ObjectTree tree o
forall (t :: Tree) o. TreeProxy t o -> ObjectTree t o
ObjectTree TreeProxy tree o
forall (t :: Tree) o. TreeProxy t o
TreeProxy
  list :: ObjectTree tree o -> ObjectTree ('IndexedNode Nat tree) [o]
list _ = TreeProxy ('IndexedNode Nat tree) [o]
-> ObjectTree ('IndexedNode Nat tree) [o]
forall (t :: Tree) o. TreeProxy t o -> ObjectTree t o
ObjectTree TreeProxy ('IndexedNode Nat tree) [o]
forall (t :: Tree) o. TreeProxy t o
TreeProxy
  textMap :: ObjectTree tree o
-> ObjectTree ('IndexedNode Symbol tree) (Map k o)
textMap _ = TreeProxy ('IndexedNode Symbol tree) (Map k o)
-> ObjectTree ('IndexedNode Symbol tree) (Map k o)
forall (t :: Tree) o. TreeProxy t o -> ObjectTree t o
ObjectTree TreeProxy ('IndexedNode Symbol tree) (Map k o)
forall (t :: Tree) o. TreeProxy t o
TreeProxy
  set :: ObjectTree tree o -> ObjectTree ('IndexedNode Nat tree) (Set o)
set _ = TreeProxy ('IndexedNode Nat tree) (Set o)
-> ObjectTree ('IndexedNode Nat tree) (Set o)
forall (t :: Tree) o. TreeProxy t o -> ObjectTree t o
ObjectTree TreeProxy ('IndexedNode Nat tree) (Set o)
forall (t :: Tree) o. TreeProxy t o
TreeProxy
  vector :: ObjectTree tree o -> ObjectTree ('IndexedNode Nat tree) (Vector o)
vector _ = TreeProxy ('IndexedNode Nat tree) (Vector o)
-> ObjectTree ('IndexedNode Nat tree) (Vector o)
forall (t :: Tree) o. TreeProxy t o -> ObjectTree t o
ObjectTree TreeProxy ('IndexedNode Nat tree) (Vector o)
forall (t :: Tree) o. TreeProxy t o
TreeProxy
  prim :: ObjectTree 'Leaf v
prim = TreeProxy 'Leaf v -> ObjectTree 'Leaf v
forall (t :: Tree) o. TreeProxy t o -> ObjectTree t o
ObjectTree TreeProxy 'Leaf v
forall (t :: Tree) o. TreeProxy t o
TreeProxy

instance FieldSYM ObjectTree where
  data Field ObjectTree o t a = FieldProxy
  field :: proxy key
-> (obj -> field)
-> ObjectTree subTree field
-> Field ObjectTree obj tree field
field _ _ _ = Field ObjectTree obj tree field
forall o (t :: Tree) a. Field ObjectTree o t a
FieldProxy
  optField :: proxy key
-> (obj -> Maybe field)
-> ObjectTree subTree field
-> Field ObjectTree obj tree (Maybe field)
optField _ _ _ = Field ObjectTree obj tree (Maybe field)
forall o (t :: Tree) a. Field ObjectTree o t a
FieldProxy

instance UnionSYM ObjectTree where
  data Tag ObjectTree u t a = TagProxy
  type Result ObjectTree u = ()
  union :: String
-> TreeBuilder
     (Tag ObjectTree union) tree (union -> Result ObjectTree union)
-> ObjectTree tree union
union _ _ = TreeProxy tree union -> ObjectTree tree union
forall (t :: Tree) o. TreeProxy t o -> ObjectTree t o
ObjectTree TreeProxy tree union
forall (t :: Tree) o. TreeProxy t o
TreeProxy
  tag :: proxy name
-> (v -> union)
-> ObjectTree subTree v
-> Tag ObjectTree union tree (v -> Result ObjectTree union)
tag _ _ _ = Tag ObjectTree union tree (v -> Result ObjectTree union)
forall u (t :: Tree) a. Tag ObjectTree u t a
TagProxy

--------------------------------------------------------------------------------
-- JSON Encoding
--------------------------------------------------------------------------------

-- | Use a 'Tree' to encode a type as an Aeson 'Value'
newtype ObjectEncoder (t :: Tree) o =
  ObjectEncoder
    { -- | Uses a schema as a JSON encoder
      --
      -- @
      --    instance ToJSON Person where
      --      toJSON = encodeObject personJ
      -- @
      ObjectEncoder t o -> o -> Value
encodeObject :: o -> Aeson.Value
    }

instance ObjectSYM ObjectEncoder where
  object :: String
-> TreeBuilder (Field ObjectEncoder o) tree o
-> ObjectEncoder tree o
object _ fields :: TreeBuilder (Field ObjectEncoder o) tree o
fields = (o -> Value) -> ObjectEncoder tree o
forall (t :: Tree) o. (o -> Value) -> ObjectEncoder t o
ObjectEncoder ((o -> Value) -> ObjectEncoder tree o)
-> (o -> Value) -> ObjectEncoder tree o
forall a b. (a -> b) -> a -> b
$ \o :: o
o ->
    Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (forall a' (t' :: Tree). Field ObjectEncoder o t' a' -> Object)
-> TreeBuilder (Field ObjectEncoder o) tree o -> Object
forall m (f :: Tree -> * -> *) (t :: Tree) a.
Monoid m =>
(forall a' (t' :: Tree). f t' a' -> m) -> TreeBuilder f t a -> m
runAp_ (Field ObjectEncoder o t' a' -> o -> Object
forall o (t :: Tree) a. Field ObjectEncoder o t a -> o -> Object
`unFieldEncoder` o
o) TreeBuilder (Field ObjectEncoder o) tree o
fields
  list :: ObjectEncoder tree o -> ObjectEncoder ('IndexedNode Nat tree) [o]
list (ObjectEncoder e :: o -> Value
e) = ([o] -> Value) -> ObjectEncoder ('IndexedNode Nat tree) [o]
forall (t :: Tree) o. (o -> Value) -> ObjectEncoder t o
ObjectEncoder (([o] -> Value) -> ObjectEncoder ('IndexedNode Nat tree) [o])
-> ([o] -> Value) -> ObjectEncoder ('IndexedNode Nat tree) [o]
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ([Value] -> Value) -> ([o] -> [Value]) -> [o] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> Value) -> [o] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map o -> Value
e
  textMap :: ObjectEncoder tree o
-> ObjectEncoder ('IndexedNode Symbol tree) (Map k o)
textMap (ObjectEncoder e :: o -> Value
e) = (Map k o -> Value)
-> ObjectEncoder ('IndexedNode Symbol tree) (Map k o)
forall (t :: Tree) o. (o -> Value) -> ObjectEncoder t o
ObjectEncoder ((Map k o -> Value)
 -> ObjectEncoder ('IndexedNode Symbol tree) (Map k o))
-> (Map k o -> Value)
-> ObjectEncoder ('IndexedNode Symbol tree) (Map k o)
forall a b. (a -> b) -> a -> b
$ Map k Value -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Map k Value -> Value)
-> (Map k o -> Map k Value) -> Map k o -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> Value) -> Map k o -> Map k Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap o -> Value
e
  set :: ObjectEncoder tree o
-> ObjectEncoder ('IndexedNode Nat tree) (Set o)
set (ObjectEncoder e :: o -> Value
e) = (Set o -> Value) -> ObjectEncoder ('IndexedNode Nat tree) (Set o)
forall (t :: Tree) o. (o -> Value) -> ObjectEncoder t o
ObjectEncoder ((Set o -> Value) -> ObjectEncoder ('IndexedNode Nat tree) (Set o))
-> (Set o -> Value)
-> ObjectEncoder ('IndexedNode Nat tree) (Set o)
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ([Value] -> Value) -> (Set o -> [Value]) -> Set o -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> Value) -> [o] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map o -> Value
e ([o] -> [Value]) -> (Set o -> [o]) -> Set o -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set o -> [o]
forall a. Set a -> [a]
S.toList
  vector :: ObjectEncoder tree o
-> ObjectEncoder ('IndexedNode Nat tree) (Vector o)
vector (ObjectEncoder e :: o -> Value
e) = (Vector o -> Value)
-> ObjectEncoder ('IndexedNode Nat tree) (Vector o)
forall (t :: Tree) o. (o -> Value) -> ObjectEncoder t o
ObjectEncoder ((Vector o -> Value)
 -> ObjectEncoder ('IndexedNode Nat tree) (Vector o))
-> (Vector o -> Value)
-> ObjectEncoder ('IndexedNode Nat tree) (Vector o)
forall a b. (a -> b) -> a -> b
$ Vector Value -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Vector Value -> Value)
-> (Vector o -> Vector Value) -> Vector o -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> Value) -> Vector o -> Vector Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap o -> Value
e
  prim :: ObjectEncoder 'Leaf v
prim = (v -> Value) -> ObjectEncoder 'Leaf v
forall (t :: Tree) o. (o -> Value) -> ObjectEncoder t o
ObjectEncoder v -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON

instance FieldSYM ObjectEncoder where
  newtype Field ObjectEncoder o t a =
    FieldEncoder { Field ObjectEncoder o t a -> o -> Object
unFieldEncoder :: o -> Aeson.Object }
  field :: proxy key
-> (obj -> field)
-> ObjectEncoder subTree field
-> Field ObjectEncoder obj tree field
field ky :: proxy key
ky acc :: obj -> field
acc (ObjectEncoder so :: field -> Value
so) =
    (obj -> Object) -> Field ObjectEncoder obj tree field
forall o (t :: Tree) a. (o -> Object) -> Field ObjectEncoder o t a
FieldEncoder ((obj -> Object) -> Field ObjectEncoder obj tree field)
-> (obj -> Object) -> Field ObjectEncoder obj tree field
forall a b. (a -> b) -> a -> b
$ \o :: obj
o -> String -> Text
T.pack (proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy key
ky) Text -> Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= field -> Value
so (obj -> field
acc obj
o)
  optField :: proxy key
-> (obj -> Maybe field)
-> ObjectEncoder subTree field
-> Field ObjectEncoder obj tree (Maybe field)
optField ky :: proxy key
ky acc :: obj -> Maybe field
acc (ObjectEncoder so :: field -> Value
so) =
    (obj -> Object) -> Field ObjectEncoder obj tree (Maybe field)
forall o (t :: Tree) a. (o -> Object) -> Field ObjectEncoder o t a
FieldEncoder ((obj -> Object) -> Field ObjectEncoder obj tree (Maybe field))
-> (obj -> Object) -> Field ObjectEncoder obj tree (Maybe field)
forall a b. (a -> b) -> a -> b
$ \o :: obj
o -> String -> Text
T.pack (proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy key
ky) Text -> Maybe Value -> Object
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (field -> Value
so (field -> Value) -> Maybe field -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> obj -> Maybe field
acc obj
o)

instance UnionSYM ObjectEncoder where
  newtype Tag ObjectEncoder u t a =
    TagEncoder { Tag ObjectEncoder u t a -> a
unTagEncoder :: a }
  type Result ObjectEncoder u = Aeson.Value
  union :: String
-> TreeBuilder
     (Tag ObjectEncoder union)
     tree
     (union -> Result ObjectEncoder union)
-> ObjectEncoder tree union
union _ tags :: TreeBuilder
  (Tag ObjectEncoder union)
  tree
  (union -> Result ObjectEncoder union)
tags = (union -> Value) -> ObjectEncoder tree union
forall (t :: Tree) o. (o -> Value) -> ObjectEncoder t o
ObjectEncoder ((union -> Value) -> ObjectEncoder tree union)
-> (union -> Value) -> ObjectEncoder tree union
forall a b. (a -> b) -> a -> b
$
    Identity (union -> Value) -> union -> Value
forall a. Identity a -> a
runIdentity ((forall a' (t' :: Tree).
 Tag ObjectEncoder union t' a' -> Identity a')
-> TreeBuilder (Tag ObjectEncoder union) tree (union -> Value)
-> Identity (union -> Value)
forall (g :: * -> *) (f :: Tree -> * -> *) (t :: Tree) a.
Applicative g =>
(forall a' (t' :: Tree). f t' a' -> g a')
-> TreeBuilder f t a -> g a
runAp (a' -> Identity a'
forall a. a -> Identity a
Identity (a' -> Identity a')
-> (Tag ObjectEncoder union t' a' -> a')
-> Tag ObjectEncoder union t' a'
-> Identity a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag ObjectEncoder union t' a' -> a'
forall u (t :: Tree) a. Tag ObjectEncoder u t a -> a
unTagEncoder) TreeBuilder (Tag ObjectEncoder union) tree (union -> Value)
TreeBuilder
  (Tag ObjectEncoder union)
  tree
  (union -> Result ObjectEncoder union)
tags)
  tag :: proxy name
-> (v -> union)
-> ObjectEncoder subTree v
-> Tag ObjectEncoder union tree (v -> Result ObjectEncoder union)
tag name :: proxy name
name _ valueEncoder :: ObjectEncoder subTree v
valueEncoder =
    (v -> Value)
-> Tag ObjectEncoder union tree (v -> Result ObjectEncoder union)
forall u (t :: Tree) a. a -> Tag ObjectEncoder u t a
TagEncoder ((v -> Value)
 -> Tag ObjectEncoder union tree (v -> Result ObjectEncoder union))
-> (v -> Value)
-> Tag ObjectEncoder union tree (v -> Result ObjectEncoder union)
forall a b. (a -> b) -> a -> b
$ \v :: v
v ->
      [Pair] -> Value
Aeson.object
        [ String -> Text
T.pack (proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy name
name) Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ObjectEncoder subTree v -> v -> Value
forall (t :: Tree) o. ObjectEncoder t o -> o -> Value
encodeObject ObjectEncoder subTree v
valueEncoder v
v ]

--------------------------------------------------------------------------------
-- JSON Decoding
--------------------------------------------------------------------------------

-- | Use a 'Tree' to decode a type from an Aeson 'Value'
newtype ObjectDecoder (t :: Tree) o =
  ObjectDecoder
    { -- | Uses a schema as a JSON parser
      --
      -- @
      --    instance FromJSON Person where
      --      parseJSON = decodeObject personJ
      -- @
      ObjectDecoder t o -> Value -> Parser o
decodeObject :: Aeson.Value -> Aeson.Parser o
    }

instance ObjectSYM ObjectDecoder where
  object :: String
-> TreeBuilder (Field ObjectDecoder o) tree o
-> ObjectDecoder tree o
object name :: String
name fields :: TreeBuilder (Field ObjectDecoder o) tree o
fields = (Value -> Parser o) -> ObjectDecoder tree o
forall (t :: Tree) o. (Value -> Parser o) -> ObjectDecoder t o
ObjectDecoder ((Value -> Parser o) -> ObjectDecoder tree o)
-> ((Object -> Parser o) -> Value -> Parser o)
-> (Object -> Parser o)
-> ObjectDecoder tree o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Object -> Parser o) -> Value -> Parser o
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
name ((Object -> Parser o) -> ObjectDecoder tree o)
-> (Object -> Parser o) -> ObjectDecoder tree o
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj ->
    (forall a' (t' :: Tree). Field ObjectDecoder o t' a' -> Parser a')
-> TreeBuilder (Field ObjectDecoder o) tree o -> Parser o
forall (g :: * -> *) (f :: Tree -> * -> *) (t :: Tree) a.
Applicative g =>
(forall a' (t' :: Tree). f t' a' -> g a')
-> TreeBuilder f t a -> g a
runAp (Field ObjectDecoder o t' a' -> Object -> Parser a'
forall o (t :: Tree) a.
Field ObjectDecoder o t a -> Object -> Parser a
`unFieldDecoder` Object
obj) TreeBuilder (Field ObjectDecoder o) tree o
fields
  list :: ObjectDecoder tree o -> ObjectDecoder ('IndexedNode Nat tree) [o]
list (ObjectDecoder d :: Value -> Parser o
d) = (Value -> Parser [o]) -> ObjectDecoder ('IndexedNode Nat tree) [o]
forall (t :: Tree) o. (Value -> Parser o) -> ObjectDecoder t o
ObjectDecoder ((Value -> Parser [o])
 -> ObjectDecoder ('IndexedNode Nat tree) [o])
-> (Value -> Parser [o])
-> ObjectDecoder ('IndexedNode Nat tree) [o]
forall a b. (a -> b) -> a -> b
$ (Value -> Parser o) -> [Value] -> Parser [o]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser o
d ([Value] -> Parser [o])
-> (Value -> Parser [Value]) -> Value -> Parser [o]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser [Value]
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON
  textMap :: ObjectDecoder tree o
-> ObjectDecoder ('IndexedNode Symbol tree) (Map k o)
textMap (ObjectDecoder d :: Value -> Parser o
d) = (Value -> Parser (Map k o))
-> ObjectDecoder ('IndexedNode Symbol tree) (Map k o)
forall (t :: Tree) o. (Value -> Parser o) -> ObjectDecoder t o
ObjectDecoder ((Value -> Parser (Map k o))
 -> ObjectDecoder ('IndexedNode Symbol tree) (Map k o))
-> (Value -> Parser (Map k o))
-> ObjectDecoder ('IndexedNode Symbol tree) (Map k o)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser o) -> Map k Value -> Parser (Map k o)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser o
d (Map k Value -> Parser (Map k o))
-> (Value -> Parser (Map k Value)) -> Value -> Parser (Map k o)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser (Map k Value)
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON
  set :: ObjectDecoder tree o
-> ObjectDecoder ('IndexedNode Nat tree) (Set o)
set (ObjectDecoder d :: Value -> Parser o
d) = (Value -> Parser (Set o))
-> ObjectDecoder ('IndexedNode Nat tree) (Set o)
forall (t :: Tree) o. (Value -> Parser o) -> ObjectDecoder t o
ObjectDecoder ((Value -> Parser (Set o))
 -> ObjectDecoder ('IndexedNode Nat tree) (Set o))
-> (Value -> Parser (Set o))
-> ObjectDecoder ('IndexedNode Nat tree) (Set o)
forall a b. (a -> b) -> a -> b
$ ([o] -> Set o) -> Parser [o] -> Parser (Set o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [o] -> Set o
forall a. Ord a => [a] -> Set a
S.fromList
                        (Parser [o] -> Parser (Set o))
-> ([Value] -> Parser [o]) -> [Value] -> Parser (Set o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser o) -> [Value] -> Parser [o]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser o
d ([Value] -> Parser (Set o))
-> (Value -> Parser [Value]) -> Value -> Parser (Set o)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser [Value]
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON
  vector :: ObjectDecoder tree o
-> ObjectDecoder ('IndexedNode Nat tree) (Vector o)
vector (ObjectDecoder d :: Value -> Parser o
d) = (Value -> Parser (Vector o))
-> ObjectDecoder ('IndexedNode Nat tree) (Vector o)
forall (t :: Tree) o. (Value -> Parser o) -> ObjectDecoder t o
ObjectDecoder ((Value -> Parser (Vector o))
 -> ObjectDecoder ('IndexedNode Nat tree) (Vector o))
-> (Value -> Parser (Vector o))
-> ObjectDecoder ('IndexedNode Nat tree) (Vector o)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser o) -> Vector Value -> Parser (Vector o)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser o
d (Vector Value -> Parser (Vector o))
-> (Value -> Parser (Vector Value)) -> Value -> Parser (Vector o)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser (Vector Value)
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON
  prim :: ObjectDecoder 'Leaf v
prim = (Value -> Parser v) -> ObjectDecoder 'Leaf v
forall (t :: Tree) o. (Value -> Parser o) -> ObjectDecoder t o
ObjectDecoder Value -> Parser v
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON

instance FieldSYM ObjectDecoder where
  newtype Field ObjectDecoder o t a =
    FieldDecoder { Field ObjectDecoder o t a -> Object -> Parser a
unFieldDecoder :: Aeson.Object -> Aeson.Parser a }
  field :: proxy key
-> (obj -> field)
-> ObjectDecoder subTree field
-> Field ObjectDecoder obj tree field
field ky :: proxy key
ky _ (ObjectDecoder d :: Value -> Parser field
d) = (Object -> Parser field) -> Field ObjectDecoder obj tree field
forall o (t :: Tree) a.
(Object -> Parser a) -> Field ObjectDecoder o t a
FieldDecoder ((Object -> Parser field) -> Field ObjectDecoder obj tree field)
-> (Object -> Parser field) -> Field ObjectDecoder obj tree field
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj -> do
    Value
so <- Object
obj Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: String -> Text
T.pack (proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy key
ky)
    Value -> Parser field
d Value
so
  optField :: proxy key
-> (obj -> Maybe field)
-> ObjectDecoder subTree field
-> Field ObjectDecoder obj tree (Maybe field)
optField ky :: proxy key
ky _ (ObjectDecoder d :: Value -> Parser field
d) = (Object -> Parser (Maybe field))
-> Field ObjectDecoder obj tree (Maybe field)
forall o (t :: Tree) a.
(Object -> Parser a) -> Field ObjectDecoder o t a
FieldDecoder ((Object -> Parser (Maybe field))
 -> Field ObjectDecoder obj tree (Maybe field))
-> (Object -> Parser (Maybe field))
-> Field ObjectDecoder obj tree (Maybe field)
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj -> do
    Maybe Value
mbSo <- Object
obj Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? String -> Text
T.pack (proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy key
ky)
    (Value -> Parser field) -> Maybe Value -> Parser (Maybe field)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser field
d Maybe Value
mbSo
  optFieldDef :: proxy key
-> (obj -> field)
-> field
-> ObjectDecoder subTree field
-> Field ObjectDecoder obj tree field
optFieldDef ky :: proxy key
ky _ def :: field
def (ObjectDecoder d :: Value -> Parser field
d) = (Object -> Parser field) -> Field ObjectDecoder obj tree field
forall o (t :: Tree) a.
(Object -> Parser a) -> Field ObjectDecoder o t a
FieldDecoder ((Object -> Parser field) -> Field ObjectDecoder obj tree field)
-> (Object -> Parser field) -> Field ObjectDecoder obj tree field
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj -> do
    Maybe Value
mbSo <- Object
obj Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? String -> Text
T.pack (proxy key -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy key
ky)
    Parser field
-> (Value -> Parser field) -> Maybe Value -> Parser field
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (field -> Parser field
forall (f :: * -> *) a. Applicative f => a -> f a
pure field
def) Value -> Parser field
d Maybe Value
mbSo

instance UnionSYM ObjectDecoder where
  newtype Tag ObjectDecoder u t a =
    TagDecoder { Tag ObjectDecoder u t a -> HashMap Text (Value -> Parser u)
unTagDecoder :: HM.HashMap T.Text (Aeson.Value -> Aeson.Parser u) }
  type Result ObjectDecoder u = ()
  union :: String
-> TreeBuilder
     (Tag ObjectDecoder union)
     tree
     (union -> Result ObjectDecoder union)
-> ObjectDecoder tree union
union name :: String
name tags :: TreeBuilder
  (Tag ObjectDecoder union)
  tree
  (union -> Result ObjectDecoder union)
tags = (Value -> Parser union) -> ObjectDecoder tree union
forall (t :: Tree) o. (Value -> Parser o) -> ObjectDecoder t o
ObjectDecoder ((Value -> Parser union) -> ObjectDecoder tree union)
-> ((Object -> Parser union) -> Value -> Parser union)
-> (Object -> Parser union)
-> ObjectDecoder tree union
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> (Object -> Parser union) -> Value -> Parser union
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
name ((Object -> Parser union) -> ObjectDecoder tree union)
-> (Object -> Parser union) -> ObjectDecoder tree union
forall a b. (a -> b) -> a -> b
$ \obj :: Object
obj -> do
      let decoderMap :: HashMap Text (Value -> Parser union)
decoderMap = (forall a' (t' :: Tree).
 Tag ObjectDecoder union t' a'
 -> HashMap Text (Value -> Parser union))
-> TreeBuilder (Tag ObjectDecoder union) tree (union -> ())
-> HashMap Text (Value -> Parser union)
forall m (f :: Tree -> * -> *) (t :: Tree) a.
Monoid m =>
(forall a' (t' :: Tree). f t' a' -> m) -> TreeBuilder f t a -> m
runAp_ forall a' (t' :: Tree).
Tag ObjectDecoder union t' a'
-> HashMap Text (Value -> Parser union)
forall u (t :: Tree) a.
Tag ObjectDecoder u t a -> HashMap Text (Value -> Parser u)
unTagDecoder TreeBuilder (Tag ObjectDecoder union) tree (union -> ())
TreeBuilder
  (Tag ObjectDecoder union)
  tree
  (union -> Result ObjectDecoder union)
tags
          decodeVal :: Text -> Value -> Parser union -> Parser union
decodeVal k :: Text
k v :: Value
v nxt :: Parser union
nxt =
            case Text
-> HashMap Text (Value -> Parser union)
-> Maybe (Value -> Parser union)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
k HashMap Text (Value -> Parser union)
decoderMap of
              Nothing -> Parser union
nxt
              Just tagDecoder :: Value -> Parser union
tagDecoder ->
                Value -> Parser union
tagDecoder Value
v
      (Text -> Value -> Parser union -> Parser union)
-> Parser union -> Object -> Parser union
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey Text -> Value -> Parser union -> Parser union
decodeVal (String -> Parser union
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unable to find a matching tag") Object
obj
  tag :: proxy name
-> (v -> union)
-> ObjectDecoder subTree v
-> Tag ObjectDecoder union tree (v -> Result ObjectDecoder union)
tag name :: proxy name
name constr :: v -> union
constr valueDecoder :: ObjectDecoder subTree v
valueDecoder =
    HashMap Text (Value -> Parser union)
-> Tag ObjectDecoder union tree (v -> ())
forall u (t :: Tree) a.
HashMap Text (Value -> Parser u) -> Tag ObjectDecoder u t a
TagDecoder (HashMap Text (Value -> Parser union)
 -> Tag ObjectDecoder union tree (v -> ()))
-> ((Value -> Parser union)
    -> HashMap Text (Value -> Parser union))
-> (Value -> Parser union)
-> Tag ObjectDecoder union tree (v -> ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Value -> Parser union) -> HashMap Text (Value -> Parser union)
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal proxy name
name)
      ((Value -> Parser union)
 -> Tag ObjectDecoder union tree (v -> Result ObjectDecoder union))
-> (Value -> Parser union)
-> Tag ObjectDecoder union tree (v -> Result ObjectDecoder union)
forall a b. (a -> b) -> a -> b
$ (v -> union) -> Parser v -> Parser union
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> union
constr (Parser v -> Parser union)
-> (Value -> Parser v) -> Value -> Parser union
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectDecoder subTree v -> Value -> Parser v
forall (t :: Tree) o. ObjectDecoder t o -> Value -> Parser o
decodeObject ObjectDecoder subTree v
valueDecoder

--------------------------------------------------------------------------------
-- No Duplicate Keys Constraint
--------------------------------------------------------------------------------

-- | A constraint that raises a type error if an object has more than one field
-- with the same key.
type family NoDuplicateKeys (obj :: Type) (edges :: [Edge]) :: Constraint where
  NoDuplicateKeys obj ('Edge key q ty subTree ': rest)
    = (KeyNotPresent key obj rest, NoDuplicateKeys obj rest)
  NoDuplicateKeys obj '[] = ()

type family KeyNotPresent (key :: Symbol) (obj :: Type) (edges :: [Edge]) :: Constraint where
  KeyNotPresent key obj ('Edge key q ty subTree ': rest)
    = TypeError ('Text "Duplicate JSON key \""
            ':<>: 'Text key
            ':<>: 'Text "\" in object "
            ':<>: 'ShowType obj
                )
  KeyNotPresent key obj ('Edge notKey q ty subTree ': rest)
    = KeyNotPresent key obj rest
  KeyNotPresent key obj '[] = ()

--------------------------------------------------------------------------------
-- Free Indexed Applicative
--------------------------------------------------------------------------------

-- | An indexed free applicative variant that is used to build 'Tree's by
-- gathering up all the edges.
data TreeBuilder (f :: Tree -> Type -> Type) (t :: Tree) (a :: Type) where
  Pure :: a -> TreeBuilder f ('Node aggr '[]) a
  Ap   :: TreeBuilder f ('Node aggr edges) (a -> b)
       -> f ('Node aggr '[edge]) a
       -> TreeBuilder f ('Node aggr (edge ': edges)) b

-- | Used like '<$>' in schema definitions
(<<$>) :: (a -> b)
       -> f ('Node aggr '[edge]) a
       -> TreeBuilder f ('Node aggr '[edge]) b
f :: a -> b
f <<$> :: (a -> b)
-> f ('Node aggr '[edge]) a -> TreeBuilder f ('Node aggr '[edge]) b
<<$> i :: f ('Node aggr '[edge]) a
i = (a -> b) -> TreeBuilder f ('Node aggr '[]) (a -> b)
forall a (f :: Tree -> * -> *) (aggr :: Aggregator).
a -> TreeBuilder f ('Node aggr '[]) a
Pure a -> b
f TreeBuilder f ('Node aggr '[]) (a -> b)
-> f ('Node aggr '[edge]) a -> TreeBuilder f ('Node aggr '[edge]) b
forall (f :: Tree -> * -> *) (aggr :: Aggregator) (edges :: [Edge])
       a b (edge :: Edge).
TreeBuilder f ('Node aggr edges) (a -> b)
-> f ('Node aggr '[edge]) a
-> TreeBuilder f ('Node aggr (edge : edges)) b
`Ap` f ('Node aggr '[edge]) a
i
infixl 4 <<$>

-- | Used like '<*>' in schema definitions
(<<*>) :: TreeBuilder f ('Node aggr edges) (a -> b)
       -> f ('Node aggr '[edge]) a
       -> TreeBuilder f ('Node aggr (edge ': edges)) b
<<*> :: TreeBuilder f ('Node aggr edges) (a -> b)
-> f ('Node aggr '[edge]) a
-> TreeBuilder f ('Node aggr (edge : edges)) b
(<<*>) = TreeBuilder f ('Node aggr edges) (a -> b)
-> f ('Node aggr '[edge]) a
-> TreeBuilder f ('Node aggr (edge : edges)) b
forall (f :: Tree -> * -> *) (aggr :: Aggregator) (edges :: [Edge])
       a b (edge :: Edge).
TreeBuilder f ('Node aggr edges) (a -> b)
-> f ('Node aggr '[edge]) a
-> TreeBuilder f ('Node aggr (edge : edges)) b
Ap
infixl 4 <<*>

runAp_ :: Monoid m => (forall a' t'. f t' a' -> m) -> TreeBuilder f t a -> m
runAp_ :: (forall a' (t' :: Tree). f t' a' -> m) -> TreeBuilder f t a -> m
runAp_ _ (Pure _) = m
forall a. Monoid a => a
mempty
runAp_ f :: forall a' (t' :: Tree). f t' a' -> m
f (Ap p :: TreeBuilder f ('Node aggr edges) (a -> a)
p c :: f ('Node aggr '[edge]) a
c) = (forall a' (t' :: Tree). f t' a' -> m)
-> TreeBuilder f ('Node aggr edges) (a -> a) -> m
forall m (f :: Tree -> * -> *) (t :: Tree) a.
Monoid m =>
(forall a' (t' :: Tree). f t' a' -> m) -> TreeBuilder f t a -> m
runAp_ forall a' (t' :: Tree). f t' a' -> m
f TreeBuilder f ('Node aggr edges) (a -> a)
p m -> m -> m
forall a. Semigroup a => a -> a -> a
<> f ('Node aggr '[edge]) a -> m
forall a' (t' :: Tree). f t' a' -> m
f f ('Node aggr '[edge]) a
c

runAp :: Applicative g => (forall a' t'. f t' a' -> g a') -> TreeBuilder f t a -> g a
runAp :: (forall a' (t' :: Tree). f t' a' -> g a')
-> TreeBuilder f t a -> g a
runAp _ (Pure a :: a
a) = a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
runAp f :: forall a' (t' :: Tree). f t' a' -> g a'
f (Ap p :: TreeBuilder f ('Node aggr edges) (a -> a)
p c :: f ('Node aggr '[edge]) a
c) = (forall a' (t' :: Tree). f t' a' -> g a')
-> TreeBuilder f ('Node aggr edges) (a -> a) -> g (a -> a)
forall (g :: * -> *) (f :: Tree -> * -> *) (t :: Tree) a.
Applicative g =>
(forall a' (t' :: Tree). f t' a' -> g a')
-> TreeBuilder f t a -> g a
runAp forall a' (t' :: Tree). f t' a' -> g a'
f TreeBuilder f ('Node aggr edges) (a -> a)
p g (a -> a) -> g a -> g a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ('Node aggr '[edge]) a -> g a
forall a' (t' :: Tree). f t' a' -> g a'
f f ('Node aggr '[edge]) a
c