module ZM.Types
(
module Data.Model.Types
, AbsTypeModel
, AbsType
, AbsRef(..)
, absRef
, AbsADT
, AbsEnv
, ADTRef(..)
, getADTRef
, asIdentifier
, Identifier(..)
, UnicodeLetter(..)
, UnicodeLetterOrNumberOrLine(..)
, UnicodeSymbol(..)
, SHA3_256_6(..)
, SHAKE128_48(..)
, NonEmptyList(..)
, nonEmptyList
, Word7
, FlatEncoding(..)
, UTF8Encoding(..)
, UTF16LEEncoding(..)
, NoEncoding(..)
, TypedDecoded
, TypedDecodeException(..)
, NFData()
, Flat
, ZigZag(..)
, LeastSignificantFirst(..)
, MostSignificantFirst(..)
, Value(..)
, Label(..)
, label
) where
import Control.DeepSeq
import Control.Exception
import qualified Data.ByteString as B
import Data.Char
import Data.Digest.Keccak
import Data.Either.Validation
import Data.Flat
import Data.Foldable
import qualified Data.Map as M
import Data.Model hiding (Name)
import Data.Model.Types hiding (Name)
import Data.Word
import ZM.Model ()
import ZM.Type.BLOB
import ZM.Type.NonEmptyList
import ZM.Type.Words (LeastSignificantFirst (..),
MostSignificantFirst (..), Word7,
ZigZag (..))
type AbsType = Type AbsRef
data AbsRef = AbsRef (SHAKE128_48 AbsADT) deriving (Eq, Ord, Show, NFData, Generic, Flat)
absRef :: Flat r => r -> AbsRef
absRef a = let [w1,w2,w3,w4,w5,w6] = B.unpack . shake_128 6 . flat $ a
in AbsRef $ SHAKE128_48 w1 w2 w3 w4 w5 w6
data SHA3_256_6 a = SHA3_256_6 Word8 Word8 Word8 Word8 Word8 Word8
deriving (Eq, Ord, Show, NFData, Generic, Flat)
data SHAKE128_48 a = SHAKE128_48 Word8 Word8 Word8 Word8 Word8 Word8
deriving (Eq, Ord, Show, NFData, Generic, Flat)
type AbsADT = ADT Identifier Identifier (ADTRef AbsRef)
type AbsTypeModel = TypeModel Identifier Identifier (ADTRef AbsRef) AbsRef
type AbsEnv = TypeEnv Identifier Identifier (ADTRef AbsRef) AbsRef
data ADTRef r = Var Word8
| Rec
| Ext r
deriving (Eq, Ord, Show, NFData, Generic, Functor, Foldable, Traversable ,Flat)
getADTRef :: ADTRef a -> Maybe a
getADTRef (Ext r) = Just r
getADTRef _ = Nothing
data Identifier = Name UnicodeLetter [UnicodeLetterOrNumberOrLine]
| Symbol (NonEmptyList UnicodeSymbol)
deriving (Eq, Ord, Show, NFData, Generic, Flat)
instance Flat [UnicodeLetterOrNumberOrLine]
instance Convertible String Identifier where
safeConvert = errorsToConvertResult (validationToEither . asIdentifier)
instance Convertible Identifier String where
safeConvert (Name (UnicodeLetter h) t) = Right $ h : map (\(UnicodeLetterOrNumberOrLine s) -> s) t
safeConvert (Symbol l) = Right $ map (\(UnicodeSymbol s) -> s) . toList $ l
asIdentifier :: String -> Validation Errors Identifier
asIdentifier [] = err ["identifier cannot be empty"]
asIdentifier i@(h:t) = errsInContext i $
if isLetter h
then Name <$> asLetter h <*> sequenceA (map asLetterOrNumber t)
else Symbol . nonEmptyList <$> sequenceA (map asSymbol i)
data UnicodeLetterOrNumberOrLine = UnicodeLetterOrNumberOrLine Char deriving (Eq, Ord, Show, NFData, Generic, Flat)
data UnicodeLetter = UnicodeLetter Char deriving (Eq, Ord, Show, NFData, Generic, Flat)
data UnicodeNumber = UnicodeNumber Char deriving (Eq, Ord, Show, NFData, Generic, Flat)
data UnicodeSymbol = UnicodeSymbol Char deriving (Eq, Ord, Show, NFData, Generic, Flat)
asSymbol :: Char -> Validation Errors UnicodeSymbol
asSymbol c | isSymbol c = ok $ UnicodeSymbol c
| otherwise = err [show c,"is not an Unicode Symbol"]
asLetter :: Char -> Validation Errors UnicodeLetter
asLetter c | isLetter c = ok $ UnicodeLetter c
| otherwise = err [show c,"is not an Unicode Letter"]
asLetterOrNumber :: Char -> Validation Errors UnicodeLetterOrNumberOrLine
asLetterOrNumber c | isLetter c || isNumber c || isAlsoOK c = ok $ UnicodeLetterOrNumberOrLine c
| otherwise = err $ [show c,"is not an Unicode Letter or Number or a _"]
ok :: a -> Validation e a
ok = Success
err :: [String] -> Validation Errors a
err = Failure . (:[]) . unwords
isAlsoOK :: Char -> Bool
isAlsoOK '_' = True
isAlsoOK _ = False
data Value = Value {valType::AbsType
,valName::String
,valBits::[Bool]
,valFields::[Value]
} deriving (Eq,Ord,Show,NFData, Generic, Flat)
data Label a label = Label a (Maybe label) deriving (Eq, Ord, Show, NFData, Generic, Flat)
label :: (Functor f, Ord k) => M.Map k a -> (a -> l) -> f k -> f (Label k l)
label env f o = (\ref -> Label ref (f <$> M.lookup ref env)) <$> o
type TypedDecoded a = Either TypedDecodeException a
data TypedDecodeException = UnknownMetaModel AbsType
| WrongType {expectedType::AbsType,actualType::AbsType}
| DecodeError DecodeException deriving (Show,Eq,Ord)
instance Exception TypedDecodeException
instance (Flat adtName, Flat consName, Flat inRef, Flat exRef,Ord exRef) => Flat (TypeModel adtName consName inRef exRef)
instance (Flat a,Flat b,Flat c) => Flat (ADT a b c)
instance (Flat a,Flat b) => Flat (ConTree a b)
instance (Flat a,Flat b) => Flat [(a,Type b)]
instance Flat a => Flat [Type a]
instance Flat a => Flat (Type a)
instance Flat a => Flat (TypeRef a)
instance (Model a,Model b,Model c) => Model (ADT a b c)
instance (Model a,Model b) => Model (ConTree a b)
instance Model a => Model (ADTRef a)
instance Model a => Model (Type a)
instance Model a => Model (TypeRef a)
instance (Model adtName, Model consName, Model inRef, Model exRef) => Model (TypeModel adtName consName inRef exRef)
instance Model Identifier
instance Model UnicodeLetter
instance Model UnicodeLetterOrNumberOrLine
instance Model UnicodeSymbol
instance Model a => Model (SHA3_256_6 a)
instance Model a => Model (SHAKE128_48 a)
instance Model AbsRef
instance Model a => Model (PostAligned a)