{-# LANGUAGE UndecidableInstances, MagicHash #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wunused-imports #-}
{-# OPTIONS_GHC -Wunused-matches #-}
{-# OPTIONS_GHC -Wunused-binds #-}

-- | Serializing types that are not Agda-specific.

module Mikan.TypeChecking.Serialise.Instances.General where

import Mikan.Utils.Monad
import Control.Monad.Reader (asks, ReaderT(..), runReaderT)

import Data.Foldable qualified as Fold
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HMap
import Data.Int (Int32)
import Data.IntSet (IntSet)
import Data.IntSet qualified as IntSet
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Primitive.ByteArray
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Strict.Tuple (Pair(..))
import Data.Text (Text)
import Data.Text.Internal qualified as T
import Data.Text.Short (ShortText)
import Data.Typeable
import Data.Void
import Data.Word (Word32, Word64)
import Data.HashSet (HashSet)
import Data.HashSet qualified as HSet

import GHC.Float (castWord64ToDouble)

import Mikan.TypeChecking.Serialise.Base

import Mikan.Utils.BiMap (BiMap)
import Mikan.Utils.BiMap qualified as BiMap
import Mikan.Utils.DocTree qualified as DocTree
import Mikan.Utils.Functor
import Mikan.Utils.List1 (List1)
import Mikan.Utils.List1 qualified as List1
import Mikan.Utils.List2 (List2)
import Mikan.Utils.List2 qualified as List2
import Mikan.Utils.Maybe.Strict qualified as Strict
import Mikan.Utils.MinimalArray.Lifted qualified as AL
import Mikan.Utils.Set1 (Set1)
import Mikan.Utils.Set1 qualified as Set1
import Mikan.Utils.ShortText qualified as TS
import Mikan.Utils.SmallSet (SmallSet(..))
import Mikan.Utils.Trie (Trie(..))
import Mikan.Utils.VarSet (VarSet(..))
import Mikan.Utils.WithDefault

---------------------------------------------------------------------------
-- Base types

instance EmbPrj Void where
  icod_ :: Void -> S Word32
icod_ = Void -> S Word32
forall a. Void -> a
absurd
  value :: Word32 -> R Void
value = (Node -> R Void) -> Word32 -> R Void
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase Node -> R Void
forall {p} {a}. p -> R a
valu where valu :: p -> R a
valu p
_ = R a
forall a. R a
malformed

instance EmbPrj () where
  icod_ :: () -> S Word32
icod_ () = Word32 -> S Word32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
0

  value :: Word32 -> R ()
value Word32
0 = () -> R ()
forall a. a -> ReaderT Decode IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  value Word32
_ = R ()
forall a. R a
malformed

instance EmbPrj Bool where
  icod_ :: Bool -> S Word32
icod_ Bool
False = Word32 -> S Word32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
0
  icod_ Bool
True  = Word32 -> S Word32
forall a. a -> ReaderT Dict IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
1

  value :: Word32 -> R Bool
value Word32
0 = Bool -> R Bool
forall a. a -> ReaderT Decode IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  value Word32
1 = Bool -> R Bool
forall a. a -> ReaderT Decode IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  value Word32
_ = R Bool
forall a. R a
malformed

instance EmbPrj Char where
  icod_ :: Char -> S Word32
icod_ Char
c = Word32 -> S Word32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> S Word32) -> Word32 -> S Word32
forall a b. (a -> b) -> a -> b
$! Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c
  value :: Word32 -> R Char
value Word32
i = Char -> R Char
forall a. a -> ReaderT Decode IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> R Char) -> Char -> R Char
forall a b. (a -> b) -> a -> b
$! Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
i

-- Numeric types

instance EmbPrj Double where
  icod_ :: Double -> S Word32
icod_   = Double -> S Word32
icodeDouble
  value :: Word32 -> R Double
value Word32
i = do
    !bits <- (Array Word64 -> Int -> Word64) -> Int -> Array Word64 -> Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip Array Word64 -> Int -> Word64
forall a. Array a -> Int -> a
AL.unsafeIndex (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i) (Array Word64 -> Word64)
-> ReaderT Decode IO (Array Word64) -> ReaderT Decode IO Word64
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (Decode -> Array Word64) -> ReaderT Decode IO (Array Word64)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Array Word64
doubleA
    pure $! castWord64ToDouble bits

-- Andreas, Agda Hackathon 2024-10-15
-- Are we sure we never use an Int that does not fit into 32 bits?
instance EmbPrj Int where
  icod_ :: Int -> S Word32
icod_ Int
i = Word32 -> S Word32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> S Word32) -> Word32 -> S Word32
forall a b. (a -> b) -> a -> b
$! Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
  value :: Word32 -> R Int
value Word32
i = Int -> R Int
forall a. a -> ReaderT Decode IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> R Int) -> Int -> R Int
forall a b. (a -> b) -> a -> b
$! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i

instance EmbPrj Int32 where
  icod_ :: Int32 -> S Word32
icod_ Int32
i = Word32 -> S Word32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> S Word32) -> Word32 -> S Word32
forall a b. (a -> b) -> a -> b
$! Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i
  value :: Word32 -> R Int32
value Word32
i = Int32 -> R Int32
forall a. a -> ReaderT Decode IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> R Int32) -> Int32 -> R Int32
forall a b. (a -> b) -> a -> b
$! Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i

instance EmbPrj Integer where
  icod_ :: Integer -> S Word32
icod_   = Integer -> S Word32
icodeInteger
  value :: Word32 -> R Integer
value Word32
i = (Array Integer -> Int -> Integer)
-> Int -> Array Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Array Integer -> Int -> Integer
forall a. Array a -> Int -> a
AL.unsafeIndex (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i) (Array Integer -> Integer)
-> ReaderT Decode IO (Array Integer) -> R Integer
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (Decode -> Array Integer) -> ReaderT Decode IO (Array Integer)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Array Integer
integerA

instance EmbPrj Word32 where
  icod_ :: Word32 -> S Word32
icod_ Word32
i = Word32 -> S Word32
forall a. a -> ReaderT Dict IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
i
  value :: Word32 -> R Word32
value Word32
i = Word32 -> R Word32
forall a. a -> ReaderT Decode IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
i

instance EmbPrj Word64 where
  icod_ :: Word64 -> S Word32
icod_ Word64
i = (Word32 -> Word32 -> Word32)
-> Arrows (Domains (Word32 -> Word32 -> Word32)) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' (Word32 -> Word32 -> Word32
forall a. HasCallStack => a
undefined :: Word32 -> Word32 -> Word32) (Word64 -> Word32
word32 Word64
q) (Word64 -> Word32
word32 Word64
r)
    where (Word64
q, Word64
r) = Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
quotRem Word64
i (Word64
2 Word64 -> Integer -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
32)
          word32 :: Word64 -> Word32
          word32 :: Word64 -> Word32
word32 = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

  value :: Word32 -> ReaderT Decode IO Word64
value = (Node -> ReaderT Decode IO Word64)
-> Word32 -> ReaderT Decode IO Word64
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase Node -> ReaderT Decode IO Word64
valu where
    valu :: Node -> ReaderT Decode IO Word64
valu (N2 Word32
a Word32
b) = Word64 -> ReaderT Decode IO Word64
forall a. a -> ReaderT Decode IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ReaderT Decode IO Word64)
-> Word64 -> ReaderT Decode IO Word64
forall a b. (a -> b) -> a -> b
$! Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
b
    valu Node
_        = ReaderT Decode IO Word64
forall a. R a
malformed
    n :: Word64
n = Word64
2 Word64 -> Integer -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
32

-- Text types

instance {-# OVERLAPPING #-} EmbPrj String where
  icod_ :: String -> S Word32
icod_   = String -> S Word32
icodeString
  value :: Word32 -> R String
value Word32
i = (Array String -> Int -> String) -> Int -> Array String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Array String -> Int -> String
forall a. Array a -> Int -> a
AL.unsafeIndex (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i) (Array String -> String)
-> ReaderT Decode IO (Array String) -> R String
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (Decode -> Array String) -> ReaderT Decode IO (Array String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Array String
stringA

instance EmbPrj ByteArray where
  icod_ :: ByteArray -> S Word32
icod_ = ByteArray -> S Word32
icodeByteArray
  value :: Word32 -> R ByteArray
value Word32
i = (Array ByteArray -> Int -> ByteArray)
-> Int -> Array ByteArray -> ByteArray
forall a b c. (a -> b -> c) -> b -> a -> c
flip Array ByteArray -> Int -> ByteArray
forall a. Array a -> Int -> a
AL.unsafeIndex (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i) (Array ByteArray -> ByteArray)
-> ReaderT Decode IO (Array ByteArray) -> R ByteArray
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (Decode -> Array ByteArray) -> ReaderT Decode IO (Array ByteArray)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Array ByteArray
byteArrayA

instance EmbPrj Text where
  icod_ :: Text -> S Word32
icod_ (T.Text ByteArray
arr Int
off Int
len) = (ByteArray -> Int -> Int -> Text)
-> Arrows (Domains (ByteArray -> Int -> Int -> Text)) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' ByteArray -> Int -> Int -> Text
T.Text ByteArray
arr Int
off Int
len
  value :: Word32 -> R Text
value = (ByteArray -> Int -> Int -> Text)
-> Word32 -> R (CoDomain (ByteArray -> Int -> Int -> Text))
forall t.
(VALU t (Arity t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Word32 -> R (CoDomain t)
valueN ByteArray -> Int -> Int -> Text
T.Text

instance EmbPrj ShortText where
  {-# INLINE icod_ #-}
  icod_ :: ShortText -> S Word32
icod_ = ByteArray -> S Word32
icodeByteArray (ByteArray -> S Word32)
-> (ShortText -> ByteArray) -> ShortText -> S Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ByteArray
TS.toByteArray
  value :: Word32 -> R ShortText
value = ByteArray -> ShortText
TS.unsafeFromByteArray (ByteArray -> ShortText)
-> (Word32 -> R ByteArray) -> Word32 -> R ShortText
forall (m :: * -> *) b c a.
Functor m =>
(b -> c) -> (a -> m b) -> a -> m c
<.> forall a. EmbPrj a => Word32 -> R a
value @ByteArray

---------------------------------------------------------------------------
-- Non-recursive types

instance (EmbPrj a, EmbPrj b) => EmbPrj (a, b) where
  icod_ :: (a, b) -> S Word32
icod_ (a
a, b
b) = (a -> b -> (a, b))
-> Arrows (Domains (a -> b -> (a, b))) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' (,) a
a b
b

  value :: Word32 -> R (a, b)
value = (a -> b -> (a, b)) -> Word32 -> R (CoDomain (a -> b -> (a, b)))
forall t.
(VALU t (Arity t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Word32 -> R (CoDomain t)
valueN (,)

instance (EmbPrj a, EmbPrj b) => EmbPrj (Pair a b) where
  icod_ :: Pair a b -> S Word32
icod_ (a
a :!: b
b) = (a -> b -> Pair a b)
-> Arrows (Domains (a -> b -> Pair a b)) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' a -> b -> Pair a b
forall a b. a -> b -> Pair a b
(:!:) a
a b
b

  value :: Word32 -> R (Pair a b)
value = (a -> b -> Pair a b) -> Word32 -> R (CoDomain (a -> b -> Pair a b))
forall t.
(VALU t (Arity t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Word32 -> R (CoDomain t)
valueN a -> b -> Pair a b
forall a b. a -> b -> Pair a b
(:!:)

instance (EmbPrj a, EmbPrj b, EmbPrj c) => EmbPrj (a, b, c) where
  icod_ :: (a, b, c) -> S Word32
icod_ (a
a, b
b, c
c) = (a -> b -> c -> (a, b, c))
-> Arrows (Domains (a -> b -> c -> (a, b, c))) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' (,,) a
a b
b c
c

  value :: Word32 -> R (a, b, c)
value = (a -> b -> c -> (a, b, c))
-> Word32 -> R (CoDomain (a -> b -> c -> (a, b, c)))
forall t.
(VALU t (Arity t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Word32 -> R (CoDomain t)
valueN (,,)

instance (EmbPrj a, EmbPrj b) => EmbPrj (Either a b) where
  icod_ :: Either a b -> S Word32
icod_ (Left  a
x) = Word32
-> (a -> Either a (ZonkAny 6))
-> Arrows (Domains (a -> Either a (ZonkAny 6))) (S Word32)
forall t.
(ICODE (Word32 -> t) (Arity (Word32 -> t)),
 StrictCurrying (Domains (Word32 -> t)) (S Word32),
 All EmbPrj (Domains (Word32 -> t))) =>
Word32 -> t -> Arrows (Domains t) (S Word32)
icodeN Word32
0 a -> Either a (ZonkAny 6)
forall a b. a -> Either a b
Left a
x
  icod_ (Right b
x) = Word32
-> (b -> Either (ZonkAny 7) b)
-> Arrows (Domains (b -> Either (ZonkAny 7) b)) (S Word32)
forall t.
(ICODE (Word32 -> t) (Arity (Word32 -> t)),
 StrictCurrying (Domains (Word32 -> t)) (S Word32),
 All EmbPrj (Domains (Word32 -> t))) =>
Word32 -> t -> Arrows (Domains t) (S Word32)
icodeN Word32
1 b -> Either (ZonkAny 7) b
forall a b. b -> Either a b
Right b
x

  value :: Word32 -> R (Either a b)
value = (Node -> R (Either a b)) -> Word32 -> R (Either a b)
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase Node -> R (Either a b)
forall {a} {b}. (EmbPrj a, EmbPrj b) => Node -> R (Either a b)
valu where
    valu :: Node -> R (Either a b)
valu (N2 Word32
0 Word32
x) = (a -> Either a b)
-> Arrows
     (Constant Word32 (Domains (a -> Either a b)))
     (R (CoDomain (a -> Either a b)))
forall t.
(VALU t (Arity t),
 StrictCurrying (Constant Word32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Word32 (Domains t)) (R (CoDomain t))
valuN a -> Either a b
forall a b. a -> Either a b
Left  Word32
x
    valu (N2 Word32
1 Word32
x) = (b -> Either a b)
-> Arrows
     (Constant Word32 (Domains (b -> Either a b)))
     (R (CoDomain (b -> Either a b)))
forall t.
(VALU t (Arity t),
 StrictCurrying (Constant Word32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Word32 (Domains t)) (R (CoDomain t))
valuN b -> Either a b
forall a b. b -> Either a b
Right Word32
x
    valu Node
_        = R (Either a b)
forall a. R a
malformed

instance EmbPrj a => EmbPrj (Maybe a) where
  icod_ :: Maybe a -> S Word32
icod_ Maybe a
Nothing  = Maybe (ZonkAny 5)
-> Arrows (Domains (Maybe (ZonkAny 5))) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' Maybe (ZonkAny 5)
forall a. Maybe a
Nothing
  icod_ (Just a
x) = (a -> Maybe a) -> Arrows (Domains (a -> Maybe a)) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' a -> Maybe a
forall a. a -> Maybe a
Just a
x

  value :: Word32 -> R (Maybe a)
value = (Node -> R (Maybe a)) -> Word32 -> R (Maybe a)
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase Node -> R (Maybe a)
forall {a}. EmbPrj a => Node -> ReaderT Decode IO (Maybe a)
valu where
    valu :: Node
-> Arrows
     (Constant Word32 (Domains (Maybe a))) (R (CoDomain (Maybe a)))
valu Node
N0     = Maybe a
-> Arrows
     (Constant Word32 (Domains (Maybe a))) (R (CoDomain (Maybe a)))
forall t.
(VALU t (Arity t),
 StrictCurrying (Constant Word32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Word32 (Domains t)) (R (CoDomain t))
valuN Maybe a
forall a. Maybe a
Nothing
    valu (N1 Word32
x) = (a -> Maybe a)
-> Arrows
     (Constant Word32 (Domains (a -> Maybe a)))
     (R (CoDomain (a -> Maybe a)))
forall t.
(VALU t (Arity t),
 StrictCurrying (Constant Word32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Word32 (Domains t)) (R (CoDomain t))
valuN a -> Maybe a
forall a. a -> Maybe a
Just Word32
x
    valu Node
_      = ReaderT Decode IO (Maybe a)
Arrows
  (Constant Word32 (Domains (Maybe a))) (R (CoDomain (Maybe a)))
forall a. R a
malformed

instance EmbPrj a => EmbPrj (Strict.Maybe a) where
  icod_ :: Maybe a -> S Word32
icod_ Maybe a
m = Maybe a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode (Maybe a -> Maybe a
forall lazy strict. Strict lazy strict => strict -> lazy
Strict.toLazy Maybe a
m)
  value :: Word32 -> R (Maybe a)
value Word32
m = Maybe a -> Maybe a
forall lazy strict. Strict lazy strict => lazy -> strict
Strict.toStrict (Maybe a -> Maybe a) -> ReaderT Decode IO (Maybe a) -> R (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Word32 -> ReaderT Decode IO (Maybe a)
forall a. EmbPrj a => Word32 -> R a
value Word32
m

instance (EmbPrj a, Typeable b) => EmbPrj (WithDefault' a b) where
  icod_ :: WithDefault' a b -> S Word32
icod_ = \case
    WithDefault' a b
Default -> WithDefault' (ZonkAny 2) (ZonkAny 3)
-> Arrows
     (Domains (WithDefault' (ZonkAny 2) (ZonkAny 3))) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' WithDefault' (ZonkAny 2) (ZonkAny 3)
forall a (b :: Bool). WithDefault' a b
Default
    Value a
b -> (a -> WithDefault' a (ZonkAny 4))
-> Arrows (Domains (a -> WithDefault' a (ZonkAny 4))) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' a -> WithDefault' a (ZonkAny 4)
forall a (b :: Bool). a -> WithDefault' a b
Value a
b

  value :: Word32 -> R (WithDefault' a b)
value = (Node -> R (WithDefault' a b)) -> Word32 -> R (WithDefault' a b)
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase ((Node -> R (WithDefault' a b)) -> Word32 -> R (WithDefault' a b))
-> (Node -> R (WithDefault' a b)) -> Word32 -> R (WithDefault' a b)
forall a b. (a -> b) -> a -> b
$ \case
    Node
N0   -> WithDefault' a b
-> Arrows
     (Constant Word32 (Domains (WithDefault' a b)))
     (R (CoDomain (WithDefault' a b)))
forall t.
(VALU t (Arity t),
 StrictCurrying (Constant Word32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Word32 (Domains t)) (R (CoDomain t))
valuN WithDefault' a b
forall a (b :: Bool). WithDefault' a b
Default
    N1 Word32
a -> (a -> WithDefault' a b)
-> Arrows
     (Constant Word32 (Domains (a -> WithDefault' a b)))
     (R (CoDomain (a -> WithDefault' a b)))
forall t.
(VALU t (Arity t),
 StrictCurrying (Constant Word32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Word32 (Domains t)) (R (CoDomain t))
valuN a -> WithDefault' a b
forall a (b :: Bool). a -> WithDefault' a b
Value Word32
a
    Node
_    -> R (WithDefault' a b)
forall a. R a
malformed

---------------------------------------------------------------------------
-- Sequences

{-# INLINABLE icodeList #-}
icodeList :: EmbPrj a => [a] -> S Node
icodeList :: forall a. EmbPrj a => [a] -> S Node
icodeList [a]
as = (Dict -> IO Node) -> S Node
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \Dict
r -> case [a]
as of
  []             -> Node -> IO Node
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
N0
  a
a:[]           -> S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Word32 -> Node
N1 (Word32 -> Node) -> S Word32 -> S Node
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
a) Dict
r
  a
a:a
b:[]         -> S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Word32 -> Word32 -> Node
N2 (Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Node)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
a ReaderT Dict IO (Word32 -> Node) -> S Word32 -> S Node
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
b) Dict
r
  a
a:a
b:a
c:[]       -> S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Word32 -> Word32 -> Word32 -> Node
N3 (Word32 -> Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Node)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
a ReaderT Dict IO (Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
b ReaderT Dict IO (Word32 -> Node) -> S Word32 -> S Node
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
c) Dict
r
  a
a:a
b:a
c:a
d:[]     -> S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Word32 -> Word32 -> Word32 -> Word32 -> Node
N4 (Word32 -> Word32 -> Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
a ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
b ReaderT Dict IO (Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
c ReaderT Dict IO (Word32 -> Node) -> S Word32 -> S Node
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
d) Dict
r
  a
a:a
b:a
c:a
d:a
e:[]   -> S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node
N5 (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node)
-> S Word32
-> ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Word32 -> Node)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
a ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
b
                                   ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
c ReaderT Dict IO (Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
d ReaderT Dict IO (Word32 -> Node) -> S Word32 -> S Node
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
e) Dict
r
  a
a:a
b:a
c:a
d:a
e:a
f:[a]
as -> S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Word32
-> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node
N6 (Word32
 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
-> S Word32
-> ReaderT
     Dict
     IO
     (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
a ReaderT
  Dict
  IO
  (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
-> S Word32
-> ReaderT
     Dict IO (Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
b ReaderT
  Dict IO (Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
-> S Word32
-> ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
c
                                   ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
d ReaderT Dict IO (Word32 -> Word32 -> Node -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
e ReaderT Dict IO (Word32 -> Node -> Node)
-> S Word32 -> ReaderT Dict IO (Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> a -> S Word32
forall a. EmbPrj a => a -> S Word32
icode a
f ReaderT Dict IO (Node -> Node) -> S Node -> S Node
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> [a] -> S Node
forall a. EmbPrj a => [a] -> S Node
icodeList [a]
as) Dict
r

valueList :: EmbPrj a => Node -> R [a]
valueList :: forall a. EmbPrj a => Node -> R [a]
valueList Node
as = (Decode -> IO [a]) -> ReaderT Decode IO [a]
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \Decode
r -> case Node
as of
  Node
N0   -> [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  N1 Word32
a -> (ReaderT Decode IO [a] -> Decode -> IO [a])
-> Decode -> ReaderT Decode IO [a] -> IO [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [a] -> Decode -> IO [a]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a <- Word32 -> R a
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    pure [a]
  N2 Word32
a Word32
b -> (ReaderT Decode IO [a] -> Decode -> IO [a])
-> Decode -> ReaderT Decode IO [a] -> IO [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [a] -> Decode -> IO [a]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a <- Word32 -> R a
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    !b <- value b
    pure [a, b]
  N3 Word32
a Word32
b Word32
c -> (ReaderT Decode IO [a] -> Decode -> IO [a])
-> Decode -> ReaderT Decode IO [a] -> IO [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [a] -> Decode -> IO [a]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a <- Word32 -> R a
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    !b <- value b
    !c <- value c
    pure [a, b, c]
  N4 Word32
a Word32
b Word32
c Word32
d -> (ReaderT Decode IO [a] -> Decode -> IO [a])
-> Decode -> ReaderT Decode IO [a] -> IO [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [a] -> Decode -> IO [a]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a <- Word32 -> R a
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    !b <- value b
    !c <- value c
    !d <- value d
    pure [a, b, c, d]
  N5 Word32
a Word32
b Word32
c Word32
d Word32
e -> (ReaderT Decode IO [a] -> Decode -> IO [a])
-> Decode -> ReaderT Decode IO [a] -> IO [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [a] -> Decode -> IO [a]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a <- Word32 -> R a
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    !b <- value b
    !c <- value c
    !d <- value d
    !e <- value e
    pure [a, b, c, d, e]
  N6 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Node
as -> (ReaderT Decode IO [a] -> Decode -> IO [a])
-> Decode -> ReaderT Decode IO [a] -> IO [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [a] -> Decode -> IO [a]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a  <- Word32 -> R a
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    !b  <- value b
    !c  <- value c
    !d  <- value d
    !e  <- value e
    !f  <- value f
    !as <- valueList as
    pure (a:b:c:d:e:f:as)

instance {-# OVERLAPPABLE #-} EmbPrj a => EmbPrj [a] where
  {-# INLINE icod_ #-}
  icod_ :: [a] -> S Word32
icod_ [a]
xs = Node -> S Word32
icodeNode (Node -> S Word32) -> S Node -> S Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [a] -> S Node
forall a. EmbPrj a => [a] -> S Node
icodeList [a]
xs
  {-# INLINE value #-}
  value :: Word32 -> R [a]
value = (Node -> R [a]) -> Word32 -> R [a]
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase Node -> R [a]
forall a. EmbPrj a => Node -> R [a]
valueList

instance EmbPrj a => EmbPrj (List1 a) where
  icod_ :: List1 a -> S Word32
icod_ = [a] -> S Word32
forall a. EmbPrj a => a -> S Word32
icod_ ([a] -> S Word32) -> (List1 a -> [a]) -> List1 a -> S Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 a -> [a]
List1 a -> [Item (List1 a)]
forall l. IsList l => l -> [Item l]
List1.toList
  value :: Word32 -> R (List1 a)
value = R (List1 a)
-> (List1 a -> R (List1 a)) -> Maybe (List1 a) -> R (List1 a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe R (List1 a)
forall a. R a
malformed List1 a -> R (List1 a)
forall a. a -> ReaderT Decode IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (List1 a) -> R (List1 a))
-> ([a] -> Maybe (List1 a)) -> [a] -> R (List1 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (List1 a)
forall a. [a] -> Maybe (NonEmpty a)
List1.nonEmpty ([a] -> R (List1 a))
-> (Word32 -> ReaderT Decode IO [a]) -> Word32 -> R (List1 a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Word32 -> ReaderT Decode IO [a]
forall a. EmbPrj a => Word32 -> R a
value

instance EmbPrj a => EmbPrj (List2 a) where
  icod_ :: List2 a -> S Word32
icod_ = [a] -> S Word32
forall a. EmbPrj a => a -> S Word32
icod_ ([a] -> S Word32) -> (List2 a -> [a]) -> List2 a -> S Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List2 a -> [a]
List2 a -> [Item (List2 a)]
forall l. IsList l => l -> [Item l]
List2.toList
  value :: Word32 -> R (List2 a)
value = R (List2 a)
-> (List2 a -> R (List2 a)) -> Maybe (List2 a) -> R (List2 a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe R (List2 a)
forall a. R a
malformed List2 a -> R (List2 a)
forall a. a -> ReaderT Decode IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (List2 a) -> R (List2 a))
-> ([a] -> Maybe (List2 a)) -> [a] -> R (List2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (List2 a)
forall a. [a] -> Maybe (List2 a)
List2.fromListMaybe ([a] -> R (List2 a))
-> (Word32 -> ReaderT Decode IO [a]) -> Word32 -> R (List2 a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Word32 -> ReaderT Decode IO [a]
forall a. EmbPrj a => Word32 -> R a
value

instance EmbPrj a => EmbPrj (Seq a) where
  icod_ :: Seq a -> S Word32
icod_ Seq a
s = [a] -> S Word32
forall a. EmbPrj a => a -> S Word32
icode ((a -> [a] -> [a]) -> [a] -> Seq a -> [a]
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr' (:) [] Seq a
s)
  value :: Word32 -> R (Seq a)
value Word32
s = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> ReaderT Decode IO [a] -> R (Seq a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Word32 -> ReaderT Decode IO [a]
forall a. EmbPrj a => Word32 -> R a
value Word32
s

data KVS a b = Cons a b !(KVS a b) | Nil

icodeListPair :: EmbPrj k => EmbPrj v => KVS k v -> S Node
icodeListPair :: forall k v. (EmbPrj k, EmbPrj v) => KVS k v -> S Node
icodeListPair KVS k v
as = (Dict -> IO Node) -> S Node
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \Dict
r -> case KVS k v
as of
  KVS k v
Nil ->
    Node -> IO Node
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
N0
  Cons k
a v
b KVS k v
Nil -> (S Node -> Dict -> IO Node) -> Dict -> S Node -> IO Node
forall a b c. (a -> b -> c) -> b -> a -> c
flip S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Dict
r (S Node -> IO Node) -> S Node -> IO Node
forall a b. (a -> b) -> a -> b
$
    Word32 -> Word32 -> Node
N2 (Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Node)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> k -> S Word32
forall a. EmbPrj a => a -> S Word32
icode k
a ReaderT Dict IO (Word32 -> Node) -> S Word32 -> S Node
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> v -> S Word32
forall a. EmbPrj a => a -> S Word32
icode v
b
  Cons k
a v
b (Cons k
c v
d KVS k v
Nil) -> (S Node -> Dict -> IO Node) -> Dict -> S Node -> IO Node
forall a b c. (a -> b -> c) -> b -> a -> c
flip S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Dict
r (S Node -> IO Node) -> S Node -> IO Node
forall a b. (a -> b) -> a -> b
$
    Word32 -> Word32 -> Word32 -> Word32 -> Node
N4 (Word32 -> Word32 -> Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> k -> S Word32
forall a. EmbPrj a => a -> S Word32
icode k
a ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> v -> S Word32
forall a. EmbPrj a => a -> S Word32
icode v
b ReaderT Dict IO (Word32 -> Word32 -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> k -> S Word32
forall a. EmbPrj a => a -> S Word32
icode k
c ReaderT Dict IO (Word32 -> Node) -> S Word32 -> S Node
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> v -> S Word32
forall a. EmbPrj a => a -> S Word32
icode v
d
  Cons k
a v
b (Cons k
c v
d (Cons k
e v
f KVS k v
as)) -> (S Node -> Dict -> IO Node) -> Dict -> S Node -> IO Node
forall a b c. (a -> b -> c) -> b -> a -> c
flip S Node -> Dict -> IO Node
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Dict
r (S Node -> IO Node) -> S Node -> IO Node
forall a b. (a -> b) -> a -> b
$
    Word32
-> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node
N6 (Word32
 -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
-> S Word32
-> ReaderT
     Dict
     IO
     (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> k -> S Word32
forall a. EmbPrj a => a -> S Word32
icode k
a ReaderT
  Dict
  IO
  (Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
-> S Word32
-> ReaderT
     Dict IO (Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> v -> S Word32
forall a. EmbPrj a => a -> S Word32
icode v
b ReaderT
  Dict IO (Word32 -> Word32 -> Word32 -> Word32 -> Node -> Node)
-> S Word32
-> ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> k -> S Word32
forall a. EmbPrj a => a -> S Word32
icode k
c
       ReaderT Dict IO (Word32 -> Word32 -> Word32 -> Node -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> v -> S Word32
forall a. EmbPrj a => a -> S Word32
icode v
d ReaderT Dict IO (Word32 -> Word32 -> Node -> Node)
-> S Word32 -> ReaderT Dict IO (Word32 -> Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> k -> S Word32
forall a. EmbPrj a => a -> S Word32
icode k
e ReaderT Dict IO (Word32 -> Node -> Node)
-> S Word32 -> ReaderT Dict IO (Node -> Node)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> v -> S Word32
forall a. EmbPrj a => a -> S Word32
icode v
f ReaderT Dict IO (Node -> Node) -> S Node -> S Node
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
<*!> KVS k v -> S Node
forall k v. (EmbPrj k, EmbPrj v) => KVS k v -> S Node
icodeListPair KVS k v
as

{-# INLINABLE valueListPair #-}
valueListPair :: EmbPrj k => EmbPrj v => Node -> R [(k, v)]
valueListPair :: forall k v. (EmbPrj k, EmbPrj v) => Node -> R [(k, v)]
valueListPair Node
as = (Decode -> IO [(k, v)]) -> ReaderT Decode IO [(k, v)]
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \Decode
r -> case Node
as of
  Node
N0     -> [(k, v)] -> IO [(k, v)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  N2 Word32
a Word32
b -> (ReaderT Decode IO [(k, v)] -> Decode -> IO [(k, v)])
-> Decode -> ReaderT Decode IO [(k, v)] -> IO [(k, v)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [(k, v)] -> Decode -> IO [(k, v)]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a <- Word32 -> R k
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    !b <- value b
    pure [(a, b)]
  N4 Word32
a Word32
b Word32
c Word32
d -> (ReaderT Decode IO [(k, v)] -> Decode -> IO [(k, v)])
-> Decode -> ReaderT Decode IO [(k, v)] -> IO [(k, v)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [(k, v)] -> Decode -> IO [(k, v)]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a <- Word32 -> R k
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    !b <- value b
    !c <- value c
    !d <- value d
    pure [(a, b), (c, d)]
  N6 Word32
a Word32
b Word32
c Word32
d Word32
e Word32
f Node
as -> (ReaderT Decode IO [(k, v)] -> Decode -> IO [(k, v)])
-> Decode -> ReaderT Decode IO [(k, v)] -> IO [(k, v)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Decode IO [(k, v)] -> Decode -> IO [(k, v)]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Decode
r do
    !a  <- Word32 -> R k
forall a. EmbPrj a => Word32 -> R a
value Word32
a
    !b  <- value b
    !c  <- value c
    !d  <- value d
    !e  <- value e
    !f  <- value f
    !as <- valueListPair as
    pure ((a, b):(c, d):(e, f):as)
  Node
_ -> IO [(k, v)]
forall a. IO a
malformedIO

---------------------------------------------------------------------------
-- Maps

instance (EmbPrj k, EmbPrj v, EmbPrj (BiMap.Tag v)) =>
         EmbPrj (BiMap k v) where
  icod_ :: BiMap k v -> S Word32
icod_ BiMap k v
m = ([(k, v)], [(Tag v, k)]) -> S Word32
forall a. EmbPrj a => a -> S Word32
icode (BiMap k v -> ([(k, v)], [(Tag v, k)])
forall k v. BiMap k v -> ([(k, v)], [(Tag v, k)])
BiMap.toDistinctAscendingLists BiMap k v
m)
  value :: Word32 -> R (BiMap k v)
value Word32
m = ([(k, v)], [(Tag v, k)]) -> BiMap k v
forall k v. ([(k, v)], [(Tag v, k)]) -> BiMap k v
BiMap.fromDistinctAscendingLists (([(k, v)], [(Tag v, k)]) -> BiMap k v)
-> ReaderT Decode IO ([(k, v)], [(Tag v, k)]) -> R (BiMap k v)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Word32 -> ReaderT Decode IO ([(k, v)], [(Tag v, k)])
forall a. EmbPrj a => Word32 -> R a
value Word32
m

instance (Hashable k, EmbPrj k, EmbPrj v) => EmbPrj (HashMap k v) where
  icod_ :: HashMap k v -> S Word32
icod_ HashMap k v
m = Node -> S Word32
icodeNode (Node -> S Word32) -> S Node -> S Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KVS k v -> S Node
forall k v. (EmbPrj k, EmbPrj v) => KVS k v -> S Node
icodeListPair ((k -> v -> KVS k v -> KVS k v) -> KVS k v -> HashMap k v -> KVS k v
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HMap.foldrWithKey' (\ k
k v
v !KVS k v
acc -> k -> v -> KVS k v -> KVS k v
forall a b. a -> b -> KVS a b -> KVS a b
Cons k
k v
v KVS k v
acc) KVS k v
forall a b. KVS a b
Nil HashMap k v
m)
  value :: Word32 -> R (HashMap k v)
value = (Node -> R (HashMap k v)) -> Word32 -> R (HashMap k v)
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase (([(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList ([(k, v)] -> HashMap k v)
-> ReaderT Decode IO [(k, v)] -> R (HashMap k v)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (ReaderT Decode IO [(k, v)] -> R (HashMap k v))
-> (Node -> ReaderT Decode IO [(k, v)]) -> Node -> R (HashMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> ReaderT Decode IO [(k, v)]
forall k v. (EmbPrj k, EmbPrj v) => Node -> R [(k, v)]
valueListPair)

instance (Ord a, EmbPrj a, EmbPrj b) => EmbPrj (Map a b) where
  icod_ :: Map a b -> S Word32
icod_ Map a b
m = Node -> S Word32
icodeNode (Node -> S Word32) -> S Node -> S Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KVS a b -> S Node
forall k v. (EmbPrj k, EmbPrj v) => KVS k v -> S Node
icodeListPair ((a -> b -> KVS a b -> KVS a b) -> KVS a b -> Map a b -> KVS a b
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' (\ a
k b
v !KVS a b
acc -> a -> b -> KVS a b -> KVS a b
forall a b. a -> b -> KVS a b -> KVS a b
Cons a
k b
v KVS a b
acc) KVS a b
forall a b. KVS a b
Nil Map a b
m)
  value :: Word32 -> R (Map a b)
value = (Node -> R (Map a b)) -> Word32 -> R (Map a b)
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase (([(a, b)] -> Map a b
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(a, b)] -> Map a b) -> ReaderT Decode IO [(a, b)] -> R (Map a b)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (ReaderT Decode IO [(a, b)] -> R (Map a b))
-> (Node -> ReaderT Decode IO [(a, b)]) -> Node -> R (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> ReaderT Decode IO [(a, b)]
forall k v. (EmbPrj k, EmbPrj v) => Node -> R [(k, v)]
valueListPair)

---------------------------------------------------------------------------
-- Sets

instance EmbPrj IntSet where
  icod_ :: IntSet -> S Word32
icod_ IntSet
s = [Int] -> S Word32
forall a. EmbPrj a => a -> S Word32
icode ((Int -> [Int] -> [Int]) -> [Int] -> IntSet -> [Int]
forall b. (Int -> b -> b) -> b -> IntSet -> b
IntSet.foldr' (:) [] IntSet
s)
  value :: Word32 -> R IntSet
value Word32
s = [Int] -> IntSet
IntSet.fromDistinctAscList ([Int] -> IntSet) -> ReaderT Decode IO [Int] -> R IntSet
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Word32 -> ReaderT Decode IO [Int]
forall a. EmbPrj a => Word32 -> R a
value Word32
s

instance (EmbPrj a) => EmbPrj (Set a) where
  icod_ :: Set a -> S Word32
icod_ Set a
s = [a] -> S Word32
forall a. EmbPrj a => a -> S Word32
icode ((a -> [a] -> [a]) -> [a] -> Set a -> [a]
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr' (:) [] Set a
s)
  value :: Word32 -> R (Set a)
value Word32
s = [a] -> Set a
forall a. [a] -> Set a
Set.fromDistinctAscList ([a] -> Set a) -> ReaderT Decode IO [a] -> R (Set a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Word32 -> ReaderT Decode IO [a]
forall a. EmbPrj a => Word32 -> R a
value Word32
s

instance (Hashable a, EmbPrj a) => EmbPrj (HashSet a) where
  icod_ :: HashSet a -> S Word32
icod_ HashSet a
s = [a] -> S Word32
forall a. EmbPrj a => a -> S Word32
icode ((a -> [a] -> [a]) -> [a] -> HashSet a -> [a]
forall a b. (a -> b -> b) -> b -> HashSet a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr' (:) [] HashSet a
s)
  value :: Word32 -> R (HashSet a)
value Word32
s = [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HSet.fromList ([a] -> HashSet a) -> ReaderT Decode IO [a] -> R (HashSet a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Word32 -> ReaderT Decode IO [a]
forall a. EmbPrj a => Word32 -> R a
value Word32
s

instance (EmbPrj a) => EmbPrj (Set1 a) where
  icod_ :: Set1 a -> S Word32
icod_ Set1 a
s = [a] -> S Word32
forall a. EmbPrj a => a -> S Word32
icode ((a -> [a] -> [a]) -> [a] -> Set1 a -> [a]
forall a b. (a -> b -> b) -> b -> NESet a -> b
Set1.foldr' (:) [] Set1 a
s)
  value :: Word32 -> R (Set1 a)
value Word32
s = NonEmpty a -> Set1 a
forall a. NonEmpty a -> NESet a
Set1.fromDistinctAscList (NonEmpty a -> Set1 a)
-> ReaderT Decode IO (NonEmpty a) -> R (Set1 a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Word32 -> ReaderT Decode IO (NonEmpty a)
forall a. EmbPrj a => Word32 -> R a
value Word32
s

instance Typeable a => EmbPrj (SmallSet a) where
  icod_ :: SmallSet a -> S Word32
icod_ (SmallSet Word64
a) = (Word64 -> SmallSet (ZonkAny 1))
-> Arrows (Domains (Word64 -> SmallSet (ZonkAny 1))) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' Word64 -> SmallSet (ZonkAny 1)
forall a. Word64 -> SmallSet a
SmallSet Word64
a
  value :: Word32 -> R (SmallSet a)
value = (Word64 -> SmallSet a)
-> Word32 -> R (CoDomain (Word64 -> SmallSet a))
forall t.
(VALU t (Arity t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Word32 -> R (CoDomain t)
valueN Word64 -> SmallSet a
forall a. Word64 -> SmallSet a
SmallSet

instance EmbPrj VarSet where
  icod_ :: VarSet -> S Word32
icod_   = VarSet -> S Word32
icodeVarSet
  value :: Word32 -> R VarSet
value Word32
i = (Array VarSet -> Int -> VarSet) -> Int -> Array VarSet -> VarSet
forall a b c. (a -> b -> c) -> b -> a -> c
flip Array VarSet -> Int -> VarSet
forall a. Array a -> Int -> a
AL.index (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i) (Array VarSet -> VarSet)
-> ReaderT Decode IO (Array VarSet) -> R VarSet
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (Decode -> Array VarSet) -> ReaderT Decode IO (Array VarSet)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Array VarSet
varSetA

---------------------------------------------------------------------------
-- Trees

instance (Ord a, EmbPrj a, EmbPrj b) => EmbPrj (Trie a b) where
  icod_ :: Trie a b -> S Word32
icod_ (Trie Maybe b
a Map a (Trie a b)
b) = (Maybe b -> Map a (Trie a b) -> Trie a b)
-> Arrows
     (Domains (Maybe b -> Map a (Trie a b) -> Trie a b)) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' Maybe b -> Map a (Trie a b) -> Trie a b
forall k v. Maybe v -> Map k (Trie k v) -> Trie k v
Trie Maybe b
a Map a (Trie a b)
b
  value :: Word32 -> R (Trie a b)
value = (Maybe b -> Map a (Trie a b) -> Trie a b)
-> Word32 -> R (CoDomain (Maybe b -> Map a (Trie a b) -> Trie a b))
forall t.
(VALU t (Arity t), All EmbPrj (CoDomain t : Domains t)) =>
t -> Word32 -> R (CoDomain t)
valueN Maybe b -> Map a (Trie a b) -> Trie a b
forall k v. Maybe v -> Map k (Trie k v) -> Trie k v
Trie

instance EmbPrj a => EmbPrj (DocTree.DocTree a) where
  icod_ :: DocTree a -> S Word32
icod_ = \case
    DocTree.Text Text
a   -> (Text -> DocTree (ZonkAny 0))
-> Arrows (Domains (Text -> DocTree (ZonkAny 0))) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' Text -> DocTree (ZonkAny 0)
forall ann. Text -> DocTree ann
DocTree.Text Text
a
    DocTree.Node a
a [DocTree a]
b -> (a -> [DocTree a] -> DocTree a)
-> Arrows (Domains (a -> [DocTree a] -> DocTree a)) (S Word32)
forall t.
(ICODE t (Arity t), StrictCurrying (Domains t) (S Word32),
 All EmbPrj (Domains t)) =>
t -> Arrows (Domains t) (S Word32)
icodeN' a -> [DocTree a] -> DocTree a
forall ann. ann -> [DocTree ann] -> DocTree ann
DocTree.Node a
a [DocTree a]
b

  value :: Word32 -> R (DocTree a)
value = (Node -> R (DocTree a)) -> Word32 -> R (DocTree a)
forall a. EmbPrj a => (Node -> R a) -> Word32 -> R a
vcase \case
    N1 Word32
a   -> (Text -> DocTree a)
-> Arrows
     (Constant Word32 (Domains (Text -> DocTree a)))
     (R (CoDomain (Text -> DocTree a)))
forall t.
(VALU t (Arity t),
 StrictCurrying (Constant Word32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Word32 (Domains t)) (R (CoDomain t))
valuN Text -> DocTree a
forall ann. Text -> DocTree ann
DocTree.Text Word32
a
    N2 Word32
a Word32
b -> (a -> [DocTree a] -> DocTree a)
-> Arrows
     (Constant Word32 (Domains (a -> [DocTree a] -> DocTree a)))
     (R (CoDomain (a -> [DocTree a] -> DocTree a)))
forall t.
(VALU t (Arity t),
 StrictCurrying (Constant Word32 (Domains t)) (R (CoDomain t)),
 All EmbPrj (Domains t)) =>
t -> Arrows (Constant Word32 (Domains t)) (R (CoDomain t))
valuN a -> [DocTree a] -> DocTree a
forall ann. ann -> [DocTree ann] -> DocTree ann
DocTree.Node Word32
a Word32
b
    Node
_      -> R (DocTree a)
forall a. R a
malformed