{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Generic contexts (mappings from variables to other things, such as
-- types, values, or capability sets) used throughout the codebase.
-- For example, while typechecking we use a context to store a mapping
-- from variables in scope to their types. As another example, at
-- runtime, robots store an 'Env' which contains several contexts,
-- mapping variables to things like their current value, any
-- requirements associated with using the variable, and so on.
--
-- The implementation here goes to some effort to make it possible to
-- serialize and deserialize contexts so that sharing is preserved and
-- the encoding of serialized contexts does not blow up due to
-- repeated values.
module Swarm.Language.Context where

import Control.Algebra (Has, run)
import Control.Carrier.State.Strict (execState)
import Control.Effect.Reader (Reader, ask, local)
import Control.Effect.State (State, get, modify)
import Control.Lens.Empty (AsEmpty (..))
import Control.Lens.Prism (prism)
import Control.Monad (unless)
import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey, genericParseJSON, genericToJSON, withText)
import Data.Data (Data)
import Data.Function (on)
import Data.Hashable
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Semigroup (Sum (..))
import Data.Text qualified as T
import GHC.Generics (Generic)
import Swarm.Pretty (PrettyPrec (..))
import Swarm.Util (failT, showT)
import Swarm.Util.JSON (optionsMinimize)
import Swarm.Util.Yaml (FromJSONE, getE, liftE, parseJSONE)
import Text.Printf (printf)
import Text.Read (readMaybe)
import Prelude hiding (lookup)

------------------------------------------------------------
-- Context hash

-- | A context hash is a hash value used to identify contexts without
--   having to compare them for equality.  Hash values are computed
--   homomorphically, so that two equal contexts will be guaranteed to
--   have the same hash value, even if they were constructed with a
--   different sequence of operations.
--
--   The downside of this approach is that, /in theory/, there could
--   be hash collisions, that is, two different contexts which
--   nonetheless have the same hash value.  However, this is extremely
--   unlikely.  The benefit is that everything can be purely
--   functional, without the need to thread around some kind of
--   globally unique ID generation effect.
newtype CtxHash = CtxHash {CtxHash -> Int
getCtxHash :: Int}
  deriving (CtxHash -> CtxHash -> Bool
(CtxHash -> CtxHash -> Bool)
-> (CtxHash -> CtxHash -> Bool) -> Eq CtxHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CtxHash -> CtxHash -> Bool
== :: CtxHash -> CtxHash -> Bool
$c/= :: CtxHash -> CtxHash -> Bool
/= :: CtxHash -> CtxHash -> Bool
Eq, Eq CtxHash
Eq CtxHash =>
(CtxHash -> CtxHash -> Ordering)
-> (CtxHash -> CtxHash -> Bool)
-> (CtxHash -> CtxHash -> Bool)
-> (CtxHash -> CtxHash -> Bool)
-> (CtxHash -> CtxHash -> Bool)
-> (CtxHash -> CtxHash -> CtxHash)
-> (CtxHash -> CtxHash -> CtxHash)
-> Ord CtxHash
CtxHash -> CtxHash -> Bool
CtxHash -> CtxHash -> Ordering
CtxHash -> CtxHash -> CtxHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CtxHash -> CtxHash -> Ordering
compare :: CtxHash -> CtxHash -> Ordering
$c< :: CtxHash -> CtxHash -> Bool
< :: CtxHash -> CtxHash -> Bool
$c<= :: CtxHash -> CtxHash -> Bool
<= :: CtxHash -> CtxHash -> Bool
$c> :: CtxHash -> CtxHash -> Bool
> :: CtxHash -> CtxHash -> Bool
$c>= :: CtxHash -> CtxHash -> Bool
>= :: CtxHash -> CtxHash -> Bool
$cmax :: CtxHash -> CtxHash -> CtxHash
max :: CtxHash -> CtxHash -> CtxHash
$cmin :: CtxHash -> CtxHash -> CtxHash
min :: CtxHash -> CtxHash -> CtxHash
Ord, Typeable CtxHash
Typeable CtxHash =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CtxHash -> c CtxHash)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CtxHash)
-> (CtxHash -> Constr)
-> (CtxHash -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CtxHash))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CtxHash))
-> ((forall b. Data b => b -> b) -> CtxHash -> CtxHash)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CtxHash -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CtxHash -> r)
-> (forall u. (forall d. Data d => d -> u) -> CtxHash -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CtxHash -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CtxHash -> m CtxHash)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CtxHash -> m CtxHash)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CtxHash -> m CtxHash)
-> Data CtxHash
CtxHash -> Constr
CtxHash -> DataType
(forall b. Data b => b -> b) -> CtxHash -> CtxHash
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CtxHash -> u
forall u. (forall d. Data d => d -> u) -> CtxHash -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxHash -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxHash -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CtxHash -> m CtxHash
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxHash -> m CtxHash
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CtxHash
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxHash -> c CtxHash
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CtxHash)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CtxHash)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxHash -> c CtxHash
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxHash -> c CtxHash
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CtxHash
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CtxHash
$ctoConstr :: CtxHash -> Constr
toConstr :: CtxHash -> Constr
$cdataTypeOf :: CtxHash -> DataType
dataTypeOf :: CtxHash -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CtxHash)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CtxHash)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CtxHash)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CtxHash)
$cgmapT :: (forall b. Data b => b -> b) -> CtxHash -> CtxHash
gmapT :: (forall b. Data b => b -> b) -> CtxHash -> CtxHash
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxHash -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxHash -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxHash -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxHash -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CtxHash -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CtxHash -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CtxHash -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CtxHash -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CtxHash -> m CtxHash
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CtxHash -> m CtxHash
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxHash -> m CtxHash
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxHash -> m CtxHash
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxHash -> m CtxHash
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxHash -> m CtxHash
Data, (forall x. CtxHash -> Rep CtxHash x)
-> (forall x. Rep CtxHash x -> CtxHash) -> Generic CtxHash
forall x. Rep CtxHash x -> CtxHash
forall x. CtxHash -> Rep CtxHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CtxHash -> Rep CtxHash x
from :: forall x. CtxHash -> Rep CtxHash x
$cto :: forall x. Rep CtxHash x -> CtxHash
to :: forall x. Rep CtxHash x -> CtxHash
Generic, ToJSONKeyFunction [CtxHash]
ToJSONKeyFunction CtxHash
ToJSONKeyFunction CtxHash
-> ToJSONKeyFunction [CtxHash] -> ToJSONKey CtxHash
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction CtxHash
toJSONKey :: ToJSONKeyFunction CtxHash
$ctoJSONKeyList :: ToJSONKeyFunction [CtxHash]
toJSONKeyList :: ToJSONKeyFunction [CtxHash]
ToJSONKey, FromJSONKeyFunction [CtxHash]
FromJSONKeyFunction CtxHash
FromJSONKeyFunction CtxHash
-> FromJSONKeyFunction [CtxHash] -> FromJSONKey CtxHash
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction CtxHash
fromJSONKey :: FromJSONKeyFunction CtxHash
$cfromJSONKeyList :: FromJSONKeyFunction [CtxHash]
fromJSONKeyList :: FromJSONKeyFunction [CtxHash]
FromJSONKey)
  deriving (NonEmpty CtxHash -> CtxHash
CtxHash -> CtxHash -> CtxHash
(CtxHash -> CtxHash -> CtxHash)
-> (NonEmpty CtxHash -> CtxHash)
-> (forall b. Integral b => b -> CtxHash -> CtxHash)
-> Semigroup CtxHash
forall b. Integral b => b -> CtxHash -> CtxHash
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: CtxHash -> CtxHash -> CtxHash
<> :: CtxHash -> CtxHash -> CtxHash
$csconcat :: NonEmpty CtxHash -> CtxHash
sconcat :: NonEmpty CtxHash -> CtxHash
$cstimes :: forall b. Integral b => b -> CtxHash -> CtxHash
stimes :: forall b. Integral b => b -> CtxHash -> CtxHash
Semigroup, Semigroup CtxHash
CtxHash
Semigroup CtxHash =>
CtxHash
-> (CtxHash -> CtxHash -> CtxHash)
-> ([CtxHash] -> CtxHash)
-> Monoid CtxHash
[CtxHash] -> CtxHash
CtxHash -> CtxHash -> CtxHash
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: CtxHash
mempty :: CtxHash
$cmappend :: CtxHash -> CtxHash -> CtxHash
mappend :: CtxHash -> CtxHash -> CtxHash
$cmconcat :: [CtxHash] -> CtxHash
mconcat :: [CtxHash] -> CtxHash
Monoid) via Sum Int
  deriving (Integer -> CtxHash
CtxHash -> CtxHash
CtxHash -> CtxHash -> CtxHash
(CtxHash -> CtxHash -> CtxHash)
-> (CtxHash -> CtxHash -> CtxHash)
-> (CtxHash -> CtxHash -> CtxHash)
-> (CtxHash -> CtxHash)
-> (CtxHash -> CtxHash)
-> (CtxHash -> CtxHash)
-> (Integer -> CtxHash)
-> Num CtxHash
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: CtxHash -> CtxHash -> CtxHash
+ :: CtxHash -> CtxHash -> CtxHash
$c- :: CtxHash -> CtxHash -> CtxHash
- :: CtxHash -> CtxHash -> CtxHash
$c* :: CtxHash -> CtxHash -> CtxHash
* :: CtxHash -> CtxHash -> CtxHash
$cnegate :: CtxHash -> CtxHash
negate :: CtxHash -> CtxHash
$cabs :: CtxHash -> CtxHash
abs :: CtxHash -> CtxHash
$csignum :: CtxHash -> CtxHash
signum :: CtxHash -> CtxHash
$cfromInteger :: Integer -> CtxHash
fromInteger :: Integer -> CtxHash
Num) via Int

instance Show CtxHash where
  show :: CtxHash -> String
show (CtxHash Int
h) = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%016x" Int
h

instance ToJSON CtxHash where
  toJSON :: CtxHash -> Value
toJSON CtxHash
h = String -> Value
forall a. ToJSON a => a -> Value
toJSON (CtxHash -> String
forall a. Show a => a -> String
show CtxHash
h)

instance FromJSON CtxHash where
  parseJSON :: Value -> Parser CtxHash
parseJSON = String -> (Text -> Parser CtxHash) -> Value -> Parser CtxHash
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"hash" ((Text -> Parser CtxHash) -> Value -> Parser CtxHash)
-> (Text -> Parser CtxHash) -> Value -> Parser CtxHash
forall a b. (a -> b) -> a -> b
$ \Text
t -> case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t) of
    Maybe Int
Nothing -> String -> Parser CtxHash
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse CtxHash"
    Just Int
h -> CtxHash -> Parser CtxHash
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> CtxHash
CtxHash Int
h)

-- | The hash for a single variable -> value binding.
singletonHash :: (Hashable v, Hashable t) => v -> t -> CtxHash
singletonHash :: forall v t. (Hashable v, Hashable t) => v -> t -> CtxHash
singletonHash v
x t
t = Int -> CtxHash
CtxHash (Int -> CtxHash) -> Int -> CtxHash
forall a b. (a -> b) -> a -> b
$ Int -> t -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt (v -> Int
forall a. Hashable a => a -> Int
hash v
x) t
t

-- | The hash for an entire Map's worth of bindings.
mapHash :: (Hashable v, Hashable t) => Map v t -> CtxHash
mapHash :: forall v t. (Hashable v, Hashable t) => Map v t -> CtxHash
mapHash = (v -> t -> CtxHash) -> Map v t -> CtxHash
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey v -> t -> CtxHash
forall v t. (Hashable v, Hashable t) => v -> t -> CtxHash
singletonHash

------------------------------------------------------------
-- Context structure

-- | 'CtxF' represents one level of structure of a context: a context
--   is either empty, a singleton, or built via deletion or union.
data CtxF f v t
  = CtxEmpty
  | CtxSingle v t
  | CtxDelete v t (f v t)
  | CtxUnion (f v t) (f v t)
  deriving (CtxF f v t -> CtxF f v t -> Bool
(CtxF f v t -> CtxF f v t -> Bool)
-> (CtxF f v t -> CtxF f v t -> Bool) -> Eq (CtxF f v t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> * -> *) v t.
(Eq v, Eq t, Eq (f v t)) =>
CtxF f v t -> CtxF f v t -> Bool
$c== :: forall (f :: * -> * -> *) v t.
(Eq v, Eq t, Eq (f v t)) =>
CtxF f v t -> CtxF f v t -> Bool
== :: CtxF f v t -> CtxF f v t -> Bool
$c/= :: forall (f :: * -> * -> *) v t.
(Eq v, Eq t, Eq (f v t)) =>
CtxF f v t -> CtxF f v t -> Bool
/= :: CtxF f v t -> CtxF f v t -> Bool
Eq, Int -> CtxF f v t -> ShowS
[CtxF f v t] -> ShowS
CtxF f v t -> String
(Int -> CtxF f v t -> ShowS)
-> (CtxF f v t -> String)
-> ([CtxF f v t] -> ShowS)
-> Show (CtxF f v t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> * -> *) v t.
(Show v, Show t, Show (f v t)) =>
Int -> CtxF f v t -> ShowS
forall (f :: * -> * -> *) v t.
(Show v, Show t, Show (f v t)) =>
[CtxF f v t] -> ShowS
forall (f :: * -> * -> *) v t.
(Show v, Show t, Show (f v t)) =>
CtxF f v t -> String
$cshowsPrec :: forall (f :: * -> * -> *) v t.
(Show v, Show t, Show (f v t)) =>
Int -> CtxF f v t -> ShowS
showsPrec :: Int -> CtxF f v t -> ShowS
$cshow :: forall (f :: * -> * -> *) v t.
(Show v, Show t, Show (f v t)) =>
CtxF f v t -> String
show :: CtxF f v t -> String
$cshowList :: forall (f :: * -> * -> *) v t.
(Show v, Show t, Show (f v t)) =>
[CtxF f v t] -> ShowS
showList :: [CtxF f v t] -> ShowS
Show, (forall a b. (a -> b) -> CtxF f v a -> CtxF f v b)
-> (forall a b. a -> CtxF f v b -> CtxF f v a)
-> Functor (CtxF f v)
forall a b. a -> CtxF f v b -> CtxF f v a
forall a b. (a -> b) -> CtxF f v a -> CtxF f v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> * -> *) v a b.
Functor (f v) =>
a -> CtxF f v b -> CtxF f v a
forall (f :: * -> * -> *) v a b.
Functor (f v) =>
(a -> b) -> CtxF f v a -> CtxF f v b
$cfmap :: forall (f :: * -> * -> *) v a b.
Functor (f v) =>
(a -> b) -> CtxF f v a -> CtxF f v b
fmap :: forall a b. (a -> b) -> CtxF f v a -> CtxF f v b
$c<$ :: forall (f :: * -> * -> *) v a b.
Functor (f v) =>
a -> CtxF f v b -> CtxF f v a
<$ :: forall a b. a -> CtxF f v b -> CtxF f v a
Functor, (forall m. Monoid m => CtxF f v m -> m)
-> (forall m a. Monoid m => (a -> m) -> CtxF f v a -> m)
-> (forall m a. Monoid m => (a -> m) -> CtxF f v a -> m)
-> (forall a b. (a -> b -> b) -> b -> CtxF f v a -> b)
-> (forall a b. (a -> b -> b) -> b -> CtxF f v a -> b)
-> (forall b a. (b -> a -> b) -> b -> CtxF f v a -> b)
-> (forall b a. (b -> a -> b) -> b -> CtxF f v a -> b)
-> (forall a. (a -> a -> a) -> CtxF f v a -> a)
-> (forall a. (a -> a -> a) -> CtxF f v a -> a)
-> (forall a. CtxF f v a -> [a])
-> (forall a. CtxF f v a -> Bool)
-> (forall a. CtxF f v a -> Int)
-> (forall a. Eq a => a -> CtxF f v a -> Bool)
-> (forall a. Ord a => CtxF f v a -> a)
-> (forall a. Ord a => CtxF f v a -> a)
-> (forall a. Num a => CtxF f v a -> a)
-> (forall a. Num a => CtxF f v a -> a)
-> Foldable (CtxF f v)
forall a. Eq a => a -> CtxF f v a -> Bool
forall a. Num a => CtxF f v a -> a
forall a. Ord a => CtxF f v a -> a
forall m. Monoid m => CtxF f v m -> m
forall a. CtxF f v a -> Bool
forall a. CtxF f v a -> Int
forall a. CtxF f v a -> [a]
forall a. (a -> a -> a) -> CtxF f v a -> a
forall m a. Monoid m => (a -> m) -> CtxF f v a -> m
forall b a. (b -> a -> b) -> b -> CtxF f v a -> b
forall a b. (a -> b -> b) -> b -> CtxF f v a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
forall (f :: * -> * -> *) v a.
(Foldable (f v), Eq a) =>
a -> CtxF f v a -> Bool
forall (f :: * -> * -> *) v a.
(Foldable (f v), Num a) =>
CtxF f v a -> a
forall (f :: * -> * -> *) v a.
(Foldable (f v), Ord a) =>
CtxF f v a -> a
forall (f :: * -> * -> *) v m.
(Foldable (f v), Monoid m) =>
CtxF f v m -> m
forall (f :: * -> * -> *) v a. Foldable (f v) => CtxF f v a -> Bool
forall (f :: * -> * -> *) v a. Foldable (f v) => CtxF f v a -> Int
forall (f :: * -> * -> *) v a. Foldable (f v) => CtxF f v a -> [a]
forall (f :: * -> * -> *) v a.
Foldable (f v) =>
(a -> a -> a) -> CtxF f v a -> a
forall (f :: * -> * -> *) v m a.
(Foldable (f v), Monoid m) =>
(a -> m) -> CtxF f v a -> m
forall (f :: * -> * -> *) v b a.
Foldable (f v) =>
(b -> a -> b) -> b -> CtxF f v a -> b
forall (f :: * -> * -> *) v a b.
Foldable (f v) =>
(a -> b -> b) -> b -> CtxF f v a -> b
$cfold :: forall (f :: * -> * -> *) v m.
(Foldable (f v), Monoid m) =>
CtxF f v m -> m
fold :: forall m. Monoid m => CtxF f v m -> m
$cfoldMap :: forall (f :: * -> * -> *) v m a.
(Foldable (f v), Monoid m) =>
(a -> m) -> CtxF f v a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CtxF f v a -> m
$cfoldMap' :: forall (f :: * -> * -> *) v m a.
(Foldable (f v), Monoid m) =>
(a -> m) -> CtxF f v a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> CtxF f v a -> m
$cfoldr :: forall (f :: * -> * -> *) v a b.
Foldable (f v) =>
(a -> b -> b) -> b -> CtxF f v a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CtxF f v a -> b
$cfoldr' :: forall (f :: * -> * -> *) v a b.
Foldable (f v) =>
(a -> b -> b) -> b -> CtxF f v a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CtxF f v a -> b
$cfoldl :: forall (f :: * -> * -> *) v b a.
Foldable (f v) =>
(b -> a -> b) -> b -> CtxF f v a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CtxF f v a -> b
$cfoldl' :: forall (f :: * -> * -> *) v b a.
Foldable (f v) =>
(b -> a -> b) -> b -> CtxF f v a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> CtxF f v a -> b
$cfoldr1 :: forall (f :: * -> * -> *) v a.
Foldable (f v) =>
(a -> a -> a) -> CtxF f v a -> a
foldr1 :: forall a. (a -> a -> a) -> CtxF f v a -> a
$cfoldl1 :: forall (f :: * -> * -> *) v a.
Foldable (f v) =>
(a -> a -> a) -> CtxF f v a -> a
foldl1 :: forall a. (a -> a -> a) -> CtxF f v a -> a
$ctoList :: forall (f :: * -> * -> *) v a. Foldable (f v) => CtxF f v a -> [a]
toList :: forall a. CtxF f v a -> [a]
$cnull :: forall (f :: * -> * -> *) v a. Foldable (f v) => CtxF f v a -> Bool
null :: forall a. CtxF f v a -> Bool
$clength :: forall (f :: * -> * -> *) v a. Foldable (f v) => CtxF f v a -> Int
length :: forall a. CtxF f v a -> Int
$celem :: forall (f :: * -> * -> *) v a.
(Foldable (f v), Eq a) =>
a -> CtxF f v a -> Bool
elem :: forall a. Eq a => a -> CtxF f v a -> Bool
$cmaximum :: forall (f :: * -> * -> *) v a.
(Foldable (f v), Ord a) =>
CtxF f v a -> a
maximum :: forall a. Ord a => CtxF f v a -> a
$cminimum :: forall (f :: * -> * -> *) v a.
(Foldable (f v), Ord a) =>
CtxF f v a -> a
minimum :: forall a. Ord a => CtxF f v a -> a
$csum :: forall (f :: * -> * -> *) v a.
(Foldable (f v), Num a) =>
CtxF f v a -> a
sum :: forall a. Num a => CtxF f v a -> a
$cproduct :: forall (f :: * -> * -> *) v a.
(Foldable (f v), Num a) =>
CtxF f v a -> a
product :: forall a. Num a => CtxF f v a -> a
Foldable, Functor (CtxF f v)
Foldable (CtxF f v)
(Functor (CtxF f v), Foldable (CtxF f v)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> CtxF f v a -> f (CtxF f v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CtxF f v (f a) -> f (CtxF f v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CtxF f v a -> m (CtxF f v b))
-> (forall (m :: * -> *) a.
    Monad m =>
    CtxF f v (m a) -> m (CtxF f v a))
-> Traversable (CtxF f v)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => CtxF f v (m a) -> m (CtxF f v a)
forall (f :: * -> *) a.
Applicative f =>
CtxF f v (f a) -> f (CtxF f v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CtxF f v a -> m (CtxF f v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CtxF f v a -> f (CtxF f v b)
forall (f :: * -> * -> *) v.
Traversable (f v) =>
Functor (CtxF f v)
forall (f :: * -> * -> *) v.
Traversable (f v) =>
Foldable (CtxF f v)
forall (f :: * -> * -> *) v (m :: * -> *) a.
(Traversable (f v), Monad m) =>
CtxF f v (m a) -> m (CtxF f v a)
forall (f :: * -> * -> *) v (f :: * -> *) a.
(Traversable (f v), Applicative f) =>
CtxF f v (f a) -> f (CtxF f v a)
forall (f :: * -> * -> *) v (m :: * -> *) a b.
(Traversable (f v), Monad m) =>
(a -> m b) -> CtxF f v a -> m (CtxF f v b)
forall (f :: * -> * -> *) v (f :: * -> *) a b.
(Traversable (f v), Applicative f) =>
(a -> f b) -> CtxF f v a -> f (CtxF f v b)
$ctraverse :: forall (f :: * -> * -> *) v (f :: * -> *) a b.
(Traversable (f v), Applicative f) =>
(a -> f b) -> CtxF f v a -> f (CtxF f v b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CtxF f v a -> f (CtxF f v b)
$csequenceA :: forall (f :: * -> * -> *) v (f :: * -> *) a.
(Traversable (f v), Applicative f) =>
CtxF f v (f a) -> f (CtxF f v a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CtxF f v (f a) -> f (CtxF f v a)
$cmapM :: forall (f :: * -> * -> *) v (m :: * -> *) a b.
(Traversable (f v), Monad m) =>
(a -> m b) -> CtxF f v a -> m (CtxF f v b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CtxF f v a -> m (CtxF f v b)
$csequence :: forall (f :: * -> * -> *) v (m :: * -> *) a.
(Traversable (f v), Monad m) =>
CtxF f v (m a) -> m (CtxF f v a)
sequence :: forall (m :: * -> *) a. Monad m => CtxF f v (m a) -> m (CtxF f v a)
Traversable, Typeable (CtxF f v t)
Typeable (CtxF f v t) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CtxF f v t -> c (CtxF f v t))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (CtxF f v t))
-> (CtxF f v t -> Constr)
-> (CtxF f v t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (CtxF f v t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (CtxF f v t)))
-> ((forall b. Data b => b -> b) -> CtxF f v t -> CtxF f v t)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r)
-> (forall u. (forall d. Data d => d -> u) -> CtxF f v t -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CtxF f v t -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t))
-> Data (CtxF f v t)
CtxF f v t -> Constr
CtxF f v t -> DataType
(forall b. Data b => b -> b) -> CtxF f v t -> CtxF f v t
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CtxF f v t -> u
forall u. (forall d. Data d => d -> u) -> CtxF f v t -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CtxF f v t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxF f v t -> c (CtxF f v t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CtxF f v t))
forall (f :: * -> * -> *) v t.
(Typeable f, Data v, Data t, Data (f v t)) =>
Typeable (CtxF f v t)
forall (f :: * -> * -> *) v t.
(Typeable f, Data v, Data t, Data (f v t)) =>
CtxF f v t -> Constr
forall (f :: * -> * -> *) v t.
(Typeable f, Data v, Data t, Data (f v t)) =>
CtxF f v t -> DataType
forall (f :: * -> * -> *) v t.
(Typeable f, Data v, Data t, Data (f v t)) =>
(forall b. Data b => b -> b) -> CtxF f v t -> CtxF f v t
forall (f :: * -> * -> *) v t u.
(Typeable f, Data v, Data t, Data (f v t)) =>
Int -> (forall d. Data d => d -> u) -> CtxF f v t -> u
forall (f :: * -> * -> *) v t u.
(Typeable f, Data v, Data t, Data (f v t)) =>
(forall d. Data d => d -> u) -> CtxF f v t -> [u]
forall (f :: * -> * -> *) v t r r'.
(Typeable f, Data v, Data t, Data (f v t)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r
forall (f :: * -> * -> *) v t r r'.
(Typeable f, Data v, Data t, Data (f v t)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r
forall (f :: * -> * -> *) v t (m :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), Monad m) =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
forall (f :: * -> * -> *) v t (m :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), MonadPlus m) =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
forall (f :: * -> * -> *) v t (c :: * -> *).
(Typeable f, Data v, Data t, Data (f v t)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CtxF f v t)
forall (f :: * -> * -> *) v t (c :: * -> *).
(Typeable f, Data v, Data t, Data (f v t)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxF f v t -> c (CtxF f v t)
forall (f :: * -> * -> *) v t (t :: * -> *) (c :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CtxF f v t))
forall (f :: * -> * -> *) v t (t :: * -> * -> *) (c :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CtxF f v t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CtxF f v t))
$cgfoldl :: forall (f :: * -> * -> *) v t (c :: * -> *).
(Typeable f, Data v, Data t, Data (f v t)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxF f v t -> c (CtxF f v t)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxF f v t -> c (CtxF f v t)
$cgunfold :: forall (f :: * -> * -> *) v t (c :: * -> *).
(Typeable f, Data v, Data t, Data (f v t)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CtxF f v t)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CtxF f v t)
$ctoConstr :: forall (f :: * -> * -> *) v t.
(Typeable f, Data v, Data t, Data (f v t)) =>
CtxF f v t -> Constr
toConstr :: CtxF f v t -> Constr
$cdataTypeOf :: forall (f :: * -> * -> *) v t.
(Typeable f, Data v, Data t, Data (f v t)) =>
CtxF f v t -> DataType
dataTypeOf :: CtxF f v t -> DataType
$cdataCast1 :: forall (f :: * -> * -> *) v t (t :: * -> *) (c :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CtxF f v t))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CtxF f v t))
$cdataCast2 :: forall (f :: * -> * -> *) v t (t :: * -> * -> *) (c :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CtxF f v t))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CtxF f v t))
$cgmapT :: forall (f :: * -> * -> *) v t.
(Typeable f, Data v, Data t, Data (f v t)) =>
(forall b. Data b => b -> b) -> CtxF f v t -> CtxF f v t
gmapT :: (forall b. Data b => b -> b) -> CtxF f v t -> CtxF f v t
$cgmapQl :: forall (f :: * -> * -> *) v t r r'.
(Typeable f, Data v, Data t, Data (f v t)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r
$cgmapQr :: forall (f :: * -> * -> *) v t r r'.
(Typeable f, Data v, Data t, Data (f v t)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxF f v t -> r
$cgmapQ :: forall (f :: * -> * -> *) v t u.
(Typeable f, Data v, Data t, Data (f v t)) =>
(forall d. Data d => d -> u) -> CtxF f v t -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CtxF f v t -> [u]
$cgmapQi :: forall (f :: * -> * -> *) v t u.
(Typeable f, Data v, Data t, Data (f v t)) =>
Int -> (forall d. Data d => d -> u) -> CtxF f v t -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CtxF f v t -> u
$cgmapM :: forall (f :: * -> * -> *) v t (m :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), Monad m) =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
$cgmapMp :: forall (f :: * -> * -> *) v t (m :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), MonadPlus m) =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
$cgmapMo :: forall (f :: * -> * -> *) v t (m :: * -> *).
(Typeable f, Data v, Data t, Data (f v t), MonadPlus m) =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxF f v t -> m (CtxF f v t)
Data, (forall x. CtxF f v t -> Rep (CtxF f v t) x)
-> (forall x. Rep (CtxF f v t) x -> CtxF f v t)
-> Generic (CtxF f v t)
forall x. Rep (CtxF f v t) x -> CtxF f v t
forall x. CtxF f v t -> Rep (CtxF f v t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> * -> *) v t x. Rep (CtxF f v t) x -> CtxF f v t
forall (f :: * -> * -> *) v t x. CtxF f v t -> Rep (CtxF f v t) x
$cfrom :: forall (f :: * -> * -> *) v t x. CtxF f v t -> Rep (CtxF f v t) x
from :: forall x. CtxF f v t -> Rep (CtxF f v t) x
$cto :: forall (f :: * -> * -> *) v t x. Rep (CtxF f v t) x -> CtxF f v t
to :: forall x. Rep (CtxF f v t) x -> CtxF f v t
Generic)

instance (ToJSON v, ToJSON t, ToJSON (f v t)) => ToJSON (CtxF f v t) where
  toJSON :: CtxF f v t -> Value
toJSON = Options -> CtxF f v t -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
optionsMinimize

instance (FromJSON v, FromJSON t, FromJSON (f v t)) => FromJSON (CtxF f v t) where
  parseJSON :: Value -> Parser (CtxF f v t)
parseJSON = Options -> Value -> Parser (CtxF f v t)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
optionsMinimize

-- | Map over the recursive structure stored in a 'CtxF'.
restructureCtx :: (f v t -> g v t) -> CtxF f v t -> CtxF g v t
restructureCtx :: forall (f :: * -> * -> *) v t (g :: * -> * -> *).
(f v t -> g v t) -> CtxF f v t -> CtxF g v t
restructureCtx f v t -> g v t
_ CtxF f v t
CtxEmpty = CtxF g v t
forall (f :: * -> * -> *) v t. CtxF f v t
CtxEmpty
restructureCtx f v t -> g v t
_ (CtxSingle v
x t
t) = v -> t -> CtxF g v t
forall (f :: * -> * -> *) v t. v -> t -> CtxF f v t
CtxSingle v
x t
t
restructureCtx f v t -> g v t
h (CtxDelete v
x t
t f v t
f1) = v -> t -> g v t -> CtxF g v t
forall (f :: * -> * -> *) v t. v -> t -> f v t -> CtxF f v t
CtxDelete v
x t
t (f v t -> g v t
h f v t
f1)
restructureCtx f v t -> g v t
h (CtxUnion f v t
f1 f v t
f2) = g v t -> g v t -> CtxF g v t
forall (f :: * -> * -> *) v t. f v t -> f v t -> CtxF f v t
CtxUnion (f v t -> g v t
h f v t
f1) (f v t -> g v t
h f v t
f2)

-- | A 'CtxTree' is one possible representation of a context,
--   consisting of a structured record of the process by which a
--   context was constructed.  This representation would be terrible
--   for doing efficient variable lookups, but it can be used to
--   efficiently serialize/deserialize the context while recovering
--   sharing.
--
--   It stores a top-level hash of the context, along with a recursive
--   tree built via 'CtxF'.
data CtxTree v t = CtxTree CtxHash (CtxF CtxTree v t)
  deriving (CtxTree v t -> CtxTree v t -> Bool
(CtxTree v t -> CtxTree v t -> Bool)
-> (CtxTree v t -> CtxTree v t -> Bool) -> Eq (CtxTree v t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v t. (Eq v, Eq t) => CtxTree v t -> CtxTree v t -> Bool
$c== :: forall v t. (Eq v, Eq t) => CtxTree v t -> CtxTree v t -> Bool
== :: CtxTree v t -> CtxTree v t -> Bool
$c/= :: forall v t. (Eq v, Eq t) => CtxTree v t -> CtxTree v t -> Bool
/= :: CtxTree v t -> CtxTree v t -> Bool
Eq, (forall a b. (a -> b) -> CtxTree v a -> CtxTree v b)
-> (forall a b. a -> CtxTree v b -> CtxTree v a)
-> Functor (CtxTree v)
forall a b. a -> CtxTree v b -> CtxTree v a
forall a b. (a -> b) -> CtxTree v a -> CtxTree v b
forall v a b. a -> CtxTree v b -> CtxTree v a
forall v a b. (a -> b) -> CtxTree v a -> CtxTree v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall v a b. (a -> b) -> CtxTree v a -> CtxTree v b
fmap :: forall a b. (a -> b) -> CtxTree v a -> CtxTree v b
$c<$ :: forall v a b. a -> CtxTree v b -> CtxTree v a
<$ :: forall a b. a -> CtxTree v b -> CtxTree v a
Functor, (forall m. Monoid m => CtxTree v m -> m)
-> (forall m a. Monoid m => (a -> m) -> CtxTree v a -> m)
-> (forall m a. Monoid m => (a -> m) -> CtxTree v a -> m)
-> (forall a b. (a -> b -> b) -> b -> CtxTree v a -> b)
-> (forall a b. (a -> b -> b) -> b -> CtxTree v a -> b)
-> (forall b a. (b -> a -> b) -> b -> CtxTree v a -> b)
-> (forall b a. (b -> a -> b) -> b -> CtxTree v a -> b)
-> (forall a. (a -> a -> a) -> CtxTree v a -> a)
-> (forall a. (a -> a -> a) -> CtxTree v a -> a)
-> (forall a. CtxTree v a -> [a])
-> (forall a. CtxTree v a -> Bool)
-> (forall a. CtxTree v a -> Int)
-> (forall a. Eq a => a -> CtxTree v a -> Bool)
-> (forall a. Ord a => CtxTree v a -> a)
-> (forall a. Ord a => CtxTree v a -> a)
-> (forall a. Num a => CtxTree v a -> a)
-> (forall a. Num a => CtxTree v a -> a)
-> Foldable (CtxTree v)
forall a. Eq a => a -> CtxTree v a -> Bool
forall a. Num a => CtxTree v a -> a
forall a. Ord a => CtxTree v a -> a
forall m. Monoid m => CtxTree v m -> m
forall a. CtxTree v a -> Bool
forall a. CtxTree v a -> Int
forall a. CtxTree v a -> [a]
forall a. (a -> a -> a) -> CtxTree v a -> a
forall v a. Eq a => a -> CtxTree v a -> Bool
forall v a. Num a => CtxTree v a -> a
forall v a. Ord a => CtxTree v a -> a
forall v m. Monoid m => CtxTree v m -> m
forall m a. Monoid m => (a -> m) -> CtxTree v a -> m
forall v a. CtxTree v a -> Bool
forall v a. CtxTree v a -> Int
forall v a. CtxTree v a -> [a]
forall b a. (b -> a -> b) -> b -> CtxTree v a -> b
forall a b. (a -> b -> b) -> b -> CtxTree v a -> b
forall v a. (a -> a -> a) -> CtxTree v a -> a
forall v m a. Monoid m => (a -> m) -> CtxTree v a -> m
forall v b a. (b -> a -> b) -> b -> CtxTree v a -> b
forall v a b. (a -> b -> b) -> b -> CtxTree v a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall v m. Monoid m => CtxTree v m -> m
fold :: forall m. Monoid m => CtxTree v m -> m
$cfoldMap :: forall v m a. Monoid m => (a -> m) -> CtxTree v a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CtxTree v a -> m
$cfoldMap' :: forall v m a. Monoid m => (a -> m) -> CtxTree v a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> CtxTree v a -> m
$cfoldr :: forall v a b. (a -> b -> b) -> b -> CtxTree v a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CtxTree v a -> b
$cfoldr' :: forall v a b. (a -> b -> b) -> b -> CtxTree v a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CtxTree v a -> b
$cfoldl :: forall v b a. (b -> a -> b) -> b -> CtxTree v a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CtxTree v a -> b
$cfoldl' :: forall v b a. (b -> a -> b) -> b -> CtxTree v a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> CtxTree v a -> b
$cfoldr1 :: forall v a. (a -> a -> a) -> CtxTree v a -> a
foldr1 :: forall a. (a -> a -> a) -> CtxTree v a -> a
$cfoldl1 :: forall v a. (a -> a -> a) -> CtxTree v a -> a
foldl1 :: forall a. (a -> a -> a) -> CtxTree v a -> a
$ctoList :: forall v a. CtxTree v a -> [a]
toList :: forall a. CtxTree v a -> [a]
$cnull :: forall v a. CtxTree v a -> Bool
null :: forall a. CtxTree v a -> Bool
$clength :: forall v a. CtxTree v a -> Int
length :: forall a. CtxTree v a -> Int
$celem :: forall v a. Eq a => a -> CtxTree v a -> Bool
elem :: forall a. Eq a => a -> CtxTree v a -> Bool
$cmaximum :: forall v a. Ord a => CtxTree v a -> a
maximum :: forall a. Ord a => CtxTree v a -> a
$cminimum :: forall v a. Ord a => CtxTree v a -> a
minimum :: forall a. Ord a => CtxTree v a -> a
$csum :: forall v a. Num a => CtxTree v a -> a
sum :: forall a. Num a => CtxTree v a -> a
$cproduct :: forall v a. Num a => CtxTree v a -> a
product :: forall a. Num a => CtxTree v a -> a
Foldable, Functor (CtxTree v)
Foldable (CtxTree v)
(Functor (CtxTree v), Foldable (CtxTree v)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> CtxTree v a -> f (CtxTree v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CtxTree v (f a) -> f (CtxTree v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CtxTree v a -> m (CtxTree v b))
-> (forall (m :: * -> *) a.
    Monad m =>
    CtxTree v (m a) -> m (CtxTree v a))
-> Traversable (CtxTree v)
forall v. Functor (CtxTree v)
forall v. Foldable (CtxTree v)
forall v (m :: * -> *) a.
Monad m =>
CtxTree v (m a) -> m (CtxTree v a)
forall v (f :: * -> *) a.
Applicative f =>
CtxTree v (f a) -> f (CtxTree v a)
forall v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CtxTree v a -> m (CtxTree v b)
forall v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CtxTree v a -> f (CtxTree v b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
CtxTree v (m a) -> m (CtxTree v a)
forall (f :: * -> *) a.
Applicative f =>
CtxTree v (f a) -> f (CtxTree v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CtxTree v a -> m (CtxTree v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CtxTree v a -> f (CtxTree v b)
$ctraverse :: forall v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CtxTree v a -> f (CtxTree v b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CtxTree v a -> f (CtxTree v b)
$csequenceA :: forall v (f :: * -> *) a.
Applicative f =>
CtxTree v (f a) -> f (CtxTree v a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CtxTree v (f a) -> f (CtxTree v a)
$cmapM :: forall v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CtxTree v a -> m (CtxTree v b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CtxTree v a -> m (CtxTree v b)
$csequence :: forall v (m :: * -> *) a.
Monad m =>
CtxTree v (m a) -> m (CtxTree v a)
sequence :: forall (m :: * -> *) a.
Monad m =>
CtxTree v (m a) -> m (CtxTree v a)
Traversable, Typeable (CtxTree v t)
Typeable (CtxTree v t) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CtxTree v t -> c (CtxTree v t))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (CtxTree v t))
-> (CtxTree v t -> Constr)
-> (CtxTree v t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (CtxTree v t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (CtxTree v t)))
-> ((forall b. Data b => b -> b) -> CtxTree v t -> CtxTree v t)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r)
-> (forall u. (forall d. Data d => d -> u) -> CtxTree v t -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CtxTree v t -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t))
-> Data (CtxTree v t)
CtxTree v t -> Constr
CtxTree v t -> DataType
(forall b. Data b => b -> b) -> CtxTree v t -> CtxTree v t
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CtxTree v t -> u
forall u. (forall d. Data d => d -> u) -> CtxTree v t -> [u]
forall v t. (Data v, Data t) => Typeable (CtxTree v t)
forall v t. (Data v, Data t) => CtxTree v t -> Constr
forall v t. (Data v, Data t) => CtxTree v t -> DataType
forall v t.
(Data v, Data t) =>
(forall b. Data b => b -> b) -> CtxTree v t -> CtxTree v t
forall v t u.
(Data v, Data t) =>
Int -> (forall d. Data d => d -> u) -> CtxTree v t -> u
forall v t u.
(Data v, Data t) =>
(forall d. Data d => d -> u) -> CtxTree v t -> [u]
forall v t r r'.
(Data v, Data t) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r
forall v t r r'.
(Data v, Data t) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r
forall v t (m :: * -> *).
(Data v, Data t, Monad m) =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
forall v t (m :: * -> *).
(Data v, Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
forall v t (c :: * -> *).
(Data v, Data t) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CtxTree v t)
forall v t (c :: * -> *).
(Data v, Data t) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxTree v t -> c (CtxTree v t)
forall v t (t :: * -> *) (c :: * -> *).
(Data v, Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CtxTree v t))
forall v t (t :: * -> * -> *) (c :: * -> *).
(Data v, Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CtxTree v t))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CtxTree v t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxTree v t -> c (CtxTree v t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CtxTree v t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CtxTree v t))
$cgfoldl :: forall v t (c :: * -> *).
(Data v, Data t) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxTree v t -> c (CtxTree v t)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CtxTree v t -> c (CtxTree v t)
$cgunfold :: forall v t (c :: * -> *).
(Data v, Data t) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CtxTree v t)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CtxTree v t)
$ctoConstr :: forall v t. (Data v, Data t) => CtxTree v t -> Constr
toConstr :: CtxTree v t -> Constr
$cdataTypeOf :: forall v t. (Data v, Data t) => CtxTree v t -> DataType
dataTypeOf :: CtxTree v t -> DataType
$cdataCast1 :: forall v t (t :: * -> *) (c :: * -> *).
(Data v, Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CtxTree v t))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CtxTree v t))
$cdataCast2 :: forall v t (t :: * -> * -> *) (c :: * -> *).
(Data v, Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CtxTree v t))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CtxTree v t))
$cgmapT :: forall v t.
(Data v, Data t) =>
(forall b. Data b => b -> b) -> CtxTree v t -> CtxTree v t
gmapT :: (forall b. Data b => b -> b) -> CtxTree v t -> CtxTree v t
$cgmapQl :: forall v t r r'.
(Data v, Data t) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r
$cgmapQr :: forall v t r r'.
(Data v, Data t) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CtxTree v t -> r
$cgmapQ :: forall v t u.
(Data v, Data t) =>
(forall d. Data d => d -> u) -> CtxTree v t -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CtxTree v t -> [u]
$cgmapQi :: forall v t u.
(Data v, Data t) =>
Int -> (forall d. Data d => d -> u) -> CtxTree v t -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CtxTree v t -> u
$cgmapM :: forall v t (m :: * -> *).
(Data v, Data t, Monad m) =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
$cgmapMp :: forall v t (m :: * -> *).
(Data v, Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
$cgmapMo :: forall v t (m :: * -> *).
(Data v, Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CtxTree v t -> m (CtxTree v t)
Data, (forall x. CtxTree v t -> Rep (CtxTree v t) x)
-> (forall x. Rep (CtxTree v t) x -> CtxTree v t)
-> Generic (CtxTree v t)
forall x. Rep (CtxTree v t) x -> CtxTree v t
forall x. CtxTree v t -> Rep (CtxTree v t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v t x. Rep (CtxTree v t) x -> CtxTree v t
forall v t x. CtxTree v t -> Rep (CtxTree v t) x
$cfrom :: forall v t x. CtxTree v t -> Rep (CtxTree v t) x
from :: forall x. CtxTree v t -> Rep (CtxTree v t) x
$cto :: forall v t x. Rep (CtxTree v t) x -> CtxTree v t
to :: forall x. Rep (CtxTree v t) x -> CtxTree v t
Generic, [CtxTree v t] -> Value
[CtxTree v t] -> Encoding
CtxTree v t -> Bool
CtxTree v t -> Value
CtxTree v t -> Encoding
(CtxTree v t -> Value)
-> (CtxTree v t -> Encoding)
-> ([CtxTree v t] -> Value)
-> ([CtxTree v t] -> Encoding)
-> (CtxTree v t -> Bool)
-> ToJSON (CtxTree v t)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
forall v t. (ToJSON v, ToJSON t) => [CtxTree v t] -> Value
forall v t. (ToJSON v, ToJSON t) => [CtxTree v t] -> Encoding
forall v t. (ToJSON v, ToJSON t) => CtxTree v t -> Bool
forall v t. (ToJSON v, ToJSON t) => CtxTree v t -> Value
forall v t. (ToJSON v, ToJSON t) => CtxTree v t -> Encoding
$ctoJSON :: forall v t. (ToJSON v, ToJSON t) => CtxTree v t -> Value
toJSON :: CtxTree v t -> Value
$ctoEncoding :: forall v t. (ToJSON v, ToJSON t) => CtxTree v t -> Encoding
toEncoding :: CtxTree v t -> Encoding
$ctoJSONList :: forall v t. (ToJSON v, ToJSON t) => [CtxTree v t] -> Value
toJSONList :: [CtxTree v t] -> Value
$ctoEncodingList :: forall v t. (ToJSON v, ToJSON t) => [CtxTree v t] -> Encoding
toEncodingList :: [CtxTree v t] -> Encoding
$comitField :: forall v t. (ToJSON v, ToJSON t) => CtxTree v t -> Bool
omitField :: CtxTree v t -> Bool
ToJSON, Maybe (CtxTree v t)
Value -> Parser [CtxTree v t]
Value -> Parser (CtxTree v t)
(Value -> Parser (CtxTree v t))
-> (Value -> Parser [CtxTree v t])
-> Maybe (CtxTree v t)
-> FromJSON (CtxTree v t)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
forall v t. (FromJSON v, FromJSON t) => Maybe (CtxTree v t)
forall v t.
(FromJSON v, FromJSON t) =>
Value -> Parser [CtxTree v t]
forall v t.
(FromJSON v, FromJSON t) =>
Value -> Parser (CtxTree v t)
$cparseJSON :: forall v t.
(FromJSON v, FromJSON t) =>
Value -> Parser (CtxTree v t)
parseJSON :: Value -> Parser (CtxTree v t)
$cparseJSONList :: forall v t.
(FromJSON v, FromJSON t) =>
Value -> Parser [CtxTree v t]
parseJSONList :: Value -> Parser [CtxTree v t]
$comittedField :: forall v t. (FromJSON v, FromJSON t) => Maybe (CtxTree v t)
omittedField :: Maybe (CtxTree v t)
FromJSON, Int -> CtxTree v t -> ShowS
[CtxTree v t] -> ShowS
CtxTree v t -> String
(Int -> CtxTree v t -> ShowS)
-> (CtxTree v t -> String)
-> ([CtxTree v t] -> ShowS)
-> Show (CtxTree v t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v t. (Show v, Show t) => Int -> CtxTree v t -> ShowS
forall v t. (Show v, Show t) => [CtxTree v t] -> ShowS
forall v t. (Show v, Show t) => CtxTree v t -> String
$cshowsPrec :: forall v t. (Show v, Show t) => Int -> CtxTree v t -> ShowS
showsPrec :: Int -> CtxTree v t -> ShowS
$cshow :: forall v t. (Show v, Show t) => CtxTree v t -> String
show :: CtxTree v t -> String
$cshowList :: forall v t. (Show v, Show t) => [CtxTree v t] -> ShowS
showList :: [CtxTree v t] -> ShowS
Show)

------------------------------------------------------------
-- Contexts

-- | A context is a mapping from variable names to things.  We store
--   both a 'Map' (for efficient lookup) as well as a 'CtxTree' (for
--   sharing-aware serializing/deserializing).
data Ctx v t = Ctx {forall v t. Ctx v t -> Map v t
unCtx :: Map v t, forall v t. Ctx v t -> CtxTree v t
ctxStruct :: CtxTree v t}
  deriving ((forall a b. (a -> b) -> Ctx v a -> Ctx v b)
-> (forall a b. a -> Ctx v b -> Ctx v a) -> Functor (Ctx v)
forall a b. a -> Ctx v b -> Ctx v a
forall a b. (a -> b) -> Ctx v a -> Ctx v b
forall v a b. a -> Ctx v b -> Ctx v a
forall v a b. (a -> b) -> Ctx v a -> Ctx v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall v a b. (a -> b) -> Ctx v a -> Ctx v b
fmap :: forall a b. (a -> b) -> Ctx v a -> Ctx v b
$c<$ :: forall v a b. a -> Ctx v b -> Ctx v a
<$ :: forall a b. a -> Ctx v b -> Ctx v a
Functor, Functor (Ctx v)
Foldable (Ctx v)
(Functor (Ctx v), Foldable (Ctx v)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Ctx v a -> f (Ctx v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Ctx v (f a) -> f (Ctx v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Ctx v a -> m (Ctx v b))
-> (forall (m :: * -> *) a. Monad m => Ctx v (m a) -> m (Ctx v a))
-> Traversable (Ctx v)
forall v. Functor (Ctx v)
forall v. Foldable (Ctx v)
forall v (m :: * -> *) a. Monad m => Ctx v (m a) -> m (Ctx v a)
forall v (f :: * -> *) a.
Applicative f =>
Ctx v (f a) -> f (Ctx v a)
forall v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ctx v a -> m (Ctx v b)
forall v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ctx v a -> f (Ctx v b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Ctx v (m a) -> m (Ctx v a)
forall (f :: * -> *) a. Applicative f => Ctx v (f a) -> f (Ctx v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ctx v a -> m (Ctx v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ctx v a -> f (Ctx v b)
$ctraverse :: forall v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ctx v a -> f (Ctx v b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ctx v a -> f (Ctx v b)
$csequenceA :: forall v (f :: * -> *) a.
Applicative f =>
Ctx v (f a) -> f (Ctx v a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Ctx v (f a) -> f (Ctx v a)
$cmapM :: forall v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ctx v a -> m (Ctx v b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ctx v a -> m (Ctx v b)
$csequence :: forall v (m :: * -> *) a. Monad m => Ctx v (m a) -> m (Ctx v a)
sequence :: forall (m :: * -> *) a. Monad m => Ctx v (m a) -> m (Ctx v a)
Traversable, Typeable (Ctx v t)
Typeable (Ctx v t) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Ctx v t -> c (Ctx v t))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Ctx v t))
-> (Ctx v t -> Constr)
-> (Ctx v t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Ctx v t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ctx v t)))
-> ((forall b. Data b => b -> b) -> Ctx v t -> Ctx v t)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Ctx v t -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Ctx v t -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ctx v t -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Ctx v t -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t))
-> Data (Ctx v t)
Ctx v t -> Constr
Ctx v t -> DataType
(forall b. Data b => b -> b) -> Ctx v t -> Ctx v t
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Ctx v t -> u
forall u. (forall d. Data d => d -> u) -> Ctx v t -> [u]
forall v t. (Data v, Data t, Ord v) => Typeable (Ctx v t)
forall v t. (Data v, Data t, Ord v) => Ctx v t -> Constr
forall v t. (Data v, Data t, Ord v) => Ctx v t -> DataType
forall v t.
(Data v, Data t, Ord v) =>
(forall b. Data b => b -> b) -> Ctx v t -> Ctx v t
forall v t u.
(Data v, Data t, Ord v) =>
Int -> (forall d. Data d => d -> u) -> Ctx v t -> u
forall v t u.
(Data v, Data t, Ord v) =>
(forall d. Data d => d -> u) -> Ctx v t -> [u]
forall v t r r'.
(Data v, Data t, Ord v) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ctx v t -> r
forall v t r r'.
(Data v, Data t, Ord v) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ctx v t -> r
forall v t (m :: * -> *).
(Data v, Data t, Ord v, Monad m) =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
forall v t (m :: * -> *).
(Data v, Data t, Ord v, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
forall v t (c :: * -> *).
(Data v, Data t, Ord v) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ctx v t)
forall v t (c :: * -> *).
(Data v, Data t, Ord v) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ctx v t -> c (Ctx v t)
forall v t (t :: * -> *) (c :: * -> *).
(Data v, Data t, Ord v, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ctx v t))
forall v t (t :: * -> * -> *) (c :: * -> *).
(Data v, Data t, Ord v, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ctx v t))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ctx v t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ctx v t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ctx v t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ctx v t -> c (Ctx v t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ctx v t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ctx v t))
$cgfoldl :: forall v t (c :: * -> *).
(Data v, Data t, Ord v) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ctx v t -> c (Ctx v t)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ctx v t -> c (Ctx v t)
$cgunfold :: forall v t (c :: * -> *).
(Data v, Data t, Ord v) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ctx v t)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ctx v t)
$ctoConstr :: forall v t. (Data v, Data t, Ord v) => Ctx v t -> Constr
toConstr :: Ctx v t -> Constr
$cdataTypeOf :: forall v t. (Data v, Data t, Ord v) => Ctx v t -> DataType
dataTypeOf :: Ctx v t -> DataType
$cdataCast1 :: forall v t (t :: * -> *) (c :: * -> *).
(Data v, Data t, Ord v, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ctx v t))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ctx v t))
$cdataCast2 :: forall v t (t :: * -> * -> *) (c :: * -> *).
(Data v, Data t, Ord v, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ctx v t))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ctx v t))
$cgmapT :: forall v t.
(Data v, Data t, Ord v) =>
(forall b. Data b => b -> b) -> Ctx v t -> Ctx v t
gmapT :: (forall b. Data b => b -> b) -> Ctx v t -> Ctx v t
$cgmapQl :: forall v t r r'.
(Data v, Data t, Ord v) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ctx v t -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ctx v t -> r
$cgmapQr :: forall v t r r'.
(Data v, Data t, Ord v) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ctx v t -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ctx v t -> r
$cgmapQ :: forall v t u.
(Data v, Data t, Ord v) =>
(forall d. Data d => d -> u) -> Ctx v t -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ctx v t -> [u]
$cgmapQi :: forall v t u.
(Data v, Data t, Ord v) =>
Int -> (forall d. Data d => d -> u) -> Ctx v t -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ctx v t -> u
$cgmapM :: forall v t (m :: * -> *).
(Data v, Data t, Ord v, Monad m) =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
$cgmapMp :: forall v t (m :: * -> *).
(Data v, Data t, Ord v, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
$cgmapMo :: forall v t (m :: * -> *).
(Data v, Data t, Ord v, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ctx v t -> m (Ctx v t)
Data, (forall x. Ctx v t -> Rep (Ctx v t) x)
-> (forall x. Rep (Ctx v t) x -> Ctx v t) -> Generic (Ctx v t)
forall x. Rep (Ctx v t) x -> Ctx v t
forall x. Ctx v t -> Rep (Ctx v t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v t x. Rep (Ctx v t) x -> Ctx v t
forall v t x. Ctx v t -> Rep (Ctx v t) x
$cfrom :: forall v t x. Ctx v t -> Rep (Ctx v t) x
from :: forall x. Ctx v t -> Rep (Ctx v t) x
$cto :: forall v t x. Rep (Ctx v t) x -> Ctx v t
to :: forall x. Rep (Ctx v t) x -> Ctx v t
Generic)

-- | Get the top-level hash of a context.
ctxHash :: Ctx v t -> CtxHash
ctxHash :: forall v t. Ctx v t -> CtxHash
ctxHash (Ctx Map v t
_ (CtxTree CtxHash
h CtxF CtxTree v t
_)) = CtxHash
h

instance Show (Ctx v t) where
  -- An auto-derived, naive Show instance blows up as it loses all
  -- sharing, so have `show` simply output a placeholder.
  show :: Ctx v t -> String
show Ctx v t
_ = String
"<Ctx>"

-- | Compare contexts for equality just by comparing their hashes.
instance Eq (Ctx v t) where
  == :: Ctx v t -> Ctx v t -> Bool
(==) = CtxHash -> CtxHash -> Bool
forall a. Eq a => a -> a -> Bool
(==) (CtxHash -> CtxHash -> Bool)
-> (Ctx v t -> CtxHash) -> Ctx v t -> Ctx v t -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Ctx v t -> CtxHash
forall v t. Ctx v t -> CtxHash
ctxHash

instance (Hashable v, Hashable t) => Hashable (Ctx v t) where
  hash :: Ctx v t -> Int
hash = CtxHash -> Int
getCtxHash (CtxHash -> Int) -> (Ctx v t -> CtxHash) -> Ctx v t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v t -> CtxHash
forall v t. Ctx v t -> CtxHash
ctxHash
  hashWithSalt :: Int -> Ctx v t -> Int
hashWithSalt Int
s = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int -> Int) -> (Ctx v t -> Int) -> Ctx v t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CtxHash -> Int
getCtxHash (CtxHash -> Int) -> (Ctx v t -> CtxHash) -> Ctx v t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v t -> CtxHash
forall v t. Ctx v t -> CtxHash
ctxHash

instance Foldable (Ctx v) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Ctx v a -> m
foldMap a -> m
f = (a -> m) -> Map v a -> m
forall m a. Monoid m => (a -> m) -> Map v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (Map v a -> m) -> (Ctx v a -> Map v a) -> Ctx v a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v a -> Map v a
forall v t. Ctx v t -> Map v t
unCtx

-- | Rebuild a complete 'Ctx' from a 'CtxTree'.
ctxFromTree :: Ord v => CtxTree v t -> Ctx v t
ctxFromTree :: forall v t. Ord v => CtxTree v t -> Ctx v t
ctxFromTree CtxTree v t
tree = Map v t -> CtxTree v t -> Ctx v t
forall v t. Map v t -> CtxTree v t -> Ctx v t
Ctx (CtxTree v t -> Map v t
forall {k} {a}. Ord k => CtxTree k a -> Map k a
varMap CtxTree v t
tree) CtxTree v t
tree
 where
  varMap :: CtxTree k a -> Map k a
varMap (CtxTree CtxHash
_ CtxF CtxTree k a
s) = case CtxF CtxTree k a
s of
    CtxF CtxTree k a
CtxEmpty -> Map k a
forall k a. Map k a
M.empty
    CtxSingle k
x a
t -> k -> a -> Map k a
forall k a. k -> a -> Map k a
M.singleton k
x a
t
    CtxDelete k
x a
_ CtxTree k a
s1 -> k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
x (CtxTree k a -> Map k a
varMap CtxTree k a
s1)
    CtxUnion CtxTree k a
s1 CtxTree k a
s2 -> CtxTree k a -> Map k a
varMap CtxTree k a
s2 Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` CtxTree k a -> Map k a
varMap CtxTree k a
s1

-- | "Roll up" one level of context structure while building a new
--   top-level Map and computing an appropriate top-level hash.
--
--   In other words, the input of type @CtxF Ctx t@ represents a
--   context where the topmost level of structure is split out by
--   itself as 'CtxF', with the rest of the recursive structure stored
--   in the embedded 'Ctx' values.  'rollCtx' takes the single level
--   of structure with recursive subtrees and "rolls them up" into one
--   recursive tree.
rollCtx :: (Ord v, Hashable v, Hashable t) => CtxF Ctx v t -> Ctx v t
rollCtx :: forall v t.
(Ord v, Hashable v, Hashable t) =>
CtxF Ctx v t -> Ctx v t
rollCtx CtxF Ctx v t
s = Map v t -> CtxTree v t -> Ctx v t
forall v t. Map v t -> CtxTree v t -> Ctx v t
Ctx Map v t
m (CtxHash -> CtxF CtxTree v t -> CtxTree v t
forall v t. CtxHash -> CtxF CtxTree v t -> CtxTree v t
CtxTree CtxHash
h ((Ctx v t -> CtxTree v t) -> CtxF Ctx v t -> CtxF CtxTree v t
forall (f :: * -> * -> *) v t (g :: * -> * -> *).
(f v t -> g v t) -> CtxF f v t -> CtxF g v t
restructureCtx Ctx v t -> CtxTree v t
forall v t. Ctx v t -> CtxTree v t
ctxStruct CtxF Ctx v t
s))
 where
  (Map v t
m, CtxHash
h) = case CtxF Ctx v t
s of
    CtxF Ctx v t
CtxEmpty -> (Map v t
forall k a. Map k a
M.empty, CtxHash
0)
    CtxSingle v
x t
t -> (v -> t -> Map v t
forall k a. k -> a -> Map k a
M.singleton v
x t
t, v -> t -> CtxHash
forall v t. (Hashable v, Hashable t) => v -> t -> CtxHash
singletonHash v
x t
t)
    CtxDelete v
x t
_ (Ctx Map v t
m1 (CtxTree CtxHash
h1 CtxF CtxTree v t
_)) -> case v -> Map v t -> Maybe t
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup v
x Map v t
m1 of
      Maybe t
Nothing -> (Map v t
m1, CtxHash
h1)
      Just t
t' -> (v -> Map v t -> Map v t
forall k a. Ord k => k -> Map k a -> Map k a
M.delete v
x Map v t
m1, CtxHash
h1 CtxHash -> CtxHash -> CtxHash
forall a. Num a => a -> a -> a
- v -> t -> CtxHash
forall v t. (Hashable v, Hashable t) => v -> t -> CtxHash
singletonHash v
x t
t')
    CtxUnion (Ctx Map v t
m1 (CtxTree CtxHash
h1 CtxF CtxTree v t
_)) (Ctx Map v t
m2 (CtxTree CtxHash
h2 CtxF CtxTree v t
_)) -> (Map v t
m2 Map v t -> Map v t -> Map v t
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map v t
m1, CtxHash
h')
     where
      -- `Data.Map.intersection l r` returns a map with common keys,
      -- but values from `l`.  The values in m1 are the ones we want
      -- to subtract from the hash, since they are the ones that will
      -- be overwritten.
      overwritten :: Map v t
overwritten = Map v t -> Map v t -> Map v t
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection Map v t
m1 Map v t
m2
      h' :: CtxHash
h' = CtxHash
h1 CtxHash -> CtxHash -> CtxHash
forall a. Num a => a -> a -> a
+ CtxHash
h2 CtxHash -> CtxHash -> CtxHash
forall a. Num a => a -> a -> a
- Map v t -> CtxHash
forall v t. (Hashable v, Hashable t) => Map v t -> CtxHash
mapHash Map v t
overwritten

------------------------------------------------------------
-- Context instances

-- | Serialize a context simply as its hash; we assume that a
--   top-level CtxMap has been seralized somewhere, from which we can
--   recover this context by looking it up.
instance ToJSON (Ctx v t) where
  toJSON :: Ctx v t -> Value
toJSON = CtxHash -> Value
forall a. ToJSON a => a -> Value
toJSON (CtxHash -> Value) -> (Ctx v t -> CtxHash) -> Ctx v t -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v t -> CtxHash
forall v t. Ctx v t -> CtxHash
ctxHash

-- | Deserialize a context.  We expect to see a hash, and look it up
--   in the provided CtxMap.
instance Ord v => FromJSONE (CtxMap CtxTree v t) (Ctx v t) where
  parseJSONE :: Value -> ParserE (CtxMap CtxTree v t) (Ctx v t)
parseJSONE Value
v = do
    CtxHash
h <- Parser CtxHash -> With (CtxMap CtxTree v t) Parser CtxHash
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Parser CtxHash -> With (CtxMap CtxTree v t) Parser CtxHash)
-> Parser CtxHash -> With (CtxMap CtxTree v t) Parser CtxHash
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON @CtxHash Value
v
    CtxMap CtxTree v t
m <- With (CtxMap CtxTree v t) Parser (CtxMap CtxTree v t)
forall (f :: * -> *) e. Monad f => With e f e
getE
    case CtxHash -> CtxMap CtxTree v t -> Maybe (Ctx v t)
forall v t.
Ord v =>
CtxHash -> CtxMap CtxTree v t -> Maybe (Ctx v t)
getCtx CtxHash
h CtxMap CtxTree v t
m of
      Maybe (Ctx v t)
Nothing -> [Text] -> ParserE (CtxMap CtxTree v t) (Ctx v t)
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Encountered unknown context hash", CtxHash -> Text
forall a. Show a => a -> Text
showT CtxHash
h]
      Just Ctx v t
ctx -> Ctx v t -> ParserE (CtxMap CtxTree v t) (Ctx v t)
forall a. a -> With (CtxMap CtxTree v t) Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ctx v t
ctx

instance (PrettyPrec t) => PrettyPrec (Ctx v t) where
  prettyPrec :: forall ann. Int -> Ctx v t -> Doc ann
prettyPrec Int
_ Ctx v t
_ = Doc ann
"<Ctx>"

-- | The semigroup operation for contexts is /right/-biased union.
instance (Ord v, Hashable v, Hashable t) => Semigroup (Ctx v t) where
  <> :: Ctx v t -> Ctx v t -> Ctx v t
(<>) = Ctx v t -> Ctx v t -> Ctx v t
forall v t.
(Ord v, Hashable v, Hashable t) =>
Ctx v t -> Ctx v t -> Ctx v t
union

instance (Ord v, Hashable v, Hashable t) => Monoid (Ctx v t) where
  mempty :: Ctx v t
mempty = Ctx v t
forall v t. Ctx v t
empty
  mappend :: Ctx v t -> Ctx v t -> Ctx v t
mappend = Ctx v t -> Ctx v t -> Ctx v t
forall a. Semigroup a => a -> a -> a
(<>)

instance AsEmpty (Ctx v t) where
  _Empty :: Prism' (Ctx v t) ()
_Empty = (() -> Ctx v t)
-> (Ctx v t -> Either (Ctx v t) ()) -> Prism' (Ctx v t) ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Ctx v t -> () -> Ctx v t
forall a b. a -> b -> a
const Ctx v t
forall v t. Ctx v t
empty) Ctx v t -> Either (Ctx v t) ()
forall {k} {a}. Ctx k a -> Either (Ctx k a) ()
isEmpty
   where
    isEmpty :: Ctx k a -> Either (Ctx k a) ()
isEmpty Ctx k a
c
      | Map k a -> Bool
forall k a. Map k a -> Bool
M.null (Ctx k a -> Map k a
forall v t. Ctx v t -> Map v t
unCtx Ctx k a
c) = () -> Either (Ctx k a) ()
forall a b. b -> Either a b
Right ()
      | Bool
otherwise = Ctx k a -> Either (Ctx k a) ()
forall a b. a -> Either a b
Left Ctx k a
c

------------------------------------------------------------
-- Context operations

-- | The empty context.
empty :: Ctx v t
-- We could also define empty = rollCtx CtxEmpty but that would introduce an
-- unnecessary Hashable t constraint.
empty :: forall v t. Ctx v t
empty = Map v t -> CtxTree v t -> Ctx v t
forall v t. Map v t -> CtxTree v t -> Ctx v t
Ctx Map v t
forall k a. Map k a
M.empty (CtxHash -> CtxF CtxTree v t -> CtxTree v t
forall v t. CtxHash -> CtxF CtxTree v t -> CtxTree v t
CtxTree CtxHash
forall a. Monoid a => a
mempty CtxF CtxTree v t
forall (f :: * -> * -> *) v t. CtxF f v t
CtxEmpty)

-- | A singleton context.
singleton :: (Ord v, Hashable v, Hashable t) => v -> t -> Ctx v t
singleton :: forall v t. (Ord v, Hashable v, Hashable t) => v -> t -> Ctx v t
singleton v
x t
t = CtxF Ctx v t -> Ctx v t
forall v t.
(Ord v, Hashable v, Hashable t) =>
CtxF Ctx v t -> Ctx v t
rollCtx (CtxF Ctx v t -> Ctx v t) -> CtxF Ctx v t -> Ctx v t
forall a b. (a -> b) -> a -> b
$ v -> t -> CtxF Ctx v t
forall (f :: * -> * -> *) v t. v -> t -> CtxF f v t
CtxSingle v
x t
t

-- | Create a 'Ctx' from a 'Map'.
fromMap :: (Ord v, Hashable v, Hashable t) => Map v t -> Ctx v t
fromMap :: forall v t. (Ord v, Hashable v, Hashable t) => Map v t -> Ctx v t
fromMap Map v t
m = case [(v, t)] -> Maybe (NonEmpty (v, t))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Map v t -> [(v, t)]
forall k a. Map k a -> [(k, a)]
M.assocs Map v t
m) of
  Maybe (NonEmpty (v, t))
Nothing -> Ctx v t
forall v t. Ctx v t
empty
  Just NonEmpty (v, t)
ne -> (Ctx v t -> Ctx v t -> Ctx v t) -> NonEmpty (Ctx v t) -> Ctx v t
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Ctx v t -> Ctx v t -> Ctx v t
forall v t.
(Ord v, Hashable v, Hashable t) =>
Ctx v t -> Ctx v t -> Ctx v t
union (((v, t) -> Ctx v t) -> NonEmpty (v, t) -> NonEmpty (Ctx v t)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ((v -> t -> Ctx v t) -> (v, t) -> Ctx v t
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry v -> t -> Ctx v t
forall v t. (Ord v, Hashable v, Hashable t) => v -> t -> Ctx v t
singleton) NonEmpty (v, t)
ne)

-- | Look up a variable in a context.
lookup :: Ord v => v -> Ctx v t -> Maybe t
lookup :: forall v t. Ord v => v -> Ctx v t -> Maybe t
lookup v
x = v -> Map v t -> Maybe t
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup v
x (Map v t -> Maybe t) -> (Ctx v t -> Map v t) -> Ctx v t -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v t -> Map v t
forall v t. Ctx v t -> Map v t
unCtx

-- | Look up a variable in a context in an ambient Reader effect.
lookupR :: (Ord v, Has (Reader (Ctx v t)) sig m) => v -> m (Maybe t)
lookupR :: forall v t (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Ord v, Has (Reader (Ctx v t)) sig m) =>
v -> m (Maybe t)
lookupR v
x = v -> Ctx v t -> Maybe t
forall v t. Ord v => v -> Ctx v t -> Maybe t
lookup v
x (Ctx v t -> Maybe t) -> m (Ctx v t) -> m (Maybe t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Ctx v t)
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
m r
ask

-- | Delete a variable from a context.
delete :: (Ord v, Hashable v, Hashable t) => v -> Ctx v t -> Ctx v t
delete :: forall v t.
(Ord v, Hashable v, Hashable t) =>
v -> Ctx v t -> Ctx v t
delete v
x ctx :: Ctx v t
ctx@(Ctx Map v t
m CtxTree v t
_) = case v -> Map v t -> Maybe t
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup v
x Map v t
m of
  Maybe t
Nothing -> Ctx v t
ctx
  Just t
t -> CtxF Ctx v t -> Ctx v t
forall v t.
(Ord v, Hashable v, Hashable t) =>
CtxF Ctx v t -> Ctx v t
rollCtx (CtxF Ctx v t -> Ctx v t) -> CtxF Ctx v t -> Ctx v t
forall a b. (a -> b) -> a -> b
$ v -> t -> Ctx v t -> CtxF Ctx v t
forall (f :: * -> * -> *) v t. v -> t -> f v t -> CtxF f v t
CtxDelete v
x t
t Ctx v t
ctx

-- | Get the list of key-value associations from a context.
assocs :: Ctx v t -> [(v, t)]
assocs :: forall v t. Ctx v t -> [(v, t)]
assocs = Map v t -> [(v, t)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map v t -> [(v, t)])
-> (Ctx v t -> Map v t) -> Ctx v t -> [(v, t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v t -> Map v t
forall v t. Ctx v t -> Map v t
unCtx

-- | Get the list of bound variables from a context.
vars :: Ctx v t -> [v]
vars :: forall v t. Ctx v t -> [v]
vars = Map v t -> [v]
forall k a. Map k a -> [k]
M.keys (Map v t -> [v]) -> (Ctx v t -> Map v t) -> Ctx v t -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v t -> Map v t
forall v t. Ctx v t -> Map v t
unCtx

-- | Add a key-value binding to a context (overwriting the old one if
--   the key is already present).
addBinding :: (Ord v, Hashable v, Hashable t) => v -> t -> Ctx v t -> Ctx v t
addBinding :: forall v t.
(Ord v, Hashable v, Hashable t) =>
v -> t -> Ctx v t -> Ctx v t
addBinding v
x t
t Ctx v t
ctx = Ctx v t
ctx Ctx v t -> Ctx v t -> Ctx v t
forall v t.
(Ord v, Hashable v, Hashable t) =>
Ctx v t -> Ctx v t -> Ctx v t
`union` v -> t -> Ctx v t
forall v t. (Ord v, Hashable v, Hashable t) => v -> t -> Ctx v t
singleton v
x t
t

-- | /Right/-biased union of contexts.
union :: (Ord v, Hashable v, Hashable t) => Ctx v t -> Ctx v t -> Ctx v t
union :: forall v t.
(Ord v, Hashable v, Hashable t) =>
Ctx v t -> Ctx v t -> Ctx v t
union Ctx v t
ctx1 Ctx v t
ctx2 = CtxF Ctx v t -> Ctx v t
forall v t.
(Ord v, Hashable v, Hashable t) =>
CtxF Ctx v t -> Ctx v t
rollCtx (CtxF Ctx v t -> Ctx v t) -> CtxF Ctx v t -> Ctx v t
forall a b. (a -> b) -> a -> b
$ Ctx v t -> Ctx v t -> CtxF Ctx v t
forall (f :: * -> * -> *) v t. f v t -> f v t -> CtxF f v t
CtxUnion Ctx v t
ctx1 Ctx v t
ctx2

-- | Locally extend the context with an additional binding.
withBinding :: (Has (Reader (Ctx v t)) sig m, Ord v, Hashable v, Hashable t) => v -> t -> m a -> m a
withBinding :: forall v t (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader (Ctx v t)) sig m, Ord v, Hashable v, Hashable t) =>
v -> t -> m a -> m a
withBinding v
x t
ty = (Ctx v t -> Ctx v t) -> m a -> m a
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Reader r) sig m =>
(r -> r) -> m a -> m a
local (v -> t -> Ctx v t -> Ctx v t
forall v t.
(Ord v, Hashable v, Hashable t) =>
v -> t -> Ctx v t -> Ctx v t
addBinding v
x t
ty)

-- | Locally extend the context with an additional context of
--   bindings.
withBindings :: (Has (Reader (Ctx v t)) sig m, Ord v, Hashable v, Hashable t) => Ctx v t -> m a -> m a
withBindings :: forall v t (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader (Ctx v t)) sig m, Ord v, Hashable v, Hashable t) =>
Ctx v t -> m a -> m a
withBindings Ctx v t
ctx = (Ctx v t -> Ctx v t) -> m a -> m a
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Reader r) sig m =>
(r -> r) -> m a -> m a
local (Ctx v t -> Ctx v t -> Ctx v t
forall v t.
(Ord v, Hashable v, Hashable t) =>
Ctx v t -> Ctx v t -> Ctx v t
`union` Ctx v t
ctx)

------------------------------------------------------------
-- Context serializing/deserializing

-- | A 'CtxMap' maps context hashes to context structures.  Those
--   structures could either be complete context trees, or just a
--   single level of structure containing more hashes.
type CtxMap f v t = Map CtxHash (CtxF f v t)

-- | Reconstitute the context corresponding to a particular hash, by
--   looking it up in a context map.
getCtx :: Ord v => CtxHash -> CtxMap CtxTree v t -> Maybe (Ctx v t)
getCtx :: forall v t.
Ord v =>
CtxHash -> CtxMap CtxTree v t -> Maybe (Ctx v t)
getCtx CtxHash
h CtxMap CtxTree v t
m = CtxTree v t -> Ctx v t
forall v t. Ord v => CtxTree v t -> Ctx v t
ctxFromTree (CtxTree v t -> Ctx v t)
-> (CtxF CtxTree v t -> CtxTree v t) -> CtxF CtxTree v t -> Ctx v t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CtxHash -> CtxF CtxTree v t -> CtxTree v t
forall v t. CtxHash -> CtxF CtxTree v t -> CtxTree v t
CtxTree CtxHash
h (CtxF CtxTree v t -> Ctx v t)
-> Maybe (CtxF CtxTree v t) -> Maybe (Ctx v t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CtxHash -> CtxMap CtxTree v t -> Maybe (CtxF CtxTree v t)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CtxHash
h CtxMap CtxTree v t
m

-- | Turn a context into a context map containing every subtree of its
--   structure.
toCtxMap :: Ord v => Ctx v t -> CtxMap CtxTree v t
toCtxMap :: forall v t. Ord v => Ctx v t -> CtxMap CtxTree v t
toCtxMap (Ctx Map v t
m CtxTree v t
s) = Identity (CtxMap CtxTree v t) -> CtxMap CtxTree v t
forall a. Identity a -> a
run (Identity (CtxMap CtxTree v t) -> CtxMap CtxTree v t)
-> Identity (CtxMap CtxTree v t) -> CtxMap CtxTree v t
forall a b. (a -> b) -> a -> b
$ CtxMap CtxTree v t
-> StateC (CtxMap CtxTree v t) Identity ()
-> Identity (CtxMap CtxTree v t)
forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m s
execState CtxMap CtxTree v t
forall k a. Map k a
M.empty (Map v t -> CtxTree v t -> StateC (CtxMap CtxTree v t) Identity ()
forall v t (m :: * -> *) (sig :: (* -> *) -> * -> *).
(Ord v, Has (State (CtxMap CtxTree v t)) sig m) =>
Map v t -> CtxTree v t -> m ()
buildCtxMap Map v t
m CtxTree v t
s)

-- | Build a context map by keeping track of the incrementally built
--   map in a state effect, and traverse the given context structure
--   to add all subtrees to the map---but, of course, stopping without
--   recursing further whenever we see a hash that is already in the
--   map.
buildCtxMap ::
  forall v t m sig.
  (Ord v, Has (State (CtxMap CtxTree v t)) sig m) =>
  Map v t ->
  CtxTree v t ->
  m ()
buildCtxMap :: forall v t (m :: * -> *) (sig :: (* -> *) -> * -> *).
(Ord v, Has (State (CtxMap CtxTree v t)) sig m) =>
Map v t -> CtxTree v t -> m ()
buildCtxMap Map v t
m (CtxTree CtxHash
h CtxF CtxTree v t
s) = do
  CtxMap CtxTree v t
cm <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @(CtxMap CtxTree v t)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CtxHash
h CtxHash -> CtxMap CtxTree v t -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` CtxMap CtxTree v t
cm) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    (CtxMap CtxTree v t -> CtxMap CtxTree v t) -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify (CtxHash
-> CtxF CtxTree v t -> CtxMap CtxTree v t -> CtxMap CtxTree v t
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert CtxHash
h CtxF CtxTree v t
s)
    case CtxF CtxTree v t
s of
      CtxF CtxTree v t
CtxEmpty -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      CtxSingle {} -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      CtxDelete v
x t
t CtxTree v t
s1 -> Map v t -> CtxTree v t -> m ()
forall v t (m :: * -> *) (sig :: (* -> *) -> * -> *).
(Ord v, Has (State (CtxMap CtxTree v t)) sig m) =>
Map v t -> CtxTree v t -> m ()
buildCtxMap (v -> t -> Map v t -> Map v t
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert v
x t
t Map v t
m) CtxTree v t
s1
      CtxUnion CtxTree v t
s1 CtxTree v t
s2 -> Map v t -> CtxTree v t -> m ()
forall v t (m :: * -> *) (sig :: (* -> *) -> * -> *).
(Ord v, Has (State (CtxMap CtxTree v t)) sig m) =>
Map v t -> CtxTree v t -> m ()
buildCtxMap Map v t
m CtxTree v t
s1 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map v t -> CtxTree v t -> m ()
forall v t (m :: * -> *) (sig :: (* -> *) -> * -> *).
(Ord v, Has (State (CtxMap CtxTree v t)) sig m) =>
Map v t -> CtxTree v t -> m ()
buildCtxMap Map v t
m CtxTree v t
s2

newtype ConstHash v t = ConstHash CtxHash
  deriving (ConstHash v t -> ConstHash v t -> Bool
(ConstHash v t -> ConstHash v t -> Bool)
-> (ConstHash v t -> ConstHash v t -> Bool) -> Eq (ConstHash v t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v t. ConstHash v t -> ConstHash v t -> Bool
$c== :: forall v t. ConstHash v t -> ConstHash v t -> Bool
== :: ConstHash v t -> ConstHash v t -> Bool
$c/= :: forall v t. ConstHash v t -> ConstHash v t -> Bool
/= :: ConstHash v t -> ConstHash v t -> Bool
Eq, Int -> ConstHash v t -> ShowS
[ConstHash v t] -> ShowS
ConstHash v t -> String
(Int -> ConstHash v t -> ShowS)
-> (ConstHash v t -> String)
-> ([ConstHash v t] -> ShowS)
-> Show (ConstHash v t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v t. Int -> ConstHash v t -> ShowS
forall v t. [ConstHash v t] -> ShowS
forall v t. ConstHash v t -> String
$cshowsPrec :: forall v t. Int -> ConstHash v t -> ShowS
showsPrec :: Int -> ConstHash v t -> ShowS
$cshow :: forall v t. ConstHash v t -> String
show :: ConstHash v t -> String
$cshowList :: forall v t. [ConstHash v t] -> ShowS
showList :: [ConstHash v t] -> ShowS
Show, (forall x. ConstHash v t -> Rep (ConstHash v t) x)
-> (forall x. Rep (ConstHash v t) x -> ConstHash v t)
-> Generic (ConstHash v t)
forall x. Rep (ConstHash v t) x -> ConstHash v t
forall x. ConstHash v t -> Rep (ConstHash v t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v t x. Rep (ConstHash v t) x -> ConstHash v t
forall v t x. ConstHash v t -> Rep (ConstHash v t) x
$cfrom :: forall v t x. ConstHash v t -> Rep (ConstHash v t) x
from :: forall x. ConstHash v t -> Rep (ConstHash v t) x
$cto :: forall v t x. Rep (ConstHash v t) x -> ConstHash v t
to :: forall x. Rep (ConstHash v t) x -> ConstHash v t
Generic, [ConstHash v t] -> Value
[ConstHash v t] -> Encoding
ConstHash v t -> Bool
ConstHash v t -> Value
ConstHash v t -> Encoding
(ConstHash v t -> Value)
-> (ConstHash v t -> Encoding)
-> ([ConstHash v t] -> Value)
-> ([ConstHash v t] -> Encoding)
-> (ConstHash v t -> Bool)
-> ToJSON (ConstHash v t)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
forall v t. [ConstHash v t] -> Value
forall v t. [ConstHash v t] -> Encoding
forall v t. ConstHash v t -> Bool
forall v t. ConstHash v t -> Value
forall v t. ConstHash v t -> Encoding
$ctoJSON :: forall v t. ConstHash v t -> Value
toJSON :: ConstHash v t -> Value
$ctoEncoding :: forall v t. ConstHash v t -> Encoding
toEncoding :: ConstHash v t -> Encoding
$ctoJSONList :: forall v t. [ConstHash v t] -> Value
toJSONList :: [ConstHash v t] -> Value
$ctoEncodingList :: forall v t. [ConstHash v t] -> Encoding
toEncodingList :: [ConstHash v t] -> Encoding
$comitField :: forall v t. ConstHash v t -> Bool
omitField :: ConstHash v t -> Bool
ToJSON, Maybe (ConstHash v t)
Value -> Parser [ConstHash v t]
Value -> Parser (ConstHash v t)
(Value -> Parser (ConstHash v t))
-> (Value -> Parser [ConstHash v t])
-> Maybe (ConstHash v t)
-> FromJSON (ConstHash v t)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
forall v t. Maybe (ConstHash v t)
forall v t. Value -> Parser [ConstHash v t]
forall v t. Value -> Parser (ConstHash v t)
$cparseJSON :: forall v t. Value -> Parser (ConstHash v t)
parseJSON :: Value -> Parser (ConstHash v t)
$cparseJSONList :: forall v t. Value -> Parser [ConstHash v t]
parseJSONList :: Value -> Parser [ConstHash v t]
$comittedField :: forall v t. Maybe (ConstHash v t)
omittedField :: Maybe (ConstHash v t)
FromJSON)

-- | "Dehydrate" a context map by replacing the actual context trees
--   with single structure layers containing only hashes.  A
--   dehydrated context map is very suitable for serializing, since it
--   makes sharing completely explicit---even if a given context is
--   referenced multiple times, the references are simply hash values,
--   and the context is stored only once, under its hash.
dehydrate :: CtxMap CtxTree v t -> CtxMap ConstHash v t
dehydrate :: forall v t. CtxMap CtxTree v t -> CtxMap ConstHash v t
dehydrate = (CtxF CtxTree v t -> CtxF ConstHash v t)
-> Map CtxHash (CtxF CtxTree v t)
-> Map CtxHash (CtxF ConstHash v t)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((CtxTree v t -> ConstHash v t)
-> CtxF CtxTree v t -> CtxF ConstHash v t
forall (f :: * -> * -> *) v t (g :: * -> * -> *).
(f v t -> g v t) -> CtxF f v t -> CtxF g v t
restructureCtx (\(CtxTree CtxHash
h1 CtxF CtxTree v t
_) -> CtxHash -> ConstHash v t
forall v t. CtxHash -> ConstHash v t
ConstHash CtxHash
h1))

-- | "Rehydrate" a dehydrated context map by replacing every hash with
--   an actual context structure.  We do this by building the result
--   as a lazy, recursive map, replacing each hash by the result we
--   get when looking it up in the map being built.  A context which
--   is referenced multiple times will thus be shared in memory.
rehydrate :: CtxMap ConstHash v t -> CtxMap CtxTree v t
rehydrate :: forall v t. CtxMap ConstHash v t -> CtxMap CtxTree v t
rehydrate CtxMap ConstHash v t
m = Map CtxHash (CtxF CtxTree v t)
m'
 where
  m' :: Map CtxHash (CtxF CtxTree v t)
m' = (CtxF ConstHash v t -> CtxF CtxTree v t)
-> CtxMap ConstHash v t -> Map CtxHash (CtxF CtxTree v t)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((ConstHash v t -> CtxTree v t)
-> CtxF ConstHash v t -> CtxF CtxTree v t
forall (f :: * -> * -> *) v t (g :: * -> * -> *).
(f v t -> g v t) -> CtxF f v t -> CtxF g v t
restructureCtx (\(ConstHash CtxHash
h) -> CtxHash -> CtxF CtxTree v t -> CtxTree v t
forall v t. CtxHash -> CtxF CtxTree v t -> CtxTree v t
CtxTree CtxHash
h (Map CtxHash (CtxF CtxTree v t)
m' Map CtxHash (CtxF CtxTree v t) -> CtxHash -> CtxF CtxTree v t
forall k a. Ord k => Map k a -> k -> a
M.! CtxHash
h))) CtxMap ConstHash v t
m