{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# language
    DeriveGeneric
  , DeriveAnyClass
  , DeriveDataTypeable
  , FlexibleContexts
  , GADTs
  , OverloadedStrings
  , DefaultSignatures
  , ScopedTypeVariables
  , FlexibleInstances
  , LambdaCase
  , TemplateHaskell
  , TypeApplications
#-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
{-# options_ghc -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Encode.Internal
-- Description :  Generic encoding of algebraic datatypes
-- Copyright   :  (c) Marco Zocca (2019)
-- License     :  MIT
-- Maintainer  :  ocramz fripost org
-- Stability   :  experimental
-- Portability :  GHC
--
-- Generic encoding of algebraic datatypes, using @generics-sop@
--
-- Examples, inspiration and code borrowed from :
-- 
-- * @basic-sop@ - generic show function : https://hackage.haskell.org/package/basic-sop-0.2.0.2/docs/src/Generics-SOP-Show.html#gshow
-- 
-- * @tree-diff@ - single-typed ADT reconstruction : http://hackage.haskell.org/package/tree-diff-0.0.2/docs/src/Data.TreeDiff.Class.html#sopToExpr
-----------------------------------------------------------------------------
module Data.Generics.Encode.Internal (gflattenHM, gflattenGT,
                                      -- * VP (Primitive types)
                                      VP(..),
                                      -- ** Lenses
                                      vpInt, vpDouble, vpFloat, vpString, vpText, vpBool, vpScientific, vpChar, vpOneHot,
                                      -- ** 'MonadThrow' getters
                                     getIntM, getInt8M, getInt16M, getInt32M, getInt64M, getWordM, getWord8M, getWord16M, getWord32M, getWord64M, getBoolM, getFloatM, getDoubleM, getScientificM, getCharM, getStringM, getTextM, getOneHotM, TypeError(..),
                                     -- * TC (Type and Constructor annotation)
                                     TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon, 
                                     -- * Heidi (generic ADT encoding)
                                     Heidi, toVal, Val(..), header, Header(..)) where

import qualified GHC.Generics as G
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Data.Proxy
import Data.Typeable (Typeable)

-- containers
import qualified Data.Map as M (Map, fromList, insert, lookup)
import Data.Sequence (Seq, (|>), (<|))
-- exceptions
import Control.Monad.Catch(Exception(..), MonadThrow(..))
-- generics-sop
import Generics.SOP (All, HasDatatypeInfo(..), datatypeInfo, DatatypeName, datatypeName, DatatypeInfo, FieldInfo(..), SListI, FieldName, ConstructorInfo(..), constructorInfo, All, All2, AllN, Prod, HAp, hcpure, hmap, hcliftA, hcliftA2, hcmap, Proxy(..), SOP(..), NP(..), I(..), K(..), mapIK, hcollapse)
-- import Generics.SOP.NP (cpure_NP)
-- import Generics.SOP.Constraint (SListIN)
import Generics.SOP.GGP (GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)
-- generic-trie
import qualified Data.GenericTrie as GT
-- hashable
import Data.Hashable (Hashable(..))
-- microlens-th
import Lens.Micro.TH (makeLenses)
-- scientific
import Data.Scientific (Scientific)
-- text
import Data.Text (Text, unpack)

-- import Data.Time (Day, LocalTime, TimeOfDay)
-- import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HM
-- import qualified Data.GenericTrie as GT

import Data.Generics.Encode.OneHot (OneHot, mkOH)
import Data.Generics.Encode.Internal.Prim (VP(..), vpInt, vpScientific, vpFloat, vpDouble, vpString, vpChar, vpText, vpBool, vpOneHot)
-- import Data.List (unfoldr)
-- import qualified Data.Foldable as F
-- import qualified Data.Sequence as S (Seq(..), empty)
-- import Data.Sequence ((<|), (|>))

import Prelude hiding (getChar)

-- $setup
-- >>> :set -XDeriveGeneric
-- >>> import qualified GHC.Generics as G




-- | Flatten a value into a 1-layer hashmap, via the value's generic encoding
gflattenHM :: Heidi a => a -> HM.HashMap [TC] VP
gflattenHM :: a -> HashMap [TC] VP
gflattenHM = Val -> HashMap [TC] VP
flattenHM (Val -> HashMap [TC] VP) -> (a -> Val) -> a -> HashMap [TC] VP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Val
forall a. Heidi a => a -> Val
toVal

-- | Flatten a value into a 'GT.Trie', via the value's generic encoding
gflattenGT :: Heidi a => a -> GT.Trie [TC] VP
gflattenGT :: a -> Trie [TC] VP
gflattenGT = Val -> Trie [TC] VP
flattenGT (Val -> Trie [TC] VP) -> (a -> Val) -> a -> Trie [TC] VP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Val
forall a. Heidi a => a -> Val
toVal


-- -- | Commands for manipulating lists of TC's
-- data TCAlg = TCAnyTyCon String -- ^ Matches any type constructor name
--            | TCFirstTyCon String -- ^ " first type constructor name
--            | TCAnyTyN String -- ^ " any type name
--            | TCFirstTyN String -- ^ first type name


-- | A (type, constructor) name pair
data TC = TC String String deriving (TC -> TC -> Bool
(TC -> TC -> Bool) -> (TC -> TC -> Bool) -> Eq TC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TC -> TC -> Bool
$c/= :: TC -> TC -> Bool
== :: TC -> TC -> Bool
$c== :: TC -> TC -> Bool
Eq, Int -> TC -> ShowS
[TC] -> ShowS
TC -> String
(Int -> TC -> ShowS)
-> (TC -> String) -> ([TC] -> ShowS) -> Show TC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TC] -> ShowS
$cshowList :: [TC] -> ShowS
show :: TC -> String
$cshow :: TC -> String
showsPrec :: Int -> TC -> ShowS
$cshowsPrec :: Int -> TC -> ShowS
Show, Eq TC
Eq TC
-> (TC -> TC -> Ordering)
-> (TC -> TC -> Bool)
-> (TC -> TC -> Bool)
-> (TC -> TC -> Bool)
-> (TC -> TC -> Bool)
-> (TC -> TC -> TC)
-> (TC -> TC -> TC)
-> Ord TC
TC -> TC -> Bool
TC -> TC -> Ordering
TC -> TC -> TC
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
min :: TC -> TC -> TC
$cmin :: TC -> TC -> TC
max :: TC -> TC -> TC
$cmax :: TC -> TC -> TC
>= :: TC -> TC -> Bool
$c>= :: TC -> TC -> Bool
> :: TC -> TC -> Bool
$c> :: TC -> TC -> Bool
<= :: TC -> TC -> Bool
$c<= :: TC -> TC -> Bool
< :: TC -> TC -> Bool
$c< :: TC -> TC -> Bool
compare :: TC -> TC -> Ordering
$ccompare :: TC -> TC -> Ordering
$cp1Ord :: Eq TC
Ord, (forall x. TC -> Rep TC x)
-> (forall x. Rep TC x -> TC) -> Generic TC
forall x. Rep TC x -> TC
forall x. TC -> Rep TC x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TC x -> TC
$cfrom :: forall x. TC -> Rep TC x
G.Generic)
instance Hashable TC
instance GT.TrieKey TC

-- | Type name
tcTyN :: TC -> String
tcTyN :: TC -> String
tcTyN (TC String
n String
_) = String
n
-- | Type constructor
tcTyCon :: TC -> String
tcTyCon :: TC -> String
tcTyCon (TC String
_ String
c) = String
c

-- | Create a fake TC with the given string as type constructor
mkTyCon :: String -> TC
mkTyCon :: String -> TC
mkTyCon String
x = String -> String -> TC
TC String
"" String
x

-- | Create a fake TC with the given string as type name
mkTyN :: String -> TC
mkTyN :: String -> TC
mkTyN String
x = String -> String -> TC
TC String
x String
""

-- | Fold a 'Val' into a 1-layer hashmap indexed by the input value's (type, constructor) metadata
flattenHM :: Val -> HM.HashMap [TC] VP
flattenHM :: Val -> HashMap [TC] VP
flattenHM = HashMap [TC] VP
-> ([TC] -> VP -> HashMap [TC] VP -> HashMap [TC] VP)
-> Val
-> HashMap [TC] VP
forall t. t -> ([TC] -> VP -> t -> t) -> Val -> t
flatten HashMap [TC] VP
forall k v. HashMap k v
HM.empty [TC] -> VP -> HashMap [TC] VP -> HashMap [TC] VP
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert

-- | Fold a 'Val' into a 1-layer 'GT.Trie' indexed by the input value's (type, constructor) metadata
flattenGT :: Val -> GT.Trie [TC] VP
flattenGT :: Val -> Trie [TC] VP
flattenGT = Trie [TC] VP
-> ([TC] -> VP -> Trie [TC] VP -> Trie [TC] VP)
-> Val
-> Trie [TC] VP
forall t. t -> ([TC] -> VP -> t -> t) -> Val -> t
flatten Trie [TC] VP
forall k a. TrieKey k => Trie k a
GT.empty [TC] -> VP -> Trie [TC] VP -> Trie [TC] VP
forall k a. TrieKey k => k -> a -> Trie k a -> Trie k a
GT.insert

flatten :: t -> ([TC] -> VP -> t -> t) -> Val -> t
flatten :: t -> ([TC] -> VP -> t -> t) -> Val -> t
flatten t
z [TC] -> VP -> t -> t
insf = ([TC], t) -> Val -> t
go ([], t
z) where
  insRev :: [TC] -> VP -> t -> t
insRev [TC]
ks = [TC] -> VP -> t -> t
insf ([TC] -> [TC]
forall a. [a] -> [a]
reverse [TC]
ks)
  go :: ([TC], t) -> Val -> t
go ([TC]
ks, t
hmacc) = \case
    VRec String
ty HashMap String Val
hm     -> (t -> String -> Val -> t) -> t -> HashMap String Val -> t
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' (\t
hm' String
k Val
t -> ([TC], t) -> Val -> t
go (String -> String -> TC
TC String
ty String
k TC -> [TC] -> [TC]
forall a. a -> [a] -> [a]
: [TC]
ks, t
hm') Val
t) t
hmacc HashMap String Val
hm
    VEnum String
ty String
cn OneHot Int
oh -> [TC] -> VP -> t -> t
insRev (String -> String -> TC
TC String
ty String
cn TC -> [TC] -> [TC]
forall a. a -> [a] -> [a]
: [TC]
ks) (OneHot Int -> VP
VPOH OneHot Int
oh) t
hmacc
    VPrim VP
vp       -> [TC] -> VP -> t -> t
insRev [TC]
ks VP
vp t
hmacc


-- | Collect the hashmap keys at the leaves. The resulting lists at the leaf nodes can be used to look up values in the rows
collectKeys :: Header String -> Header (Seq String)
collectKeys :: Header String -> Header (Seq String)
collectKeys = Seq String -> Header String -> Header (Seq String)
go Seq String
forall a. Monoid a => a
mempty
  where
    go :: Seq String -> Header String -> Header (Seq String)
go Seq String
acc = \case
      HLeaf String
x -> Seq String -> Header (Seq String)
forall t. t -> Header t
HLeaf (Seq String
acc Seq String -> String -> Seq String
forall a. Seq a -> a -> Seq a
|> String
x)
      HSum String
ty HashMap String (Header String)
hm -> String
-> HashMap String (Header (Seq String)) -> Header (Seq String)
forall t. String -> HashMap String (Header t) -> Header t
HSum String
ty (HashMap String (Header (Seq String)) -> Header (Seq String))
-> HashMap String (Header (Seq String)) -> Header (Seq String)
forall a b. (a -> b) -> a -> b
$ (String -> Header String -> Header (Seq String))
-> HashMap String (Header String)
-> HashMap String (Header (Seq String))
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\String
k Header String
v -> Seq String -> Header String -> Header (Seq String)
go (Seq String
acc Seq String -> String -> Seq String
forall a. Seq a -> a -> Seq a
|> String
k) Header String
v) HashMap String (Header String)
hm
      HProd String
ty HashMap String (Header String)
hm -> String
-> HashMap String (Header (Seq String)) -> Header (Seq String)
forall t. String -> HashMap String (Header t) -> Header t
HProd String
ty (HashMap String (Header (Seq String)) -> Header (Seq String))
-> HashMap String (Header (Seq String)) -> Header (Seq String)
forall a b. (a -> b) -> a -> b
$ (String -> Header String -> Header (Seq String))
-> HashMap String (Header String)
-> HashMap String (Header (Seq String))
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\String
k Header String
v -> Seq String -> Header String -> Header (Seq String)
go (Seq String
acc Seq String -> String -> Seq String
forall a. Seq a -> a -> Seq a
|> String
k)  Header String
v) HashMap String (Header String)
hm


-- | Internal representation of encoded ADTs values
--
-- The first String parameter contains the type name at the given level, the second contains the type constructor name
data Val =
     VRec   String        (HM.HashMap String Val) -- ^ recursion
   | VEnum  String String (OneHot Int)            -- ^ 1-hot encoding of an enum
   | VPrim  VP                                    -- ^ primitive types
   deriving (Val -> Val -> Bool
(Val -> Val -> Bool) -> (Val -> Val -> Bool) -> Eq Val
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Val -> Val -> Bool
$c/= :: Val -> Val -> Bool
== :: Val -> Val -> Bool
$c== :: Val -> Val -> Bool
Eq, Int -> Val -> ShowS
[Val] -> ShowS
Val -> String
(Int -> Val -> ShowS)
-> (Val -> String) -> ([Val] -> ShowS) -> Show Val
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Val] -> ShowS
$cshowList :: [Val] -> ShowS
show :: Val -> String
$cshow :: Val -> String
showsPrec :: Int -> Val -> ShowS
$cshowsPrec :: Int -> Val -> ShowS
Show)

-- the type param 't' can store information at the leaves, e.g. list-shaped keys for lookup
data Header t =
     HSum String (HM.HashMap String (Header t)) -- ^ sums
   | HProd String (HM.HashMap String (Header t)) -- ^ products
   | HLeaf t -- ^ primitive types
   deriving (Header t -> Header t -> Bool
(Header t -> Header t -> Bool)
-> (Header t -> Header t -> Bool) -> Eq (Header t)
forall t. Eq t => Header t -> Header t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header t -> Header t -> Bool
$c/= :: forall t. Eq t => Header t -> Header t -> Bool
== :: Header t -> Header t -> Bool
$c== :: forall t. Eq t => Header t -> Header t -> Bool
Eq, Int -> Header t -> ShowS
[Header t] -> ShowS
Header t -> String
(Int -> Header t -> ShowS)
-> (Header t -> String) -> ([Header t] -> ShowS) -> Show (Header t)
forall t. Show t => Int -> Header t -> ShowS
forall t. Show t => [Header t] -> ShowS
forall t. Show t => Header t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header t] -> ShowS
$cshowList :: forall t. Show t => [Header t] -> ShowS
show :: Header t -> String
$cshow :: forall t. Show t => Header t -> String
showsPrec :: Int -> Header t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Header t -> ShowS
Show, a -> Header b -> Header a
(a -> b) -> Header a -> Header b
(forall a b. (a -> b) -> Header a -> Header b)
-> (forall a b. a -> Header b -> Header a) -> Functor Header
forall a b. a -> Header b -> Header a
forall a b. (a -> b) -> Header a -> Header b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Header b -> Header a
$c<$ :: forall a b. a -> Header b -> Header a
fmap :: (a -> b) -> Header a -> Header b
$cfmap :: forall a b. (a -> b) -> Header a -> Header b
Functor, Header a -> Bool
(a -> m) -> Header a -> m
(a -> b -> b) -> b -> Header a -> b
(forall m. Monoid m => Header m -> m)
-> (forall m a. Monoid m => (a -> m) -> Header a -> m)
-> (forall m a. Monoid m => (a -> m) -> Header a -> m)
-> (forall a b. (a -> b -> b) -> b -> Header a -> b)
-> (forall a b. (a -> b -> b) -> b -> Header a -> b)
-> (forall b a. (b -> a -> b) -> b -> Header a -> b)
-> (forall b a. (b -> a -> b) -> b -> Header a -> b)
-> (forall a. (a -> a -> a) -> Header a -> a)
-> (forall a. (a -> a -> a) -> Header a -> a)
-> (forall a. Header a -> [a])
-> (forall a. Header a -> Bool)
-> (forall a. Header a -> Int)
-> (forall a. Eq a => a -> Header a -> Bool)
-> (forall a. Ord a => Header a -> a)
-> (forall a. Ord a => Header a -> a)
-> (forall a. Num a => Header a -> a)
-> (forall a. Num a => Header a -> a)
-> Foldable Header
forall a. Eq a => a -> Header a -> Bool
forall a. Num a => Header a -> a
forall a. Ord a => Header a -> a
forall m. Monoid m => Header m -> m
forall a. Header a -> Bool
forall a. Header a -> Int
forall a. Header a -> [a]
forall a. (a -> a -> a) -> Header a -> a
forall m a. Monoid m => (a -> m) -> Header a -> m
forall b a. (b -> a -> b) -> b -> Header a -> b
forall a b. (a -> b -> b) -> b -> Header 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
product :: Header a -> a
$cproduct :: forall a. Num a => Header a -> a
sum :: Header a -> a
$csum :: forall a. Num a => Header a -> a
minimum :: Header a -> a
$cminimum :: forall a. Ord a => Header a -> a
maximum :: Header a -> a
$cmaximum :: forall a. Ord a => Header a -> a
elem :: a -> Header a -> Bool
$celem :: forall a. Eq a => a -> Header a -> Bool
length :: Header a -> Int
$clength :: forall a. Header a -> Int
null :: Header a -> Bool
$cnull :: forall a. Header a -> Bool
toList :: Header a -> [a]
$ctoList :: forall a. Header a -> [a]
foldl1 :: (a -> a -> a) -> Header a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Header a -> a
foldr1 :: (a -> a -> a) -> Header a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Header a -> a
foldl' :: (b -> a -> b) -> b -> Header a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Header a -> b
foldl :: (b -> a -> b) -> b -> Header a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Header a -> b
foldr' :: (a -> b -> b) -> b -> Header a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Header a -> b
foldr :: (a -> b -> b) -> b -> Header a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Header a -> b
foldMap' :: (a -> m) -> Header a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Header a -> m
foldMap :: (a -> m) -> Header a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Header a -> m
fold :: Header m -> m
$cfold :: forall m. Monoid m => Header m -> m
Foldable, Functor Header
Foldable Header
Functor Header
-> Foldable Header
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Header a -> f (Header b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Header (f a) -> f (Header a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Header a -> m (Header b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Header (m a) -> m (Header a))
-> Traversable Header
(a -> f b) -> Header a -> f (Header 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 => Header (m a) -> m (Header a)
forall (f :: * -> *) a.
Applicative f =>
Header (f a) -> f (Header a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Header a -> m (Header b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Header a -> f (Header b)
sequence :: Header (m a) -> m (Header a)
$csequence :: forall (m :: * -> *) a. Monad m => Header (m a) -> m (Header a)
mapM :: (a -> m b) -> Header a -> m (Header b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Header a -> m (Header b)
sequenceA :: Header (f a) -> f (Header a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Header (f a) -> f (Header a)
traverse :: (a -> f b) -> Header a -> f (Header b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Header a -> f (Header b)
$cp2Traversable :: Foldable Header
$cp1Traversable :: Functor Header
Traversable)

-- | Single interface to the library.
--
-- This typeclass provides all the machinery for encoding Haskell values into dataframes.
--
-- NOTE: Your datatypes only need to possess a 'G.Generic' instance, to which you just need to add an empty instance of 'Heidi'.
--
-- example:
--
-- @
-- {-\# language DeriveGenerics, DeriveAnyClass \#-}
--
-- data A = A Int Char deriving ('G.Generic', 'Heidi')
-- @
class Heidi a where
  toVal :: a -> Val
  default toVal ::
    (G.Generic a, All2 Heidi (GCode a), GFrom a, GDatatypeInfo a) => a -> Val
  toVal a
x = DatatypeInfo (ToSumCode (Rep a) '[])
-> SOP I (ToSumCode (Rep a) '[]) -> Val
forall (xss :: [[*]]).
All2 Heidi xss =>
DatatypeInfo xss -> SOP I xss -> Val
toVal' (Proxy a -> DatatypeInfo (ToSumCode (Rep a) '[])
forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) (a -> SOP I (ToSumCode (Rep a) '[])
forall a. (GFrom a, Generic a) => a -> SOP I (GCode a)
gfrom a
x)
  header :: Proxy a -> Header String
  default header ::
    (G.Generic a, All2 Heidi (GCode a), GDatatypeInfo a) => Proxy a -> Header String
  header Proxy a
_ = DatatypeInfo (ToSumCode (Rep a) '[]) -> Header String
forall (xs :: [[*]]).
(All2 Heidi xs, SListI xs) =>
DatatypeInfo xs -> Header String
header' (Proxy a -> DatatypeInfo (ToSumCode (Rep a) '[])
forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

toVal' :: All2 Heidi xss => DatatypeInfo xss -> SOP I xss -> Val
toVal' :: DatatypeInfo xss -> SOP I xss -> Val
toVal' DatatypeInfo xss
di sop :: SOP I xss
sop@(SOP NS (NP I) xss
xss) = NS (K Val) xss -> CollapseTo NS Val
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K Val) xss -> CollapseTo NS Val)
-> NS (K Val) xss -> CollapseTo NS Val
forall a b. (a -> b) -> a -> b
$ Proxy (All Heidi)
-> (forall (a :: [*]).
    All Heidi a =>
    ConstructorInfo a -> NP I a -> K Val a)
-> Prod NS ConstructorInfo xss
-> NS (NP I) xss
-> NS (K Val) xss
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hcliftA2
    Proxy (All Heidi)
allp
    (\ConstructorInfo a
ci NP I a
xs -> Val -> K Val a
forall k a (b :: k). a -> K a b
K (ConstructorInfo a -> NP I a -> String -> OneHot Int -> Val
forall (xs :: [*]).
All Heidi xs =>
ConstructorInfo xs -> NP I xs -> String -> OneHot Int -> Val
mkVal ConstructorInfo a
ci NP I a
xs String
tyName OneHot Int
oneHot))
    (DatatypeInfo xss -> NP ConstructorInfo xss
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo DatatypeInfo xss
di)
    NS (NP I) xss
xss
  where
     tyName :: String
tyName = DatatypeInfo xss -> String
forall (xss :: [[*]]). DatatypeInfo xss -> String
datatypeName DatatypeInfo xss
di
     oneHot :: OneHot Int
oneHot = DatatypeInfo xss -> SOP I xss -> OneHot Int
forall (xs :: [[*]]).
SListI xs =>
DatatypeInfo xs -> SOP I xs -> OneHot Int
mkOH DatatypeInfo xss
di SOP I xss
sop

mkVal :: All Heidi xs =>
         ConstructorInfo xs
      -> NP I xs
      -> DatatypeName -> OneHot Int -> Val
mkVal :: ConstructorInfo xs -> NP I xs -> String -> OneHot Int -> Val
mkVal ConstructorInfo xs
cinfo NP I xs
xs String
tyn OneHot Int
oh = case ConstructorInfo xs
cinfo of
    Infix String
cn Associativity
_ Int
_  -> String -> HashMap String Val -> Val
VRec String
cn (HashMap String Val -> Val) -> HashMap String Val -> Val
forall a b. (a -> b) -> a -> b
$ NP I xs -> HashMap String Val
forall (xs :: [*]). All Heidi xs => NP I xs -> HashMap String Val
mkAnonProd NP I xs
xs
    Constructor String
cn
      | [Val] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Val]
cns  -> String -> String -> OneHot Int -> Val
VEnum String
tyn String
cn OneHot Int
oh
      | Bool
otherwise -> String -> HashMap String Val -> Val
VRec String
cn  (HashMap String Val -> Val) -> HashMap String Val -> Val
forall a b. (a -> b) -> a -> b
$ NP I xs -> HashMap String Val
forall (xs :: [*]). All Heidi xs => NP I xs -> HashMap String Val
mkAnonProd NP I xs
xs
    Record String
_ NP FieldInfo xs
fi   -> String -> HashMap String Val -> Val
VRec String
tyn (HashMap String Val -> Val) -> HashMap String Val -> Val
forall a b. (a -> b) -> a -> b
$ NP FieldInfo xs -> NP I xs -> HashMap String Val
forall (xs :: [*]).
All Heidi xs =>
NP FieldInfo xs -> NP I xs -> HashMap String Val
mkProd NP FieldInfo xs
fi NP I xs
xs
  where
    cns :: [Val]
    cns :: [Val]
cns = NP I xs -> [Val]
forall (xs :: [*]). All Heidi xs => NP I xs -> [Val]
npToVals NP I xs
xs

    mkProd :: All Heidi xs => NP FieldInfo xs -> NP I xs -> HM.HashMap String Val
    mkProd :: NP FieldInfo xs -> NP I xs -> HashMap String Val
mkProd NP FieldInfo xs
finfo NP I xs
xss = [(String, Val)] -> HashMap String Val
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Val)] -> HashMap String Val)
-> [(String, Val)] -> HashMap String Val
forall a b. (a -> b) -> a -> b
$
      NP (K (String, Val)) xs -> CollapseTo NP (String, Val)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NP (K (String, Val)) xs -> CollapseTo NP (String, Val))
-> NP (K (String, Val)) xs -> CollapseTo NP (String, Val)
forall a b. (a -> b) -> a -> b
$ Proxy Heidi
-> (forall a. Heidi a => FieldInfo a -> I a -> K (String, Val) a)
-> Prod NP FieldInfo xs
-> NP I xs
-> NP (K (String, Val)) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hcliftA2 Proxy Heidi
p forall a. Heidi a => FieldInfo a -> I a -> K (String, Val) a
mk Prod NP FieldInfo xs
NP FieldInfo xs
finfo NP I xs
xss
      where
        mk :: Heidi v => FieldInfo v -> I v -> K (FieldName, Val) v
        mk :: FieldInfo v -> I v -> K (String, Val) v
mk (FieldInfo String
n) (I v
x) = (String, Val) -> K (String, Val) v
forall k a (b :: k). a -> K a b
K (String
n, v -> Val
forall a. Heidi a => a -> Val
toVal v
x)

    mkAnonProd :: All Heidi xs => NP I xs -> HM.HashMap String Val
    mkAnonProd :: NP I xs -> HashMap String Val
mkAnonProd NP I xs
xss = [(String, Val)] -> HashMap String Val
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Val)] -> HashMap String Val)
-> [(String, Val)] -> HashMap String Val
forall a b. (a -> b) -> a -> b
$ [String] -> [Val] -> [(String, Val)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
labels [Val]
cnss
      where
        cnss :: [Val]
cnss = NP I xs -> [Val]
forall (xs :: [*]). All Heidi xs => NP I xs -> [Val]
npToVals NP I xs
xss

npToVals :: All Heidi xs => NP I xs -> [Val]
npToVals :: NP I xs -> [Val]
npToVals NP I xs
xs = NP (K Val) xs -> CollapseTo NP Val
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NP (K Val) xs -> CollapseTo NP Val)
-> NP (K Val) xs -> CollapseTo NP Val
forall a b. (a -> b) -> a -> b
$ Proxy Heidi
-> (forall a. Heidi a => I a -> K Val a)
-> NP I xs
-> NP (K Val) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy Heidi
p ((a -> Val) -> I a -> K Val a
forall k a b (c :: k). (a -> b) -> I a -> K b c
mapIK a -> Val
forall a. Heidi a => a -> Val
toVal) NP I xs
xs


header' :: (All2 Heidi xs, SListI xs) => DatatypeInfo xs -> Header String
header' :: DatatypeInfo xs -> Header String
header' DatatypeInfo xs
di
  | [(String, Header String)] -> Bool
forall a. [a] -> Bool
single [(String, Header String)]
hs =
      let (String
n, Header String
hdr) = [(String, Header String)] -> (String, Header String)
forall a. [a] -> a
head [(String, Header String)]
hs
      in String -> HashMap String (Header String) -> Header String
forall t. String -> HashMap String (Header t) -> Header t
HProd String
dtn (HashMap String (Header String) -> Header String)
-> HashMap String (Header String) -> Header String
forall a b. (a -> b) -> a -> b
$ String -> Header String -> HashMap String (Header String)
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton String
n Header String
hdr
  | Bool
otherwise = String -> HashMap String (Header String) -> Header String
forall t. String -> HashMap String (Header t) -> Header t
HSum String
dtn (HashMap String (Header String) -> Header String)
-> HashMap String (Header String) -> Header String
forall a b. (a -> b) -> a -> b
$ [(String, Header String)] -> HashMap String (Header String)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(String, Header String)]
hs
  where
    hs :: [(String, Header String)]
    hs :: [(String, Header String)]
hs = NP (K (String, Header String)) xs
-> CollapseTo NP (String, Header String)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NP (K (String, Header String)) xs
 -> CollapseTo NP (String, Header String))
-> NP (K (String, Header String)) xs
-> CollapseTo NP (String, Header String)
forall a b. (a -> b) -> a -> b
$ Proxy (All Heidi)
-> (forall (a :: [*]).
    All Heidi a =>
    ConstructorInfo a -> K (String, Header String) a)
-> NP ConstructorInfo xs
-> NP (K (String, Header String)) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcliftA Proxy (All Heidi)
allp (String -> ConstructorInfo a -> K (String, Header String) a
forall (xs :: [*]).
All Heidi xs =>
String -> ConstructorInfo xs -> K (String, Header String) xs
goConstructor String
dtn) NP ConstructorInfo xs
cinfo
    cinfo :: NP ConstructorInfo xs
cinfo = DatatypeInfo xs -> NP ConstructorInfo xs
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo DatatypeInfo xs
di
    dtn :: String
dtn = DatatypeInfo xs -> String
forall (xss :: [[*]]). DatatypeInfo xss -> String
datatypeName DatatypeInfo xs
di

goConstructor :: forall xs . (All Heidi xs) => String -> ConstructorInfo xs -> K (String, Header String) xs
goConstructor :: String -> ConstructorInfo xs -> K (String, Header String) xs
goConstructor String
dtn = \case
  Record String
n NP FieldInfo xs
ns -> (String, Header String) -> K (String, Header String) xs
forall k a (b :: k). a -> K a b
K (String
n, String -> NP FieldInfo xs -> Header String
forall (xs :: [*]).
All Heidi xs =>
String -> NP FieldInfo xs -> Header String
mkProdH String
dtn NP FieldInfo xs
ns)
  Constructor String
n -> (String, Header String) -> K (String, Header String) xs
forall k a (b :: k). a -> K a b
K (String
n, String -> Proxy xs -> Header String
forall (xs :: [*]).
(SListI xs, All Heidi xs) =>
String -> Proxy xs -> Header String
mkAnonProdH String
dtn (Proxy xs
forall k (t :: k). Proxy t
Proxy @xs) )
  Infix String
n Associativity
_ Int
_ -> (String, Header String) -> K (String, Header String) xs
forall k a (b :: k). a -> K a b
K (String
n, String -> Proxy xs -> Header String
forall (xs :: [*]).
(SListI xs, All Heidi xs) =>
String -> Proxy xs -> Header String
mkAnonProdH String
dtn (Proxy xs
forall k (t :: k). Proxy t
Proxy @xs) )


-- | anonymous products
mkAnonProdH ::
  forall xs. (SListI xs, All Heidi xs) => String -> Proxy xs -> Header String
mkAnonProdH :: String -> Proxy xs -> Header String
mkAnonProdH String
dtn Proxy xs
_  | [Header String] -> Bool
forall a. [a] -> Bool
single [Header String]
hs =
                    let hdr :: Header String
hdr = [Header String] -> Header String
forall a. [a] -> a
head [Header String]
hs
                    in Header String
hdr
                  | [Header String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Header String]
hs = String -> Header String
forall t. t -> Header t
HLeaf String
dtn
                  | Bool
otherwise = String -> HashMap String (Header String) -> Header String
forall t. String -> HashMap String (Header t) -> Header t
HProd String
dtn (HashMap String (Header String) -> Header String)
-> HashMap String (Header String) -> Header String
forall a b. (a -> b) -> a -> b
$ [(String, Header String)] -> HashMap String (Header String)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Header String)] -> HashMap String (Header String))
-> [(String, Header String)] -> HashMap String (Header String)
forall a b. (a -> b) -> a -> b
$ [String] -> [Header String] -> [(String, Header String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
labels [Header String]
hs
  where
    hs :: [Header String]
    hs :: [Header String]
hs = NP (K (Header String)) xs -> CollapseTo NP (Header String)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (Proxy Heidi
-> (forall a. Heidi a => K (Header String) a)
-> NP (K (Header String)) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure Proxy Heidi
p forall a. Heidi a => K (Header String) a
headerK :: NP (K (Header String)) xs)
    headerK :: forall a. Heidi a => K (Header String) a
    headerK :: K (Header String) a
headerK = Header String -> K (Header String) a
forall k a (b :: k). a -> K a b
K (Proxy a -> Header String
forall a. Heidi a => Proxy a -> Header String
header (Proxy a
forall k (t :: k). Proxy t
Proxy @a))

-- | products
mkProdH :: All Heidi xs => String -> NP FieldInfo xs -> Header String
mkProdH :: String -> NP FieldInfo xs -> Header String
mkProdH String
dtn NP FieldInfo xs
finfo | [(String, Header String)] -> Bool
forall a. [a] -> Bool
single [(String, Header String)]
hs =
                    let (String
n, Header String
hdr) = [(String, Header String)] -> (String, Header String)
forall a. [a] -> a
head [(String, Header String)]
hs   -- FIXME why n is unused ?!
                    in Header String
hdr
                 | Bool
otherwise = String -> HashMap String (Header String) -> Header String
forall t. String -> HashMap String (Header t) -> Header t
HProd String
dtn (HashMap String (Header String) -> Header String)
-> HashMap String (Header String) -> Header String
forall a b. (a -> b) -> a -> b
$ [(String, Header String)] -> HashMap String (Header String)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(String, Header String)]
hs
  where
    hs :: [(String, Header String)]
    hs :: [(String, Header String)]
hs = NP (K (String, Header String)) xs
-> CollapseTo NP (String, Header String)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NP (K (String, Header String)) xs
 -> CollapseTo NP (String, Header String))
-> NP (K (String, Header String)) xs
-> CollapseTo NP (String, Header String)
forall a b. (a -> b) -> a -> b
$ Proxy Heidi
-> (forall a.
    Heidi a =>
    FieldInfo a -> K (String, Header String) a)
-> NP FieldInfo xs
-> NP (K (String, Header String)) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcliftA Proxy Heidi
p forall a. Heidi a => FieldInfo a -> K (String, Header String) a
goFieldH NP FieldInfo xs
finfo

goFieldH :: forall a . (Heidi a) => FieldInfo a -> K (String, Header String) a
goFieldH :: FieldInfo a -> K (String, Header String) a
goFieldH (FieldInfo String
n) = String -> K (String, Header String) a
forall a. Heidi a => String -> K (String, Header String) a
goFieldAnonH String
n

goFieldAnonH :: forall a . Heidi a => String -> K (String, Header String) a
goFieldAnonH :: String -> K (String, Header String) a
goFieldAnonH String
n = (String, Header String) -> K (String, Header String) a
forall k a (b :: k). a -> K a b
K (String
n, Proxy a -> Header String
forall a. Heidi a => Proxy a -> Header String
header (Proxy a
forall k (t :: k). Proxy t
Proxy @a))

single :: [a] -> Bool
single :: [a] -> Bool
single = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length


allp :: Proxy (All Heidi)
allp :: Proxy (All Heidi)
allp = Proxy (All Heidi)
forall k (t :: k). Proxy t
Proxy

p :: Proxy Heidi
p :: Proxy Heidi
p = Proxy Heidi
forall k (t :: k). Proxy t
Proxy

-- | >>> take 3 labels
-- ["_0","_1","_2"]
labels :: [String]
labels :: [String]
labels = (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char
'_' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) [Integer
0 ..]


instance Heidi () where {toVal :: () -> Val
toVal ()
_ = VP -> Val
VPrim VP
VPUnit ; header :: Proxy () -> Header String
header Proxy ()
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"()"}
instance Heidi Bool where toVal :: Bool -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Bool -> VP) -> Bool -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> VP
VPBool
instance Heidi Int where {toVal :: Int -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Int -> VP) -> Int -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VP
VPInt ; header :: Proxy Int -> Header String
header Proxy Int
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Int"}
instance Heidi Int8 where {toVal :: Int8 -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Int8 -> VP) -> Int8 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> VP
VPInt8 ; header :: Proxy Int8 -> Header String
header Proxy Int8
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Int8"}
instance Heidi Int16 where {toVal :: Int16 -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Int16 -> VP) -> Int16 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> VP
VPInt16 ; header :: Proxy Int16 -> Header String
header Proxy Int16
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Int16"}
instance Heidi Int32 where {toVal :: Int32 -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Int32 -> VP) -> Int32 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> VP
VPInt32 ; header :: Proxy Int32 -> Header String
header Proxy Int32
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Int32"}
instance Heidi Int64 where {toVal :: Int64 -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Int64 -> VP) -> Int64 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> VP
VPInt64 ; header :: Proxy Int64 -> Header String
header Proxy Int64
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Int64"}
instance Heidi Word where {toVal :: Word -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Word -> VP) -> Word -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> VP
VPWord ; header :: Proxy Word -> Header String
header Proxy Word
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Word"}
instance Heidi Word8 where {toVal :: Word8 -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Word8 -> VP) -> Word8 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> VP
VPWord8 ; header :: Proxy Word8 -> Header String
header Proxy Word8
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Word8"}
instance Heidi Word16 where {toVal :: Word16 -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Word16 -> VP) -> Word16 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> VP
VPWord16 ; header :: Proxy Word16 -> Header String
header Proxy Word16
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Word16"}
instance Heidi Word32 where {toVal :: Word32 -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Word32 -> VP) -> Word32 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> VP
VPWord32 ; header :: Proxy Word32 -> Header String
header Proxy Word32
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Word32"}
instance Heidi Word64 where {toVal :: Word64 -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Word64 -> VP) -> Word64 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VP
VPWord64 ; header :: Proxy Word64 -> Header String
header Proxy Word64
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Word64"}
instance Heidi Float where {toVal :: Float -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Float -> VP) -> Float -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> VP
VPFloat ; header :: Proxy Float -> Header String
header Proxy Float
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Float"}
instance Heidi Double where {toVal :: Double -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Double -> VP) -> Double -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> VP
VPDouble ; header :: Proxy Double -> Header String
header Proxy Double
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Double"}
instance Heidi Scientific where {toVal :: Scientific -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Scientific -> VP) -> Scientific -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> VP
VPScientific ; header :: Proxy Scientific -> Header String
header Proxy Scientific
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Scientific"}
instance Heidi Char where {toVal :: Char -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Char -> VP) -> Char -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> VP
VPChar ; header :: Proxy Char -> Header String
header Proxy Char
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Char"}
instance Heidi String where {toVal :: String -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (String -> VP) -> String -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VP
VPString ; header :: Proxy String -> Header String
header Proxy String
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"String"}
instance Heidi Text where {toVal :: Text -> Val
toVal = VP -> Val
VPrim (VP -> Val) -> (Text -> VP) -> Text -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> VP
VPText ; header :: Proxy Text -> Header String
header Proxy Text
_ = String -> Header String
forall t. t -> Header t
HLeaf String
"Text"}

instance Heidi a => Heidi (Maybe a) where
  toVal :: Maybe a -> Val
toVal = \case
    Maybe a
Nothing -> String -> HashMap String Val -> Val
VRec String
"Maybe" HashMap String Val
forall k v. HashMap k v
HM.empty
    Just a
x  -> String -> HashMap String Val -> Val
VRec String
"Maybe" (HashMap String Val -> Val) -> HashMap String Val -> Val
forall a b. (a -> b) -> a -> b
$ String -> Val -> HashMap String Val
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton String
"Just" (Val -> HashMap String Val) -> Val -> HashMap String Val
forall a b. (a -> b) -> a -> b
$ a -> Val
forall a. Heidi a => a -> Val
toVal a
x
  header :: Proxy (Maybe a) -> Header String
header Proxy (Maybe a)
_ = String -> HashMap String (Header String) -> Header String
forall t. String -> HashMap String (Header t) -> Header t
HSum String
"Maybe" (HashMap String (Header String) -> Header String)
-> HashMap String (Header String) -> Header String
forall a b. (a -> b) -> a -> b
$ [(String, Header String)] -> HashMap String (Header String)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [
    (String
"Nothing", String -> Header String
forall t. t -> Header t
HLeaf String
"_") ,
    (String
"Just", Proxy a -> Header String
forall a. Heidi a => Proxy a -> Header String
header (Proxy a
forall k (t :: k). Proxy t
Proxy @a))]

instance (Heidi a, Heidi b) => Heidi (Either a b) where
  toVal :: Either a b -> Val
toVal = \case
    Left  a
l -> String -> HashMap String Val -> Val
VRec String
"Either" (HashMap String Val -> Val) -> HashMap String Val -> Val
forall a b. (a -> b) -> a -> b
$ String -> Val -> HashMap String Val
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton String
"Left" (Val -> HashMap String Val) -> Val -> HashMap String Val
forall a b. (a -> b) -> a -> b
$ a -> Val
forall a. Heidi a => a -> Val
toVal a
l
    Right b
r -> String -> HashMap String Val -> Val
VRec String
"Either" (HashMap String Val -> Val) -> HashMap String Val -> Val
forall a b. (a -> b) -> a -> b
$ String -> Val -> HashMap String Val
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton String
"Right" (Val -> HashMap String Val) -> Val -> HashMap String Val
forall a b. (a -> b) -> a -> b
$ b -> Val
forall a. Heidi a => a -> Val
toVal b
r

instance (Heidi a, Heidi b) => Heidi (a, b) where
  toVal :: (a, b) -> Val
toVal (a
x, b
y) = String -> HashMap String Val -> Val
VRec String
"(,)" (HashMap String Val -> Val) -> HashMap String Val -> Val
forall a b. (a -> b) -> a -> b
$ [(String, Val)] -> HashMap String Val
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Val)] -> HashMap String Val)
-> [(String, Val)] -> HashMap String Val
forall a b. (a -> b) -> a -> b
$ [String] -> [Val] -> [(String, Val)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
labels [a -> Val
forall a. Heidi a => a -> Val
toVal a
x, b -> Val
forall a. Heidi a => a -> Val
toVal b
y]

instance (Heidi a, Heidi b, Heidi c) => Heidi (a, b, c) where
  toVal :: (a, b, c) -> Val
toVal (a
x, b
y, c
z) = String -> HashMap String Val -> Val
VRec String
"(,,)" (HashMap String Val -> Val) -> HashMap String Val -> Val
forall a b. (a -> b) -> a -> b
$ [(String, Val)] -> HashMap String Val
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(String, Val)] -> HashMap String Val)
-> [(String, Val)] -> HashMap String Val
forall a b. (a -> b) -> a -> b
$ [String] -> [Val] -> [(String, Val)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
labels [a -> Val
forall a. Heidi a => a -> Val
toVal a
x, b -> Val
forall a. Heidi a => a -> Val
toVal b
y, c -> Val
forall a. Heidi a => a -> Val
toVal c
z] 





-- | Extract an Int
getInt :: VP -> Maybe Int
getInt :: VP -> Maybe Int
getInt = \case {VPInt Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i; VP
_ -> Maybe Int
forall a. Maybe a
Nothing}
-- | Extract an Int8
getInt8 :: VP -> Maybe Int8
getInt8 :: VP -> Maybe Int8
getInt8 = \case {VPInt8 Int8
i -> Int8 -> Maybe Int8
forall a. a -> Maybe a
Just Int8
i; VP
_ -> Maybe Int8
forall a. Maybe a
Nothing}
-- | Extract an Int16
getInt16 :: VP -> Maybe Int16
getInt16 :: VP -> Maybe Int16
getInt16 = \case {VPInt16 Int16
i -> Int16 -> Maybe Int16
forall a. a -> Maybe a
Just Int16
i; VP
_ -> Maybe Int16
forall a. Maybe a
Nothing}
-- | Extract an Int32
getInt32 :: VP -> Maybe Int32
getInt32 :: VP -> Maybe Int32
getInt32 = \case {VPInt32 Int32
i -> Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
i; VP
_ -> Maybe Int32
forall a. Maybe a
Nothing}
-- | Extract an Int64
getInt64 :: VP -> Maybe Int64
getInt64 :: VP -> Maybe Int64
getInt64 = \case {VPInt64 Int64
i -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
i; VP
_ -> Maybe Int64
forall a. Maybe a
Nothing}
-- | Extract a Word
getWord :: VP -> Maybe Word
getWord :: VP -> Maybe Word
getWord = \case {VPWord Word
i -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
i; VP
_ -> Maybe Word
forall a. Maybe a
Nothing}
-- | Extract a Word8
getWord8 :: VP -> Maybe Word8
getWord8 :: VP -> Maybe Word8
getWord8 = \case {VPWord8 Word8
i -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
i; VP
_ -> Maybe Word8
forall a. Maybe a
Nothing}
-- | Extract a Word16
getWord16 :: VP -> Maybe Word16
getWord16 :: VP -> Maybe Word16
getWord16 = \case {VPWord16 Word16
i -> Word16 -> Maybe Word16
forall a. a -> Maybe a
Just Word16
i; VP
_ -> Maybe Word16
forall a. Maybe a
Nothing}
-- | Extract a Word32
getWord32 :: VP -> Maybe Word32
getWord32 :: VP -> Maybe Word32
getWord32 = \case {VPWord32 Word32
i -> Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
i; VP
_ -> Maybe Word32
forall a. Maybe a
Nothing}
-- | Extract a Word64
getWord64 :: VP -> Maybe Word64
getWord64 :: VP -> Maybe Word64
getWord64 = \case {VPWord64 Word64
i -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
i; VP
_ -> Maybe Word64
forall a. Maybe a
Nothing}
-- | Extract a Bool
getBool :: VP -> Maybe Bool
getBool :: VP -> Maybe Bool
getBool = \case {VPBool Bool
i -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
i; VP
_ -> Maybe Bool
forall a. Maybe a
Nothing}
-- | Extract a Float
getFloat :: VP -> Maybe Float
getFloat :: VP -> Maybe Float
getFloat = \case {VPFloat Float
i -> Float -> Maybe Float
forall a. a -> Maybe a
Just Float
i; VP
_ -> Maybe Float
forall a. Maybe a
Nothing}
-- | Extract a Double
getDouble :: VP -> Maybe Double
getDouble :: VP -> Maybe Double
getDouble = \case {VPDouble Double
i -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
i; VP
_ -> Maybe Double
forall a. Maybe a
Nothing}
-- | Extract a Scientific
getScientific :: VP -> Maybe Scientific
getScientific :: VP -> Maybe Scientific
getScientific = \case {VPScientific Scientific
i -> Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
i; VP
_ -> Maybe Scientific
forall a. Maybe a
Nothing}
-- | Extract a Char
getChar :: VP -> Maybe Char
getChar :: VP -> Maybe Char
getChar = \case {VPChar Char
i -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
i; VP
_ -> Maybe Char
forall a. Maybe a
Nothing}
-- | Extract a String
getString :: VP -> Maybe String
getString :: VP -> Maybe String
getString = \case {VPString String
i -> String -> Maybe String
forall a. a -> Maybe a
Just String
i; VP
_ -> Maybe String
forall a. Maybe a
Nothing}
-- | Extract a Text string
getText :: VP -> Maybe Text
getText :: VP -> Maybe Text
getText = \case {VPText Text
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i; VP
_ -> Maybe Text
forall a. Maybe a
Nothing}
-- | Extract a OneHot value
getOneHot :: VP -> Maybe (OneHot Int)
getOneHot :: VP -> Maybe (OneHot Int)
getOneHot = \case {VPOH OneHot Int
i -> OneHot Int -> Maybe (OneHot Int)
forall a. a -> Maybe a
Just OneHot Int
i; VP
_ -> Maybe (OneHot Int)
forall a. Maybe a
Nothing}

-- | Helper function for decoding into a 'MonadThrow'.
decodeM :: (MonadThrow m, Exception e) =>
           e -> (a -> m b) -> Maybe a -> m b
decodeM :: e -> (a -> m b) -> Maybe a -> m b
decodeM e
e = m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e)


getIntM :: MonadThrow m => VP -> m Int
getIntM :: VP -> m Int
getIntM VP
x = TypeError -> (Int -> m Int) -> Maybe Int -> m Int
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
IntCastE Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Int
getInt VP
x)
getInt8M :: MonadThrow m => VP -> m Int8
getInt8M :: VP -> m Int8
getInt8M VP
x = TypeError -> (Int8 -> m Int8) -> Maybe Int8 -> m Int8
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
Int8CastE Int8 -> m Int8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Int8
getInt8 VP
x)
getInt16M :: MonadThrow m => VP -> m Int16
getInt16M :: VP -> m Int16
getInt16M VP
x = TypeError -> (Int16 -> m Int16) -> Maybe Int16 -> m Int16
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
Int16CastE Int16 -> m Int16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Int16
getInt16 VP
x)
getInt32M :: MonadThrow m => VP -> m Int32
getInt32M :: VP -> m Int32
getInt32M VP
x = TypeError -> (Int32 -> m Int32) -> Maybe Int32 -> m Int32
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
Int32CastE Int32 -> m Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Int32
getInt32 VP
x)
getInt64M :: MonadThrow m => VP -> m Int64
getInt64M :: VP -> m Int64
getInt64M VP
x = TypeError -> (Int64 -> m Int64) -> Maybe Int64 -> m Int64
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
Int64CastE Int64 -> m Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Int64
getInt64 VP
x)
getWordM :: MonadThrow m => VP -> m Word
getWordM :: VP -> m Word
getWordM VP
x = TypeError -> (Word -> m Word) -> Maybe Word -> m Word
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
WordCastE Word -> m Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Word
getWord VP
x)
getWord8M :: MonadThrow m => VP -> m Word8
getWord8M :: VP -> m Word8
getWord8M VP
x = TypeError -> (Word8 -> m Word8) -> Maybe Word8 -> m Word8
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
Word8CastE Word8 -> m Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Word8
getWord8 VP
x)
getWord16M :: MonadThrow m => VP -> m Word16
getWord16M :: VP -> m Word16
getWord16M VP
x = TypeError -> (Word16 -> m Word16) -> Maybe Word16 -> m Word16
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
Word16CastE Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Word16
getWord16 VP
x)
getWord32M :: MonadThrow m => VP -> m Word32
getWord32M :: VP -> m Word32
getWord32M VP
x = TypeError -> (Word32 -> m Word32) -> Maybe Word32 -> m Word32
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
Word32CastE Word32 -> m Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Word32
getWord32 VP
x)
getWord64M :: MonadThrow m => VP -> m Word64
getWord64M :: VP -> m Word64
getWord64M VP
x = TypeError -> (Word64 -> m Word64) -> Maybe Word64 -> m Word64
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
Word64CastE Word64 -> m Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Word64
getWord64 VP
x)
getBoolM :: MonadThrow m => VP -> m Bool
getBoolM :: VP -> m Bool
getBoolM VP
x = TypeError -> (Bool -> m Bool) -> Maybe Bool -> m Bool
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
BoolCastE Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Bool
getBool VP
x)
getFloatM :: MonadThrow m => VP -> m Float
getFloatM :: VP -> m Float
getFloatM VP
x = TypeError -> (Float -> m Float) -> Maybe Float -> m Float
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
FloatCastE Float -> m Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Float
getFloat VP
x)
getDoubleM :: MonadThrow m => VP -> m Double
getDoubleM :: VP -> m Double
getDoubleM VP
x = TypeError -> (Double -> m Double) -> Maybe Double -> m Double
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
DoubleCastE Double -> m Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Double
getDouble VP
x)
getScientificM :: MonadThrow m => VP -> m Scientific
getScientificM :: VP -> m Scientific
getScientificM VP
x = TypeError
-> (Scientific -> m Scientific) -> Maybe Scientific -> m Scientific
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
ScientificCastE Scientific -> m Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Scientific
getScientific VP
x)
getCharM :: MonadThrow m => VP -> m Char
getCharM :: VP -> m Char
getCharM VP
x = TypeError -> (Char -> m Char) -> Maybe Char -> m Char
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
CharCastE Char -> m Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Char
getChar VP
x)
getStringM :: MonadThrow m => VP -> m String
getStringM :: VP -> m String
getStringM VP
x = TypeError -> (String -> m String) -> Maybe String -> m String
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
StringCastE String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe String
getString VP
x)
getTextM :: MonadThrow m => VP -> m Text
getTextM :: VP -> m Text
getTextM VP
x = TypeError -> (Text -> m Text) -> Maybe Text -> m Text
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
TextCastE Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe Text
getText VP
x)
getOneHotM :: MonadThrow m => VP -> m (OneHot Int)
getOneHotM :: VP -> m (OneHot Int)
getOneHotM VP
x = TypeError
-> (OneHot Int -> m (OneHot Int))
-> Maybe (OneHot Int)
-> m (OneHot Int)
forall (m :: * -> *) e a b.
(MonadThrow m, Exception e) =>
e -> (a -> m b) -> Maybe a -> m b
decodeM TypeError
OneHotCastE OneHot Int -> m (OneHot Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VP -> Maybe (OneHot Int)
getOneHot VP
x)

-- | Type errors
data TypeError =
    FloatCastE
  | DoubleCastE
  | ScientificCastE
  | IntCastE
  | Int8CastE
  | Int16CastE
  | Int32CastE
  | Int64CastE
  | WordCastE
  | Word8CastE
  | Word16CastE
  | Word32CastE
  | Word64CastE
  | BoolCastE
  | CharCastE
  | StringCastE
  | TextCastE
  | OneHotCastE
  deriving (Int -> TypeError -> ShowS
[TypeError] -> ShowS
TypeError -> String
(Int -> TypeError -> ShowS)
-> (TypeError -> String)
-> ([TypeError] -> ShowS)
-> Show TypeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeError] -> ShowS
$cshowList :: [TypeError] -> ShowS
show :: TypeError -> String
$cshow :: TypeError -> String
showsPrec :: Int -> TypeError -> ShowS
$cshowsPrec :: Int -> TypeError -> ShowS
Show, TypeError -> TypeError -> Bool
(TypeError -> TypeError -> Bool)
-> (TypeError -> TypeError -> Bool) -> Eq TypeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeError -> TypeError -> Bool
$c/= :: TypeError -> TypeError -> Bool
== :: TypeError -> TypeError -> Bool
$c== :: TypeError -> TypeError -> Bool
Eq, Typeable)
instance Exception TypeError






-- -- examples

data A0 = MkA0 deriving (A0 -> A0 -> Bool
(A0 -> A0 -> Bool) -> (A0 -> A0 -> Bool) -> Eq A0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: A0 -> A0 -> Bool
$c/= :: A0 -> A0 -> Bool
== :: A0 -> A0 -> Bool
$c== :: A0 -> A0 -> Bool
Eq, Int -> A0 -> ShowS
[A0] -> ShowS
A0 -> String
(Int -> A0 -> ShowS)
-> (A0 -> String) -> ([A0] -> ShowS) -> Show A0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [A0] -> ShowS
$cshowList :: [A0] -> ShowS
show :: A0 -> String
$cshow :: A0 -> String
showsPrec :: Int -> A0 -> ShowS
$cshowsPrec :: Int -> A0 -> ShowS
Show, (forall x. A0 -> Rep A0 x)
-> (forall x. Rep A0 x -> A0) -> Generic A0
forall x. Rep A0 x -> A0
forall x. A0 -> Rep A0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep A0 x -> A0
$cfrom :: forall x. A0 -> Rep A0 x
G.Generic, Proxy A0 -> Header String
A0 -> Val
(A0 -> Val) -> (Proxy A0 -> Header String) -> Heidi A0
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy A0 -> Header String
$cheader :: Proxy A0 -> Header String
toVal :: A0 -> Val
$ctoVal :: A0 -> Val
Heidi)
data A = MkA Int deriving (A -> A -> Bool
(A -> A -> Bool) -> (A -> A -> Bool) -> Eq A
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: A -> A -> Bool
$c/= :: A -> A -> Bool
== :: A -> A -> Bool
$c== :: A -> A -> Bool
Eq, Int -> A -> ShowS
[A] -> ShowS
A -> String
(Int -> A -> ShowS) -> (A -> String) -> ([A] -> ShowS) -> Show A
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [A] -> ShowS
$cshowList :: [A] -> ShowS
show :: A -> String
$cshow :: A -> String
showsPrec :: Int -> A -> ShowS
$cshowsPrec :: Int -> A -> ShowS
Show, (forall x. A -> Rep A x) -> (forall x. Rep A x -> A) -> Generic A
forall x. Rep A x -> A
forall x. A -> Rep A x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep A x -> A
$cfrom :: forall x. A -> Rep A x
G.Generic, Proxy A -> Header String
A -> Val
(A -> Val) -> (Proxy A -> Header String) -> Heidi A
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy A -> Header String
$cheader :: Proxy A -> Header String
toVal :: A -> Val
$ctoVal :: A -> Val
Heidi)
newtype A' = MkA' Int deriving (A' -> A' -> Bool
(A' -> A' -> Bool) -> (A' -> A' -> Bool) -> Eq A'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: A' -> A' -> Bool
$c/= :: A' -> A' -> Bool
== :: A' -> A' -> Bool
$c== :: A' -> A' -> Bool
Eq, Int -> A' -> ShowS
[A'] -> ShowS
A' -> String
(Int -> A' -> ShowS)
-> (A' -> String) -> ([A'] -> ShowS) -> Show A'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [A'] -> ShowS
$cshowList :: [A'] -> ShowS
show :: A' -> String
$cshow :: A' -> String
showsPrec :: Int -> A' -> ShowS
$cshowsPrec :: Int -> A' -> ShowS
Show, (forall x. A' -> Rep A' x)
-> (forall x. Rep A' x -> A') -> Generic A'
forall x. Rep A' x -> A'
forall x. A' -> Rep A' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep A' x -> A'
$cfrom :: forall x. A' -> Rep A' x
G.Generic, Proxy A' -> Header String
A' -> Val
(A' -> Val) -> (Proxy A' -> Header String) -> Heidi A'
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy A' -> Header String
$cheader :: Proxy A' -> Header String
toVal :: A' -> Val
$ctoVal :: A' -> Val
Heidi)
newtype A2 = A2 { A2 -> Int
a2 :: Int } deriving (A2 -> A2 -> Bool
(A2 -> A2 -> Bool) -> (A2 -> A2 -> Bool) -> Eq A2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: A2 -> A2 -> Bool
$c/= :: A2 -> A2 -> Bool
== :: A2 -> A2 -> Bool
$c== :: A2 -> A2 -> Bool
Eq, Int -> A2 -> ShowS
[A2] -> ShowS
A2 -> String
(Int -> A2 -> ShowS)
-> (A2 -> String) -> ([A2] -> ShowS) -> Show A2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [A2] -> ShowS
$cshowList :: [A2] -> ShowS
show :: A2 -> String
$cshow :: A2 -> String
showsPrec :: Int -> A2 -> ShowS
$cshowsPrec :: Int -> A2 -> ShowS
Show, (forall x. A2 -> Rep A2 x)
-> (forall x. Rep A2 x -> A2) -> Generic A2
forall x. Rep A2 x -> A2
forall x. A2 -> Rep A2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep A2 x -> A2
$cfrom :: forall x. A2 -> Rep A2 x
G.Generic, Proxy A2 -> Header String
A2 -> Val
(A2 -> Val) -> (Proxy A2 -> Header String) -> Heidi A2
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy A2 -> Header String
$cheader :: Proxy A2 -> Header String
toVal :: A2 -> Val
$ctoVal :: A2 -> Val
Heidi)
data B = MkB Int Char deriving (B -> B -> Bool
(B -> B -> Bool) -> (B -> B -> Bool) -> Eq B
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: B -> B -> Bool
$c/= :: B -> B -> Bool
== :: B -> B -> Bool
$c== :: B -> B -> Bool
Eq, Int -> B -> ShowS
[B] -> ShowS
B -> String
(Int -> B -> ShowS) -> (B -> String) -> ([B] -> ShowS) -> Show B
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [B] -> ShowS
$cshowList :: [B] -> ShowS
show :: B -> String
$cshow :: B -> String
showsPrec :: Int -> B -> ShowS
$cshowsPrec :: Int -> B -> ShowS
Show, (forall x. B -> Rep B x) -> (forall x. Rep B x -> B) -> Generic B
forall x. Rep B x -> B
forall x. B -> Rep B x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep B x -> B
$cfrom :: forall x. B -> Rep B x
G.Generic, Proxy B -> Header String
B -> Val
(B -> Val) -> (Proxy B -> Header String) -> Heidi B
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy B -> Header String
$cheader :: Proxy B -> Header String
toVal :: B -> Val
$ctoVal :: B -> Val
Heidi)
data B2 = MkB2 { B2 -> Int
b21 :: Int, B2 -> Char
b22 :: Char } deriving (B2 -> B2 -> Bool
(B2 -> B2 -> Bool) -> (B2 -> B2 -> Bool) -> Eq B2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: B2 -> B2 -> Bool
$c/= :: B2 -> B2 -> Bool
== :: B2 -> B2 -> Bool
$c== :: B2 -> B2 -> Bool
Eq, Int -> B2 -> ShowS
[B2] -> ShowS
B2 -> String
(Int -> B2 -> ShowS)
-> (B2 -> String) -> ([B2] -> ShowS) -> Show B2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [B2] -> ShowS
$cshowList :: [B2] -> ShowS
show :: B2 -> String
$cshow :: B2 -> String
showsPrec :: Int -> B2 -> ShowS
$cshowsPrec :: Int -> B2 -> ShowS
Show, (forall x. B2 -> Rep B2 x)
-> (forall x. Rep B2 x -> B2) -> Generic B2
forall x. Rep B2 x -> B2
forall x. B2 -> Rep B2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep B2 x -> B2
$cfrom :: forall x. B2 -> Rep B2 x
G.Generic, Proxy B2 -> Header String
B2 -> Val
(B2 -> Val) -> (Proxy B2 -> Header String) -> Heidi B2
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy B2 -> Header String
$cheader :: Proxy B2 -> Header String
toVal :: B2 -> Val
$ctoVal :: B2 -> Val
Heidi)
data C = MkC1 {C -> Int
c1 :: Int} | MkC2 A | MkC3 () deriving (C -> C -> Bool
(C -> C -> Bool) -> (C -> C -> Bool) -> Eq C
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: C -> C -> Bool
$c/= :: C -> C -> Bool
== :: C -> C -> Bool
$c== :: C -> C -> Bool
Eq, Int -> C -> ShowS
[C] -> ShowS
C -> String
(Int -> C -> ShowS) -> (C -> String) -> ([C] -> ShowS) -> Show C
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [C] -> ShowS
$cshowList :: [C] -> ShowS
show :: C -> String
$cshow :: C -> String
showsPrec :: Int -> C -> ShowS
$cshowsPrec :: Int -> C -> ShowS
Show, (forall x. C -> Rep C x) -> (forall x. Rep C x -> C) -> Generic C
forall x. Rep C x -> C
forall x. C -> Rep C x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep C x -> C
$cfrom :: forall x. C -> Rep C x
G.Generic, Proxy C -> Header String
C -> Val
(C -> Val) -> (Proxy C -> Header String) -> Heidi C
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy C -> Header String
$cheader :: Proxy C -> Header String
toVal :: C -> Val
$ctoVal :: C -> Val
Heidi)
data C2 = C21 {C2 -> Int
c21a :: Int, C2 -> ()
c21b :: ()} | C22 {C2 -> A
c22 :: A} | C23 () deriving (C2 -> C2 -> Bool
(C2 -> C2 -> Bool) -> (C2 -> C2 -> Bool) -> Eq C2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: C2 -> C2 -> Bool
$c/= :: C2 -> C2 -> Bool
== :: C2 -> C2 -> Bool
$c== :: C2 -> C2 -> Bool
Eq, Int -> C2 -> ShowS
[C2] -> ShowS
C2 -> String
(Int -> C2 -> ShowS)
-> (C2 -> String) -> ([C2] -> ShowS) -> Show C2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [C2] -> ShowS
$cshowList :: [C2] -> ShowS
show :: C2 -> String
$cshow :: C2 -> String
showsPrec :: Int -> C2 -> ShowS
$cshowsPrec :: Int -> C2 -> ShowS
Show, (forall x. C2 -> Rep C2 x)
-> (forall x. Rep C2 x -> C2) -> Generic C2
forall x. Rep C2 x -> C2
forall x. C2 -> Rep C2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep C2 x -> C2
$cfrom :: forall x. C2 -> Rep C2 x
G.Generic, Proxy C2 -> Header String
C2 -> Val
(C2 -> Val) -> (Proxy C2 -> Header String) -> Heidi C2
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy C2 -> Header String
$cheader :: Proxy C2 -> Header String
toVal :: C2 -> Val
$ctoVal :: C2 -> Val
Heidi)
data C3 = C31 | C32 | C33 deriving (C3 -> C3 -> Bool
(C3 -> C3 -> Bool) -> (C3 -> C3 -> Bool) -> Eq C3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: C3 -> C3 -> Bool
$c/= :: C3 -> C3 -> Bool
== :: C3 -> C3 -> Bool
$c== :: C3 -> C3 -> Bool
Eq, Int -> C3 -> ShowS
[C3] -> ShowS
C3 -> String
(Int -> C3 -> ShowS)
-> (C3 -> String) -> ([C3] -> ShowS) -> Show C3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [C3] -> ShowS
$cshowList :: [C3] -> ShowS
show :: C3 -> String
$cshow :: C3 -> String
showsPrec :: Int -> C3 -> ShowS
$cshowsPrec :: Int -> C3 -> ShowS
Show, (forall x. C3 -> Rep C3 x)
-> (forall x. Rep C3 x -> C3) -> Generic C3
forall x. Rep C3 x -> C3
forall x. C3 -> Rep C3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep C3 x -> C3
$cfrom :: forall x. C3 -> Rep C3 x
G.Generic, Proxy C3 -> Header String
C3 -> Val
(C3 -> Val) -> (Proxy C3 -> Header String) -> Heidi C3
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy C3 -> Header String
$cheader :: Proxy C3 -> Header String
toVal :: C3 -> Val
$ctoVal :: C3 -> Val
Heidi)
-- data C3 a = C31 a a deriving (Eq, Show, G.Generic, Heidi)
data D = D (Maybe Int) C deriving (D -> D -> Bool
(D -> D -> Bool) -> (D -> D -> Bool) -> Eq D
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: D -> D -> Bool
$c/= :: D -> D -> Bool
== :: D -> D -> Bool
$c== :: D -> D -> Bool
Eq, Int -> D -> ShowS
[D] -> ShowS
D -> String
(Int -> D -> ShowS) -> (D -> String) -> ([D] -> ShowS) -> Show D
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [D] -> ShowS
$cshowList :: [D] -> ShowS
show :: D -> String
$cshow :: D -> String
showsPrec :: Int -> D -> ShowS
$cshowsPrec :: Int -> D -> ShowS
Show, (forall x. D -> Rep D x) -> (forall x. Rep D x -> D) -> Generic D
forall x. Rep D x -> D
forall x. D -> Rep D x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep D x -> D
$cfrom :: forall x. D -> Rep D x
G.Generic, Proxy D -> Header String
D -> Val
(D -> Val) -> (Proxy D -> Header String) -> Heidi D
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy D -> Header String
$cheader :: Proxy D -> Header String
toVal :: D -> Val
$ctoVal :: D -> Val
Heidi)
data E = E (Maybe Int) (Maybe Char) deriving (E -> E -> Bool
(E -> E -> Bool) -> (E -> E -> Bool) -> Eq E
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: E -> E -> Bool
$c/= :: E -> E -> Bool
== :: E -> E -> Bool
$c== :: E -> E -> Bool
Eq, Int -> E -> ShowS
[E] -> ShowS
E -> String
(Int -> E -> ShowS) -> (E -> String) -> ([E] -> ShowS) -> Show E
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [E] -> ShowS
$cshowList :: [E] -> ShowS
show :: E -> String
$cshow :: E -> String
showsPrec :: Int -> E -> ShowS
$cshowsPrec :: Int -> E -> ShowS
Show, (forall x. E -> Rep E x) -> (forall x. Rep E x -> E) -> Generic E
forall x. Rep E x -> E
forall x. E -> Rep E x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep E x -> E
$cfrom :: forall x. E -> Rep E x
G.Generic, Proxy E -> Header String
E -> Val
(E -> Val) -> (Proxy E -> Header String) -> Heidi E
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy E -> Header String
$cheader :: Proxy E -> Header String
toVal :: E -> Val
$ctoVal :: E -> Val
Heidi)
data R = MkR { R -> B2
r1 :: B2, R -> C
r2 :: C , R -> B
r3 :: B } deriving (R -> R -> Bool
(R -> R -> Bool) -> (R -> R -> Bool) -> Eq R
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: R -> R -> Bool
$c/= :: R -> R -> Bool
== :: R -> R -> Bool
$c== :: R -> R -> Bool
Eq, Int -> R -> ShowS
[R] -> ShowS
R -> String
(Int -> R -> ShowS) -> (R -> String) -> ([R] -> ShowS) -> Show R
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [R] -> ShowS
$cshowList :: [R] -> ShowS
show :: R -> String
$cshow :: R -> String
showsPrec :: Int -> R -> ShowS
$cshowsPrec :: Int -> R -> ShowS
Show, (forall x. R -> Rep R x) -> (forall x. Rep R x -> R) -> Generic R
forall x. Rep R x -> R
forall x. R -> Rep R x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep R x -> R
$cfrom :: forall x. R -> Rep R x
G.Generic, Proxy R -> Header String
R -> Val
(R -> Val) -> (Proxy R -> Header String) -> Heidi R
forall a. (a -> Val) -> (Proxy a -> Header String) -> Heidi a
header :: Proxy R -> Header String
$cheader :: Proxy R -> Header String
toVal :: R -> Val
$ctoVal :: R -> Val
Heidi)

-- newtype F = F (Int, Char) deriving (Eq, Show, G.Generic)
-- instance Heidi F