{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Accessors.Dynamic
       ( DTree, DData(..), DConstructor(..), DSimpleEnum(..), DField(..)
       , toDData, updateLookupable, describeDField, sameDFieldType
       , diffDTrees
         -- * some utility functions for working with DSimpleEnums
       , denumToString, denumToStringOrMsg, denumSetString, denumSetIndex
       ) where

import GHC.Generics

import Data.Binary ( Binary )
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Word ( Word8, Word16, Word32, Word64 )
import Data.Serialize ( Serialize )
import Data.Data ( Data )
import Data.Either ( partitionEithers )
import Data.List ( intercalate )
import Data.Typeable ( Typeable )
import Control.Lens
import Text.Printf ( printf )

import Accessors

type DTree = Either DField DData

data DData = DData String DConstructor
           deriving ((forall x. DData -> Rep DData x)
-> (forall x. Rep DData x -> DData) -> Generic DData
forall x. Rep DData x -> DData
forall x. DData -> Rep DData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DData x -> DData
$cfrom :: forall x. DData -> Rep DData x
Generic, Int -> DData -> ShowS
[DData] -> ShowS
DData -> String
(Int -> DData -> ShowS)
-> (DData -> String) -> ([DData] -> ShowS) -> Show DData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DData] -> ShowS
$cshowList :: [DData] -> ShowS
show :: DData -> String
$cshow :: DData -> String
showsPrec :: Int -> DData -> ShowS
$cshowsPrec :: Int -> DData -> ShowS
Show, DData -> DData -> Bool
(DData -> DData -> Bool) -> (DData -> DData -> Bool) -> Eq DData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DData -> DData -> Bool
$c/= :: DData -> DData -> Bool
== :: DData -> DData -> Bool
$c== :: DData -> DData -> Bool
Eq, Eq DData
Eq DData
-> (DData -> DData -> Ordering)
-> (DData -> DData -> Bool)
-> (DData -> DData -> Bool)
-> (DData -> DData -> Bool)
-> (DData -> DData -> Bool)
-> (DData -> DData -> DData)
-> (DData -> DData -> DData)
-> Ord DData
DData -> DData -> Bool
DData -> DData -> Ordering
DData -> DData -> DData
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 :: DData -> DData -> DData
$cmin :: DData -> DData -> DData
max :: DData -> DData -> DData
$cmax :: DData -> DData -> DData
>= :: DData -> DData -> Bool
$c>= :: DData -> DData -> Bool
> :: DData -> DData -> Bool
$c> :: DData -> DData -> Bool
<= :: DData -> DData -> Bool
$c<= :: DData -> DData -> Bool
< :: DData -> DData -> Bool
$c< :: DData -> DData -> Bool
compare :: DData -> DData -> Ordering
$ccompare :: DData -> DData -> Ordering
$cp1Ord :: Eq DData
Ord, Typeable DData
DataType
Constr
Typeable DData
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DData -> c DData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DData)
-> (DData -> Constr)
-> (DData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DData))
-> ((forall b. Data b => b -> b) -> DData -> DData)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DData -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DData -> r)
-> (forall u. (forall d. Data d => d -> u) -> DData -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DData -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DData -> m DData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DData -> m DData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DData -> m DData)
-> Data DData
DData -> DataType
DData -> Constr
(forall b. Data b => b -> b) -> DData -> DData
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DData -> c DData
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DData
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DData -> u
forall u. (forall d. Data d => d -> u) -> DData -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DData -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DData -> m DData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DData -> m DData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DData -> c DData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DData)
$cDData :: Constr
$tDData :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DData -> m DData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DData -> m DData
gmapMp :: (forall d. Data d => d -> m d) -> DData -> m DData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DData -> m DData
gmapM :: (forall d. Data d => d -> m d) -> DData -> m DData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DData -> m DData
gmapQi :: Int -> (forall d. Data d => d -> u) -> DData -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DData -> u
gmapQ :: (forall d. Data d => d -> u) -> DData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DData -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DData -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DData -> r
gmapT :: (forall b. Data b => b -> b) -> DData -> DData
$cgmapT :: (forall b. Data b => b -> b) -> DData -> DData
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DData)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DData)
dataTypeOf :: DData -> DataType
$cdataTypeOf :: DData -> DataType
toConstr :: DData -> Constr
$ctoConstr :: DData -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DData
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DData -> c DData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DData -> c DData
$cp1Data :: Typeable DData
Data, Typeable)
instance Serialize DData
instance Binary DData

data DConstructor =
  DConstructor String [(Maybe String, DTree)]
  | DSum DSimpleEnum
  deriving ((forall x. DConstructor -> Rep DConstructor x)
-> (forall x. Rep DConstructor x -> DConstructor)
-> Generic DConstructor
forall x. Rep DConstructor x -> DConstructor
forall x. DConstructor -> Rep DConstructor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DConstructor x -> DConstructor
$cfrom :: forall x. DConstructor -> Rep DConstructor x
Generic, Int -> DConstructor -> ShowS
[DConstructor] -> ShowS
DConstructor -> String
(Int -> DConstructor -> ShowS)
-> (DConstructor -> String)
-> ([DConstructor] -> ShowS)
-> Show DConstructor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DConstructor] -> ShowS
$cshowList :: [DConstructor] -> ShowS
show :: DConstructor -> String
$cshow :: DConstructor -> String
showsPrec :: Int -> DConstructor -> ShowS
$cshowsPrec :: Int -> DConstructor -> ShowS
Show, DConstructor -> DConstructor -> Bool
(DConstructor -> DConstructor -> Bool)
-> (DConstructor -> DConstructor -> Bool) -> Eq DConstructor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DConstructor -> DConstructor -> Bool
$c/= :: DConstructor -> DConstructor -> Bool
== :: DConstructor -> DConstructor -> Bool
$c== :: DConstructor -> DConstructor -> Bool
Eq, Eq DConstructor
Eq DConstructor
-> (DConstructor -> DConstructor -> Ordering)
-> (DConstructor -> DConstructor -> Bool)
-> (DConstructor -> DConstructor -> Bool)
-> (DConstructor -> DConstructor -> Bool)
-> (DConstructor -> DConstructor -> Bool)
-> (DConstructor -> DConstructor -> DConstructor)
-> (DConstructor -> DConstructor -> DConstructor)
-> Ord DConstructor
DConstructor -> DConstructor -> Bool
DConstructor -> DConstructor -> Ordering
DConstructor -> DConstructor -> DConstructor
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 :: DConstructor -> DConstructor -> DConstructor
$cmin :: DConstructor -> DConstructor -> DConstructor
max :: DConstructor -> DConstructor -> DConstructor
$cmax :: DConstructor -> DConstructor -> DConstructor
>= :: DConstructor -> DConstructor -> Bool
$c>= :: DConstructor -> DConstructor -> Bool
> :: DConstructor -> DConstructor -> Bool
$c> :: DConstructor -> DConstructor -> Bool
<= :: DConstructor -> DConstructor -> Bool
$c<= :: DConstructor -> DConstructor -> Bool
< :: DConstructor -> DConstructor -> Bool
$c< :: DConstructor -> DConstructor -> Bool
compare :: DConstructor -> DConstructor -> Ordering
$ccompare :: DConstructor -> DConstructor -> Ordering
$cp1Ord :: Eq DConstructor
Ord, Typeable DConstructor
DataType
Constr
Typeable DConstructor
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DConstructor -> c DConstructor)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DConstructor)
-> (DConstructor -> Constr)
-> (DConstructor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DConstructor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DConstructor))
-> ((forall b. Data b => b -> b) -> DConstructor -> DConstructor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DConstructor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DConstructor -> r)
-> (forall u. (forall d. Data d => d -> u) -> DConstructor -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DConstructor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DConstructor -> m DConstructor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DConstructor -> m DConstructor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DConstructor -> m DConstructor)
-> Data DConstructor
DConstructor -> DataType
DConstructor -> Constr
(forall b. Data b => b -> b) -> DConstructor -> DConstructor
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DConstructor -> c DConstructor
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DConstructor
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DConstructor -> u
forall u. (forall d. Data d => d -> u) -> DConstructor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DConstructor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DConstructor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DConstructor -> m DConstructor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DConstructor -> m DConstructor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DConstructor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DConstructor -> c DConstructor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DConstructor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DConstructor)
$cDSum :: Constr
$cDConstructor :: Constr
$tDConstructor :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DConstructor -> m DConstructor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DConstructor -> m DConstructor
gmapMp :: (forall d. Data d => d -> m d) -> DConstructor -> m DConstructor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DConstructor -> m DConstructor
gmapM :: (forall d. Data d => d -> m d) -> DConstructor -> m DConstructor
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DConstructor -> m DConstructor
gmapQi :: Int -> (forall d. Data d => d -> u) -> DConstructor -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DConstructor -> u
gmapQ :: (forall d. Data d => d -> u) -> DConstructor -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DConstructor -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DConstructor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DConstructor -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DConstructor -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DConstructor -> r
gmapT :: (forall b. Data b => b -> b) -> DConstructor -> DConstructor
$cgmapT :: (forall b. Data b => b -> b) -> DConstructor -> DConstructor
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DConstructor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DConstructor)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DConstructor)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DConstructor)
dataTypeOf :: DConstructor -> DataType
$cdataTypeOf :: DConstructor -> DataType
toConstr :: DConstructor -> Constr
$ctoConstr :: DConstructor -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DConstructor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DConstructor
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DConstructor -> c DConstructor
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DConstructor -> c DConstructor
$cp1Data :: Typeable DConstructor
Data, Typeable)
instance Serialize DConstructor
instance Binary DConstructor

data DSimpleEnum = DSimpleEnum [String] Int
                 deriving ((forall x. DSimpleEnum -> Rep DSimpleEnum x)
-> (forall x. Rep DSimpleEnum x -> DSimpleEnum)
-> Generic DSimpleEnum
forall x. Rep DSimpleEnum x -> DSimpleEnum
forall x. DSimpleEnum -> Rep DSimpleEnum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DSimpleEnum x -> DSimpleEnum
$cfrom :: forall x. DSimpleEnum -> Rep DSimpleEnum x
Generic, Int -> DSimpleEnum -> ShowS
[DSimpleEnum] -> ShowS
DSimpleEnum -> String
(Int -> DSimpleEnum -> ShowS)
-> (DSimpleEnum -> String)
-> ([DSimpleEnum] -> ShowS)
-> Show DSimpleEnum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DSimpleEnum] -> ShowS
$cshowList :: [DSimpleEnum] -> ShowS
show :: DSimpleEnum -> String
$cshow :: DSimpleEnum -> String
showsPrec :: Int -> DSimpleEnum -> ShowS
$cshowsPrec :: Int -> DSimpleEnum -> ShowS
Show, DSimpleEnum -> DSimpleEnum -> Bool
(DSimpleEnum -> DSimpleEnum -> Bool)
-> (DSimpleEnum -> DSimpleEnum -> Bool) -> Eq DSimpleEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DSimpleEnum -> DSimpleEnum -> Bool
$c/= :: DSimpleEnum -> DSimpleEnum -> Bool
== :: DSimpleEnum -> DSimpleEnum -> Bool
$c== :: DSimpleEnum -> DSimpleEnum -> Bool
Eq, Eq DSimpleEnum
Eq DSimpleEnum
-> (DSimpleEnum -> DSimpleEnum -> Ordering)
-> (DSimpleEnum -> DSimpleEnum -> Bool)
-> (DSimpleEnum -> DSimpleEnum -> Bool)
-> (DSimpleEnum -> DSimpleEnum -> Bool)
-> (DSimpleEnum -> DSimpleEnum -> Bool)
-> (DSimpleEnum -> DSimpleEnum -> DSimpleEnum)
-> (DSimpleEnum -> DSimpleEnum -> DSimpleEnum)
-> Ord DSimpleEnum
DSimpleEnum -> DSimpleEnum -> Bool
DSimpleEnum -> DSimpleEnum -> Ordering
DSimpleEnum -> DSimpleEnum -> DSimpleEnum
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 :: DSimpleEnum -> DSimpleEnum -> DSimpleEnum
$cmin :: DSimpleEnum -> DSimpleEnum -> DSimpleEnum
max :: DSimpleEnum -> DSimpleEnum -> DSimpleEnum
$cmax :: DSimpleEnum -> DSimpleEnum -> DSimpleEnum
>= :: DSimpleEnum -> DSimpleEnum -> Bool
$c>= :: DSimpleEnum -> DSimpleEnum -> Bool
> :: DSimpleEnum -> DSimpleEnum -> Bool
$c> :: DSimpleEnum -> DSimpleEnum -> Bool
<= :: DSimpleEnum -> DSimpleEnum -> Bool
$c<= :: DSimpleEnum -> DSimpleEnum -> Bool
< :: DSimpleEnum -> DSimpleEnum -> Bool
$c< :: DSimpleEnum -> DSimpleEnum -> Bool
compare :: DSimpleEnum -> DSimpleEnum -> Ordering
$ccompare :: DSimpleEnum -> DSimpleEnum -> Ordering
$cp1Ord :: Eq DSimpleEnum
Ord, Typeable DSimpleEnum
DataType
Constr
Typeable DSimpleEnum
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DSimpleEnum -> c DSimpleEnum)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DSimpleEnum)
-> (DSimpleEnum -> Constr)
-> (DSimpleEnum -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DSimpleEnum))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DSimpleEnum))
-> ((forall b. Data b => b -> b) -> DSimpleEnum -> DSimpleEnum)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DSimpleEnum -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DSimpleEnum -> r)
-> (forall u. (forall d. Data d => d -> u) -> DSimpleEnum -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DSimpleEnum -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum)
-> Data DSimpleEnum
DSimpleEnum -> DataType
DSimpleEnum -> Constr
(forall b. Data b => b -> b) -> DSimpleEnum -> DSimpleEnum
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DSimpleEnum -> c DSimpleEnum
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DSimpleEnum
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DSimpleEnum -> u
forall u. (forall d. Data d => d -> u) -> DSimpleEnum -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DSimpleEnum -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DSimpleEnum -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DSimpleEnum
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DSimpleEnum -> c DSimpleEnum
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DSimpleEnum)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DSimpleEnum)
$cDSimpleEnum :: Constr
$tDSimpleEnum :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum
gmapMp :: (forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum
gmapM :: (forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DSimpleEnum -> m DSimpleEnum
gmapQi :: Int -> (forall d. Data d => d -> u) -> DSimpleEnum -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DSimpleEnum -> u
gmapQ :: (forall d. Data d => d -> u) -> DSimpleEnum -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DSimpleEnum -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DSimpleEnum -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DSimpleEnum -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DSimpleEnum -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DSimpleEnum -> r
gmapT :: (forall b. Data b => b -> b) -> DSimpleEnum -> DSimpleEnum
$cgmapT :: (forall b. Data b => b -> b) -> DSimpleEnum -> DSimpleEnum
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DSimpleEnum)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DSimpleEnum)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DSimpleEnum)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DSimpleEnum)
dataTypeOf :: DSimpleEnum -> DataType
$cdataTypeOf :: DSimpleEnum -> DataType
toConstr :: DSimpleEnum -> Constr
$ctoConstr :: DSimpleEnum -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DSimpleEnum
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DSimpleEnum
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DSimpleEnum -> c DSimpleEnum
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DSimpleEnum -> c DSimpleEnum
$cp1Data :: Typeable DSimpleEnum
Data, Typeable)
instance Serialize DSimpleEnum
instance Binary DSimpleEnum

-- | a dynamic field
data DField =
  DDouble Double
  | DFloat Float
  | DInt8 Int8
  | DInt16 Int16
  | DInt32 Int32
  | DInt64 Int64
  | DWord8 Word8
  | DWord16 Word16
  | DWord32 Word32
  | DWord64 Word64
  | DString String
  | DUnit
  | DSorry
  deriving ((forall x. DField -> Rep DField x)
-> (forall x. Rep DField x -> DField) -> Generic DField
forall x. Rep DField x -> DField
forall x. DField -> Rep DField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DField x -> DField
$cfrom :: forall x. DField -> Rep DField x
Generic, Int -> DField -> ShowS
[DField] -> ShowS
DField -> String
(Int -> DField -> ShowS)
-> (DField -> String) -> ([DField] -> ShowS) -> Show DField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DField] -> ShowS
$cshowList :: [DField] -> ShowS
show :: DField -> String
$cshow :: DField -> String
showsPrec :: Int -> DField -> ShowS
$cshowsPrec :: Int -> DField -> ShowS
Show, DField -> DField -> Bool
(DField -> DField -> Bool)
-> (DField -> DField -> Bool) -> Eq DField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DField -> DField -> Bool
$c/= :: DField -> DField -> Bool
== :: DField -> DField -> Bool
$c== :: DField -> DField -> Bool
Eq, Eq DField
Eq DField
-> (DField -> DField -> Ordering)
-> (DField -> DField -> Bool)
-> (DField -> DField -> Bool)
-> (DField -> DField -> Bool)
-> (DField -> DField -> Bool)
-> (DField -> DField -> DField)
-> (DField -> DField -> DField)
-> Ord DField
DField -> DField -> Bool
DField -> DField -> Ordering
DField -> DField -> DField
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 :: DField -> DField -> DField
$cmin :: DField -> DField -> DField
max :: DField -> DField -> DField
$cmax :: DField -> DField -> DField
>= :: DField -> DField -> Bool
$c>= :: DField -> DField -> Bool
> :: DField -> DField -> Bool
$c> :: DField -> DField -> Bool
<= :: DField -> DField -> Bool
$c<= :: DField -> DField -> Bool
< :: DField -> DField -> Bool
$c< :: DField -> DField -> Bool
compare :: DField -> DField -> Ordering
$ccompare :: DField -> DField -> Ordering
$cp1Ord :: Eq DField
Ord, Typeable DField
DataType
Constr
Typeable DField
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DField -> c DField)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DField)
-> (DField -> Constr)
-> (DField -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DField))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DField))
-> ((forall b. Data b => b -> b) -> DField -> DField)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DField -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DField -> r)
-> (forall u. (forall d. Data d => d -> u) -> DField -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DField -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DField -> m DField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DField -> m DField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DField -> m DField)
-> Data DField
DField -> DataType
DField -> Constr
(forall b. Data b => b -> b) -> DField -> DField
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DField -> c DField
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DField
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DField -> u
forall u. (forall d. Data d => d -> u) -> DField -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DField -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DField -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DField -> m DField
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DField -> m DField
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DField
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DField -> c DField
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DField)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DField)
$cDSorry :: Constr
$cDUnit :: Constr
$cDString :: Constr
$cDWord64 :: Constr
$cDWord32 :: Constr
$cDWord16 :: Constr
$cDWord8 :: Constr
$cDInt64 :: Constr
$cDInt32 :: Constr
$cDInt16 :: Constr
$cDInt8 :: Constr
$cDFloat :: Constr
$cDDouble :: Constr
$tDField :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DField -> m DField
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DField -> m DField
gmapMp :: (forall d. Data d => d -> m d) -> DField -> m DField
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DField -> m DField
gmapM :: (forall d. Data d => d -> m d) -> DField -> m DField
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DField -> m DField
gmapQi :: Int -> (forall d. Data d => d -> u) -> DField -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DField -> u
gmapQ :: (forall d. Data d => d -> u) -> DField -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DField -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DField -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DField -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DField -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DField -> r
gmapT :: (forall b. Data b => b -> b) -> DField -> DField
$cgmapT :: (forall b. Data b => b -> b) -> DField -> DField
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DField)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DField)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DField)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DField)
dataTypeOf :: DField -> DataType
$cdataTypeOf :: DField -> DataType
toConstr :: DField -> Constr
$ctoConstr :: DField -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DField
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DField
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DField -> c DField
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DField -> c DField
$cp1Data :: Typeable DField
Data, Typeable)
instance Serialize DField
instance Binary DField

-- | Get the constructor string or an error message.
denumToString :: DSimpleEnum -> Either String String
denumToString :: DSimpleEnum -> Either String String
denumToString (DSimpleEnum [String]
_ Int
k)
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"denumToString: index %d is negative" Int
k
denumToString (DSimpleEnum [String]
constructors Int
k) = [String] -> Int -> Either String String
forall t a b. (Eq t, Num t, PrintfType a) => [b] -> t -> Either a b
safeIndex [String]
constructors Int
k
  where
    safeIndex :: [b] -> t -> Either a b
safeIndex (b
x:[b]
_) t
0 = b -> Either a b
forall a b. b -> Either a b
Right b
x
    safeIndex (b
_:[b]
xs) t
j = [b] -> t -> Either a b
safeIndex [b]
xs (t
jt -> t -> t
forall a. Num a => a -> a -> a
-t
1)
    safeIndex [] t
_ =
      a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$
      String -> Int -> Int -> a
forall r. PrintfType r => String -> r
printf String
"denumToString: index %d is too large (%d constructors)" Int
k ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
constructors)

-- | Get the constructor string or an error message without telling which is which.
denumToStringOrMsg :: DSimpleEnum -> String
denumToStringOrMsg :: DSimpleEnum -> String
denumToStringOrMsg DSimpleEnum
d = case DSimpleEnum -> Either String String
denumToString DSimpleEnum
d of
  Left String
msg -> String
msg
  Right String
r -> String
r

-- | Try to update an enum with its constructor. Fail if not a valid constructor.
denumSetString :: DSimpleEnum -> String -> Either String DSimpleEnum
denumSetString :: DSimpleEnum -> String -> Either String DSimpleEnum
denumSetString (DSimpleEnum [String]
options Int
_) String
txt = [String] -> Int -> Either String DSimpleEnum
forall a. PrintfType a => [String] -> Int -> Either a DSimpleEnum
safeLookup [String]
options Int
0
  where
    safeLookup :: [String] -> Int -> Either a DSimpleEnum
safeLookup (String
opt:[String]
opts) Int
k
      | String
opt String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
txt = DSimpleEnum -> Either a DSimpleEnum
forall a b. b -> Either a b
Right ([String] -> Int -> DSimpleEnum
DSimpleEnum [String]
options Int
k)
      | Bool
otherwise = [String] -> Int -> Either a DSimpleEnum
safeLookup [String]
opts (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    safeLookup [] Int
_ = a -> Either a DSimpleEnum
forall a b. a -> Either a b
Left (a -> Either a DSimpleEnum) -> a -> Either a DSimpleEnum
forall a b. (a -> b) -> a -> b
$ String -> String -> a
forall r. PrintfType r => String -> r
printf String
"denumSetString: %s is not a valid constructor" String
txt

-- | Try to update an enum with its index. Fail if out of bounds.
denumSetIndex :: DSimpleEnum -> Int -> Either String DSimpleEnum
denumSetIndex :: DSimpleEnum -> Int -> Either String DSimpleEnum
denumSetIndex (DSimpleEnum [String]
constructors Int
_) Int
k
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Either String DSimpleEnum
forall a b. a -> Either a b
Left (String -> Either String DSimpleEnum)
-> String -> Either String DSimpleEnum
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"denumSetIndex: index %d is negative" Int
k
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
constructors =
      String -> Either String DSimpleEnum
forall a b. a -> Either a b
Left (String -> Either String DSimpleEnum)
-> String -> Either String DSimpleEnum
forall a b. (a -> b) -> a -> b
$
      String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"denumSetIndex: index %d is too large (%d constructors)" Int
k ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
constructors)
  | Bool
otherwise = DSimpleEnum -> Either String DSimpleEnum
forall a b. b -> Either a b
Right (DSimpleEnum -> Either String DSimpleEnum)
-> DSimpleEnum -> Either String DSimpleEnum
forall a b. (a -> b) -> a -> b
$ [String] -> Int -> DSimpleEnum
DSimpleEnum [String]
constructors Int
k

-- | Returns True if the __type__ of fields is the same.
sameDFieldType :: DField -> DField -> Bool
sameDFieldType :: DField -> DField -> Bool
sameDFieldType (DDouble Double
_) (DDouble Double
_) = Bool
True
sameDFieldType (DFloat Float
_) (DFloat Float
_)   = Bool
True
sameDFieldType (DInt8 Int8
_) (DInt8 Int8
_)     = Bool
True
sameDFieldType (DInt16 Int16
_) (DInt16 Int16
_)   = Bool
True
sameDFieldType (DInt32 Int32
_) (DInt32 Int32
_)   = Bool
True
sameDFieldType (DInt64 Int64
_) (DInt64 Int64
_)   = Bool
True
sameDFieldType (DWord8 Word8
_) (DWord8 Word8
_)   = Bool
True
sameDFieldType (DWord16 Word16
_) (DWord16 Word16
_) = Bool
True
sameDFieldType (DWord32 Word32
_) (DWord32 Word32
_) = Bool
True
sameDFieldType (DWord64 Word64
_) (DWord64 Word64
_) = Bool
True
sameDFieldType (DString String
_) (DString String
_) = Bool
True
sameDFieldType DField
DUnit DField
DUnit             = Bool
True
sameDFieldType DField
DSorry DField
DSorry           = Bool
True
sameDFieldType (DDouble Double
_) DField
_           = Bool
False
sameDFieldType (DFloat Float
_)  DField
_           = Bool
False
sameDFieldType (DInt8 Int8
_)   DField
_           = Bool
False
sameDFieldType (DInt16 Int16
_)  DField
_           = Bool
False
sameDFieldType (DInt32 Int32
_)  DField
_           = Bool
False
sameDFieldType (DInt64 Int64
_)  DField
_           = Bool
False
sameDFieldType (DWord8 Word8
_)  DField
_           = Bool
False
sameDFieldType (DWord16 Word16
_) DField
_           = Bool
False
sameDFieldType (DWord32 Word32
_) DField
_           = Bool
False
sameDFieldType (DWord64 Word64
_) DField
_           = Bool
False
sameDFieldType (DString String
_) DField
_           = Bool
False
sameDFieldType DField
DUnit       DField
_           = Bool
False
sameDFieldType DField
DSorry      DField
_           = Bool
False

describeDField :: DField -> String
describeDField :: DField -> String
describeDField (DInt8 Int8
_)   = String
"Int8"
describeDField (DInt16 Int16
_)  = String
"Int16"
describeDField (DInt32 Int32
_)  = String
"Int32"
describeDField (DInt64 Int64
_)  = String
"Int64"
describeDField (DWord8 Word8
_)  = String
"Word8"
describeDField (DWord16 Word16
_) = String
"Word16"
describeDField (DWord32 Word32
_) = String
"Word32"
describeDField (DWord64 Word64
_) = String
"Word64"
describeDField (DDouble Double
_) = String
"Double"
describeDField (DFloat Float
_)  = String
"Float"
describeDField (DString String
_) = String
"String"
describeDField DField
DUnit       = String
"()"
describeDField DField
DSorry      = String
"Sorry"

-- | convert to a dynamic value
toDData :: forall a . Lookup a => a -> DTree
toDData :: a -> DTree
toDData a
x = Either (GAField a) (GAData a) -> DTree
toDData' Either (GAField a) (GAData a)
forall a. Lookup a => AccessorTree a
accessors
  where
    toDData' :: Either (GAField a) (GAData a) -> DTree
    toDData' :: Either (GAField a) (GAData a) -> DTree
toDData' (Right (GAData String
dname GAConstructor a
constructor)) =
      DData -> DTree
forall a b. b -> Either a b
Right (DData -> DTree) -> DData -> DTree
forall a b. (a -> b) -> a -> b
$ String -> DConstructor -> DData
DData String
dname (GAConstructor a -> DConstructor
toDConstructor GAConstructor a
constructor)
    toDData' (Left GAField a
field) = DField -> DTree
forall a b. a -> Either a b
Left (GAField a -> DField
toDField GAField a
field)

    toDConstructor :: GAConstructor a -> DConstructor
    toDConstructor :: GAConstructor a -> DConstructor
toDConstructor (GASum GASimpleEnum a
e) =
      DSimpleEnum -> DConstructor
DSum ([String] -> Int -> DSimpleEnum
DSimpleEnum (GASimpleEnum a -> [String]
forall a. GASimpleEnum a -> [String]
eConstructors GASimpleEnum a
e) (GASimpleEnum a -> a -> Int
forall a. GASimpleEnum a -> a -> Int
eToIndex GASimpleEnum a
e a
x))

    toDConstructor (GAConstructor String
cname [(Maybe String, Either (GAField a) (GAData a))]
fields) =
      String -> [(Maybe String, DTree)] -> DConstructor
DConstructor String
cname ([(Maybe String, DTree)] -> DConstructor)
-> [(Maybe String, DTree)] -> DConstructor
forall a b. (a -> b) -> a -> b
$ ((Maybe String, Either (GAField a) (GAData a))
 -> (Maybe String, DTree))
-> [(Maybe String, Either (GAField a) (GAData a))]
-> [(Maybe String, DTree)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Maybe String
n, Either (GAField a) (GAData a)
f) -> (Maybe String
n, Either (GAField a) (GAData a) -> DTree
toDData' Either (GAField a) (GAData a)
f)) [(Maybe String, Either (GAField a) (GAData a))]
fields

    toDField :: GAField a -> DField
    toDField :: GAField a -> DField
toDField (FieldDouble Lens' a Double
f) = Double -> DField
DDouble (a
x a -> Getting Double a Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double a Double
Lens' a Double
f)
    toDField (FieldFloat Lens' a Float
f)  = Float -> DField
DFloat (a
x a -> Getting Float a Float -> Float
forall s a. s -> Getting a s a -> a
^. Getting Float a Float
Lens' a Float
f)
    toDField (FieldInt8 Lens' a Int8
f)   = Int8 -> DField
DInt8 (a
x a -> Getting Int8 a Int8 -> Int8
forall s a. s -> Getting a s a -> a
^. Getting Int8 a Int8
Lens' a Int8
f)
    toDField (FieldInt16 Lens' a Int16
f)  = Int16 -> DField
DInt16 (a
x a -> Getting Int16 a Int16 -> Int16
forall s a. s -> Getting a s a -> a
^. Getting Int16 a Int16
Lens' a Int16
f)
    toDField (FieldInt32 Lens' a Int32
f)  = Int32 -> DField
DInt32 (a
x a -> Getting Int32 a Int32 -> Int32
forall s a. s -> Getting a s a -> a
^. Getting Int32 a Int32
Lens' a Int32
f)
    toDField (FieldInt64 Lens' a Int64
f)  = Int64 -> DField
DInt64 (a
x a -> Getting Int64 a Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 a Int64
Lens' a Int64
f)
    toDField (FieldWord8 Lens' a Word8
f)  = Word8 -> DField
DWord8 (a
x a -> Getting Word8 a Word8 -> Word8
forall s a. s -> Getting a s a -> a
^. Getting Word8 a Word8
Lens' a Word8
f)
    toDField (FieldWord16 Lens' a Word16
f) = Word16 -> DField
DWord16 (a
x a -> Getting Word16 a Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. Getting Word16 a Word16
Lens' a Word16
f)
    toDField (FieldWord32 Lens' a Word32
f) = Word32 -> DField
DWord32 (a
x a -> Getting Word32 a Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 a Word32
Lens' a Word32
f)
    toDField (FieldWord64 Lens' a Word64
f) = Word64 -> DField
DWord64 (a
x a -> Getting Word64 a Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 a Word64
Lens' a Word64
f)
    toDField (FieldString Lens' a String
f) = String -> DField
DString (a
x a -> Getting String a String -> String
forall s a. s -> Getting a s a -> a
^. Getting String a String
Lens' a String
f)
    toDField GAField a
FieldUnit       = DField
DUnit
    toDField GAField a
FieldSorry      = DField
DSorry


-- | Update something using a dynamic representation
updateLookupable :: Lookup a => a -> DTree -> Either String a
updateLookupable :: a -> DTree -> Either String a
updateLookupable a
x0 DTree
dtree = a -> Either (GAField a) (GAData a) -> DTree -> Either String a
forall a.
a -> Either (GAField a) (GAData a) -> DTree -> Either String a
updateData a
x0 Either (GAField a) (GAData a)
forall a. Lookup a => AccessorTree a
accessors DTree
dtree

updateData :: forall a
                     . a
                     -> Either (GAField a) (GAData a)
                     -> DTree
                     -> Either String a
updateData :: a -> Either (GAField a) (GAData a) -> DTree -> Either String a
updateData a
x0 (Left GAField a
afield) (Left DField
dfield) = a -> GAField a -> DField -> Either String a
forall a. a -> GAField a -> DField -> Either String a
updateField a
x0 GAField a
afield DField
dfield
updateData a
x0 (Right (GAData String
adataName GAConstructor a
acon)) (Right (DData String
ddataName DConstructor
dcon))
  | String
adataName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
ddataName =
      String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$
      String
"dynamic datatype name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
ddataName String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
" don't match accessor datatype names " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
adataName
  | Bool
otherwise = a -> GAConstructor a -> DConstructor -> Either String a
forall a. a -> GAConstructor a -> DConstructor -> Either String a
updateConstructor a
x0 GAConstructor a
acon DConstructor
dcon
updateData a
_ (Left GAField a
field) (Right (DData String
n DConstructor
_)) =
  String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"got GAField (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ GAField a -> String
forall a. GAField a -> String
describeGAField GAField a
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") for accessor tree but DData (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") for dynamic tree"
updateData a
_ (Right (GAData String
n GAConstructor a
_)) (Left DField
field) =
  String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"got GAData for accessor tree (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") but DField (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DField -> String
describeDField DField
fieldString -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") for dynamic tree"

showList' :: [String] -> String
showList' :: [String] -> String
showList' [String]
xs = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

updateConstructor :: forall a
                     . a
                     -> GAConstructor a
                     -> DConstructor
                     -> Either String a
updateConstructor :: a -> GAConstructor a -> DConstructor -> Either String a
updateConstructor a
x (GASum GASimpleEnum a
aenum) (DSum (DSimpleEnum [String]
dnames Int
k))
  | [String]
anames [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String]
dnames =
      String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$
      String
"accessor sum options " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showList' [String]
anames String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
" doesn't match dynamic sum options " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showList' [String]
dnames
  | Bool
otherwise = GASimpleEnum a -> a -> Int -> Either String a
forall a. GASimpleEnum a -> a -> Int -> Either String a
eFromIndex GASimpleEnum a
aenum a
x Int
k
  where
    anames :: [String]
anames = GASimpleEnum a -> [String]
forall a. GASimpleEnum a -> [String]
eConstructors GASimpleEnum a
aenum
updateConstructor a
x0 (GAConstructor String
aconName [(Maybe String, AccessorTree a)]
afields) (DConstructor String
dconName [(Maybe String, DTree)]
dfields)
  | String
aconName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
dconName =
      String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$
      String
"dynamic constructor name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
dconName String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
" don't match accessor constructor names " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
aconName
  | [(Maybe String, AccessorTree a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe String, AccessorTree a)]
afields Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [(Maybe String, DTree)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe String, DTree)]
dfields = Either String a
forall b. Either String b
lengthMismatch
  | Bool
otherwise = a
-> [(Maybe String, AccessorTree a)]
-> [(Maybe String, DTree)]
-> Either String a
f a
x0 [(Maybe String, AccessorTree a)]
afields [(Maybe String, DTree)]
dfields
    where
      lengthMismatch :: Either String b
lengthMismatch =
        String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$
        String
"dynamic fields have different length than accessor fields\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
"dynamic fields: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Maybe String] -> String
forall a. Show a => a -> String
show (((Maybe String, DTree) -> Maybe String)
-> [(Maybe String, DTree)] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe String, DTree) -> Maybe String
forall a b. (a, b) -> a
fst [(Maybe String, DTree)]
dfields) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
"accessor fields: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Maybe String] -> String
forall a. Show a => a -> String
show (((Maybe String, AccessorTree a) -> Maybe String)
-> [(Maybe String, AccessorTree a)] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe String, AccessorTree a) -> Maybe String
forall a b. (a, b) -> a
fst [(Maybe String, AccessorTree a)]
afields)

      f :: a
           -> [(Maybe String, Either (GAField a) (GAData a))]
           -> [(Maybe String, DTree)]
           -> Either String a
      f :: a
-> [(Maybe String, AccessorTree a)]
-> [(Maybe String, DTree)]
-> Either String a
f a
x ((Maybe String
aname, AccessorTree a
afield):[(Maybe String, AccessorTree a)]
as) ((Maybe String
dname, DTree
dfield):[(Maybe String, DTree)]
ds)
        | Maybe String
aname Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
dname =
            String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$
            String
"accessor selector name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
aname String -> ShowS
forall a. [a] -> [a] -> [a]
++
            String
" doesn't match dynamic selector name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
dname
        | Bool
otherwise = case a -> AccessorTree a -> DTree -> Either String a
forall a.
a -> Either (GAField a) (GAData a) -> DTree -> Either String a
updateData a
x AccessorTree a
afield DTree
dfield of
            Left String
msg -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"error updating selector " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
aname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
            Right a
r -> a
-> [(Maybe String, AccessorTree a)]
-> [(Maybe String, DTree)]
-> Either String a
f a
r [(Maybe String, AccessorTree a)]
as [(Maybe String, DTree)]
ds
      f a
x [] [] = a -> Either String a
forall a b. b -> Either a b
Right a
x
      -- this should never happen:
      f a
_ [(Maybe String, AccessorTree a)]
_ [(Maybe String, DTree)]
_ = Either String a
forall b. Either String b
lengthMismatch
updateConstructor a
_ (GAConstructor String
aconName [(Maybe String, AccessorTree a)]
_) (DSum (DSimpleEnum [String]
dnames Int
_)) =
  String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"got GAConstructor (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
aconName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") but DSum ([" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showList' [String]
dnames String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"])"
updateConstructor a
_ (GASum GASimpleEnum a
aenum) (DConstructor String
dconName [(Maybe String, DTree)]
_) =
  String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"got GASum ([" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showList' (GASimpleEnum a -> [String]
forall a. GASimpleEnum a -> [String]
eConstructors GASimpleEnum a
aenum) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]) but DConstructor (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dconName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"


updateField :: a -> GAField a -> DField -> Either String a
updateField :: a -> GAField a -> DField -> Either String a
updateField a
x0 (FieldDouble Lens' a Double
f) (DDouble Double
x) = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Double -> Identity Double) -> a -> Identity a
Lens' a Double
f ((Double -> Identity Double) -> a -> Identity a)
-> Double -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
x) a
x0
updateField a
x0 (FieldFloat Lens' a Float
f) (DFloat Float
x)   = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Float -> Identity Float) -> a -> Identity a
Lens' a Float
f ((Float -> Identity Float) -> a -> Identity a) -> Float -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Float
x) a
x0
updateField a
x0 (FieldInt8 Lens' a Int8
f) (DInt8 Int8
x)     = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Int8 -> Identity Int8) -> a -> Identity a
Lens' a Int8
f ((Int8 -> Identity Int8) -> a -> Identity a) -> Int8 -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int8
x) a
x0
updateField a
x0 (FieldInt16 Lens' a Int16
f) (DInt16 Int16
x)   = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Int16 -> Identity Int16) -> a -> Identity a
Lens' a Int16
f ((Int16 -> Identity Int16) -> a -> Identity a) -> Int16 -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int16
x) a
x0
updateField a
x0 (FieldInt32 Lens' a Int32
f) (DInt32 Int32
x)   = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Int32 -> Identity Int32) -> a -> Identity a
Lens' a Int32
f ((Int32 -> Identity Int32) -> a -> Identity a) -> Int32 -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int32
x) a
x0
updateField a
x0 (FieldInt64 Lens' a Int64
f) (DInt64 Int64
x)   = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Int64 -> Identity Int64) -> a -> Identity a
Lens' a Int64
f ((Int64 -> Identity Int64) -> a -> Identity a) -> Int64 -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int64
x) a
x0
updateField a
x0 (FieldWord8 Lens' a Word8
f) (DWord8 Word8
x)   = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Word8 -> Identity Word8) -> a -> Identity a
Lens' a Word8
f ((Word8 -> Identity Word8) -> a -> Identity a) -> Word8 -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word8
x) a
x0
updateField a
x0 (FieldWord16 Lens' a Word16
f) (DWord16 Word16
x) = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Word16 -> Identity Word16) -> a -> Identity a
Lens' a Word16
f ((Word16 -> Identity Word16) -> a -> Identity a)
-> Word16 -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
x) a
x0
updateField a
x0 (FieldWord32 Lens' a Word32
f) (DWord32 Word32
x) = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Word32 -> Identity Word32) -> a -> Identity a
Lens' a Word32
f ((Word32 -> Identity Word32) -> a -> Identity a)
-> Word32 -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
x) a
x0
updateField a
x0 (FieldWord64 Lens' a Word64
f) (DWord64 Word64
x) = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((Word64 -> Identity Word64) -> a -> Identity a
Lens' a Word64
f ((Word64 -> Identity Word64) -> a -> Identity a)
-> Word64 -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
x) a
x0
updateField a
x0 (FieldString Lens' a String
f) (DString String
x) = a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ ((String -> Identity String) -> a -> Identity a
Lens' a String
f ((String -> Identity String) -> a -> Identity a)
-> String -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
x) a
x0
updateField a
x0 GAField a
FieldUnit DField
_                 = a -> Either String a
forall a b. b -> Either a b
Right a
x0
updateField a
x0 GAField a
FieldSorry DField
_                = a -> Either String a
forall a b. b -> Either a b
Right a
x0
updateField a
_ f :: GAField a
f@(FieldDouble Lens' a Double
_) DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldFloat Lens' a Float
_)  DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldInt8 Lens' a Int8
_)   DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldInt16 Lens' a Int16
_)  DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldInt32 Lens' a Int32
_)  DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldInt64 Lens' a Int64
_)  DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldWord8 Lens' a Word8
_)  DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldWord16 Lens' a Word16
_) DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldWord32 Lens' a Word32
_) DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldWord64 Lens' a Word64
_) DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)
updateField a
_ f :: GAField a
f@(FieldString Lens' a String
_) DField
d          = String -> Either String a
forall a b. a -> Either a b
Left (GAField a -> DField -> String
forall a. GAField a -> DField -> String
fieldMismatch GAField a
f DField
d)

fieldMismatch :: GAField a -> DField -> String
fieldMismatch :: GAField a -> DField -> String
fieldMismatch GAField a
f DField
d =
  String
"accessor GAField " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GAField a -> String
forall a. GAField a -> String
describeGAField GAField a
f String -> ShowS
forall a. [a] -> [a] -> [a]
++
  String
" got incompatible dynamic DField " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DField -> String
describeDField DField
d


diffDTrees :: String -> DTree -> DTree -> [String]
diffDTrees :: String -> DTree -> DTree -> [String]
diffDTrees String
rootName = [String] -> DTree -> DTree -> [String]
diffDTrees' [String
rootName]

showName :: [String] -> String
showName :: [String] -> String
showName = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse

diffDTrees' :: [String] -> DTree -> DTree -> [String]
diffDTrees' :: [String] -> DTree -> DTree -> [String]
diffDTrees' [String]
name (Left DField
x) (Left DField
y) = case [String] -> DField -> DField -> Maybe String
diffDFields [String]
name DField
x DField
y of
  Maybe String
Nothing -> []
  Just String
r -> [String
r]
diffDTrees' [String]
name (Right DData
x) (Right DData
y) = [String] -> DData -> DData -> [String]
diffDData [String]
name DData
x DData
y
diffDTrees' [String]
name DTree
_ DTree
_ = [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" have different types"]

diffDFields :: [String] -> DField -> DField -> Maybe String
diffDFields :: [String] -> DField -> DField -> Maybe String
diffDFields [String]
name (DDouble Double
x) (DDouble Double
y)       = [String] -> Double -> Double -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Double
x Double
y
diffDFields [String]
name (DFloat  Float
x) (DFloat  Float
y)       = [String] -> Float -> Float -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Float
x Float
y
diffDFields [String]
name (DInt8    Int8
x) (DInt8    Int8
y)     = [String] -> Int8 -> Int8 -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Int8
x Int8
y
diffDFields [String]
name (DInt16    Int16
x) (DInt16    Int16
y)   = [String] -> Int16 -> Int16 -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Int16
x Int16
y
diffDFields [String]
name (DInt32    Int32
x) (DInt32    Int32
y)   = [String] -> Int32 -> Int32 -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Int32
x Int32
y
diffDFields [String]
name (DInt64    Int64
x) (DInt64    Int64
y)   = [String] -> Int64 -> Int64 -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Int64
x Int64
y
diffDFields [String]
name (DWord8    Word8
x) (DWord8    Word8
y)   = [String] -> Word8 -> Word8 -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Word8
x Word8
y
diffDFields [String]
name (DWord16    Word16
x) (DWord16    Word16
y) = [String] -> Word16 -> Word16 -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Word16
x Word16
y
diffDFields [String]
name (DWord32    Word32
x) (DWord32    Word32
y) = [String] -> Word32 -> Word32 -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Word32
x Word32
y
diffDFields [String]
name (DWord64    Word64
x) (DWord64    Word64
y) = [String] -> Word64 -> Word64 -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name Word64
x Word64
y
diffDFields [String]
name (DString String
x) (DString String
y)       = [String] -> String -> String -> Maybe String
forall a. (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq [String]
name String
x String
y
diffDFields [String]
name DField
DSorry DField
DSorry                 = String -> Maybe String
forall a. a -> Maybe a
Just ([String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": can't diff this type")
diffDFields [String]
name DField
x DField
y
  | DField -> DField -> Bool
sameDFieldType DField
x DField
y = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ERROR! unhandled type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (DField, DField) -> String
forall a. Show a => a -> String
show (DField
x, DField
y)
  | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": has different types"

diffEq :: (Eq a, Show a) => [String] -> a -> a -> Maybe String
diffEq :: [String] -> a -> a -> Maybe String
diffEq [String]
name a
x a
y
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just ([String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)


data MaybeRecords
  = Record [(String, DTree)]
  | NoRecord [DTree]
  | Mixed
  | EmptyCon

toMaybeRecords :: [(Maybe String, DTree)] -> MaybeRecords
toMaybeRecords :: [(Maybe String, DTree)] -> MaybeRecords
toMaybeRecords [(Maybe String, DTree)]
xs = case [Either DTree (String, DTree)] -> ([DTree], [(String, DTree)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (((Maybe String, DTree) -> Either DTree (String, DTree))
-> [(Maybe String, DTree)] -> [Either DTree (String, DTree)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe String, DTree) -> Either DTree (String, DTree)
forall a a. (Maybe a, a) -> Either a (a, a)
f [(Maybe String, DTree)]
xs) of
  ([], []) -> MaybeRecords
EmptyCon
  ([], [(String, DTree)]
r) -> [(String, DTree)] -> MaybeRecords
Record [(String, DTree)]
r
  ([DTree]
r, []) -> [DTree] -> MaybeRecords
NoRecord [DTree]
r
  ([DTree], [(String, DTree)])
_ -> MaybeRecords
Mixed
  where
    f :: (Maybe a, a) -> Either a (a, a)
f (Just a
x, a
t) = (a, a) -> Either a (a, a)
forall a b. b -> Either a b
Right (a
x, a
t)
    f (Maybe a
Nothing, a
t) = a -> Either a (a, a)
forall a b. a -> Either a b
Left a
t

diffDData :: [String] -> DData -> DData -> [String]
diffDData :: [String] -> DData -> DData -> [String]
diffDData [String]
name (DData String
dx (DSum sx :: DSimpleEnum
sx@(DSimpleEnum [String]
csx Int
kx))) (DData String
dy (DSum sy :: DSimpleEnum
sy@(DSimpleEnum [String]
csy Int
ky)))
  | (String
dx String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
dy) Bool -> Bool -> Bool
|| ([String]
csx [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String]
csy) = [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" have different types"]
  | Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ky = case (DSimpleEnum -> Either String String
denumToString DSimpleEnum
sx, DSimpleEnum -> Either String String
denumToString DSimpleEnum
sy) of
      (Right String
nx, Right String
ny) -> [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ny]
      (Either String String
nx, Either String String
ny) -> [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ERROR converting to enum! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([Either String String] -> [String]
forall a b. [Either a b] -> [a]
lefts [Either String String
nx, Either String String
ny])]
  | Bool
otherwise = []
diffDData [String]
name (DData String
dx (DConstructor String
cx [(Maybe String, DTree)]
xs)) (DData String
dy (DConstructor String
cy [(Maybe String, DTree)]
ys))
  | (String
dx, String
cx) (String, String) -> (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
/= (String
dy, String
cy) = [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has different types " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((String, String), (String, String)) -> String
forall a. Show a => a -> String
show ((String
dx, String
cx), (String
dy, String
cy))]
  | Bool
otherwise = case ([(Maybe String, DTree)] -> MaybeRecords
toMaybeRecords [(Maybe String, DTree)]
xs, [(Maybe String, DTree)] -> MaybeRecords
toMaybeRecords [(Maybe String, DTree)]
ys) of
      (MaybeRecords
Mixed, MaybeRecords
Mixed) -> [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has mixed types WTF"]
      (MaybeRecords
EmptyCon, MaybeRecords
EmptyCon) -> []
      (NoRecord [DTree]
x, NoRecord [DTree]
y)
        | [DTree] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DTree]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [DTree] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DTree]
y ->
            let diffChild :: Int -> DTree -> DTree -> [String]
diffChild Int
k = [String] -> DTree -> DTree -> [String]
diffDTrees' (Int -> String
arrayName Int
kString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
name)
            in [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> DTree -> DTree -> [String])
-> [Int] -> [DTree] -> [DTree] -> [[String]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> DTree -> DTree -> [String]
diffChild [Int
0..] [DTree]
x [DTree]
y
        | Bool
otherwise -> [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has different types"]
      (Record [(String, DTree)]
x, Record [(String, DTree)]
y)
        | ((String, DTree) -> String) -> [(String, DTree)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, DTree) -> String
forall a b. (a, b) -> a
fst [(String, DTree)]
x [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= ((String, DTree) -> String) -> [(String, DTree)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, DTree) -> String
forall a b. (a, b) -> a
fst [(String, DTree)]
y -> [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has different types"]
        | Bool
otherwise ->
            let diffChild :: (String, DTree) -> (String, DTree) -> [String]
diffChild (String
nx, DTree
x') (String
ny, DTree
y')
                  | String
nx String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ny = [String] -> DTree -> DTree -> [String]
diffDTrees' (String
nxString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
name) DTree
x' DTree
y'
                  | Bool
otherwise = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"internal error: record names don't match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a. Show a => a -> String
show (String
nx, String
ny)
            in [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, DTree) -> (String, DTree) -> [String])
-> [(String, DTree)] -> [(String, DTree)] -> [[String]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String, DTree) -> (String, DTree) -> [String]
diffChild [(String, DTree)]
x [(String, DTree)]
y
      (MaybeRecords, MaybeRecords)
_ -> [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has different types"]
diffDData [String]
name DData
_ DData
_ = [[String] -> String
showName [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has different types"]

--  | otherwise = zipWith diffDData
arrayName :: Int -> String
arrayName :: Int -> String
arrayName Int
k = Char
'['Char -> ShowS
forall a. a -> [a] -> [a]
:(Int -> String
forall a. Show a => a -> String
show Int
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]")


lefts :: [Either a b] -> [a]
lefts :: [Either a b] -> [a]
lefts ((Left a
x):[Either a b]
xs) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[Either a b] -> [a]
forall a b. [Either a b] -> [a]
lefts [Either a b]
xs
lefts ((Right b
_):[Either a b]
xs) = [Either a b] -> [a]
forall a b. [Either a b] -> [a]
lefts [Either a b]
xs
lefts [] = []