├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── .travis.yml ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── cabal.project ├── jsbits ├── sha3.js └── test.js ├── src ├── Data │ ├── Annotate.hs │ ├── Digest │ │ └── Keccak.hs │ ├── List │ │ └── Extra.hs │ ├── These │ │ └── Extra.hs │ ├── Timeless.hs │ └── Timeless │ │ └── Mutual.hs ├── README.lhs ├── ZM.hs └── ZM │ ├── Abs.hs │ ├── AsValue.hs │ ├── BLOB.hs │ ├── BLOB │ └── BLOBList.hs │ ├── Coerce.hs │ ├── Model.hs │ ├── Parser.hs │ ├── Parser │ ├── ADT.hs │ ├── Bracket.hs │ ├── Doc.hs │ ├── Env.hs │ ├── Exp.hs │ ├── Lexer.hs │ ├── Literal.hs │ ├── Op.hs │ ├── Pretty.hs │ ├── Types.hs │ ├── Util.hs │ ├── Val.hs │ └── Value.hs │ ├── Pretty.hs │ ├── Pretty │ └── Base.hs │ ├── To │ ├── Decoder.hs │ └── Encoder.hs │ ├── Transform.hs │ ├── Type │ ├── Array.hs │ ├── BLOB.hs │ ├── Bit.hs │ ├── Bits11.hs │ ├── Bits23.hs │ ├── Bits52.hs │ ├── Bits8.hs │ ├── Char.hs │ ├── Float32.hs │ ├── Float64.hs │ ├── Function.hs │ ├── Generate.hs │ ├── List.hs │ ├── Map.hs │ ├── NonEmptyList.hs │ ├── Prims.hs │ ├── Repo.hs │ ├── Repo0.hs │ ├── String.hs │ ├── Tuples.hs │ ├── Unit.hs │ └── Words.hs │ ├── Types.hs │ └── Util.hs ├── stack.yaml.bk ├── test ├── DocSpec.hs ├── DocTest │ ├── Test.hs │ └── ZM │ │ ├── AsValue.hs │ │ └── To │ │ └── Decoder.hs ├── DocTests.hs ├── Driver.hs ├── Info.hs ├── InfoSHA.hs ├── Spec.hs ├── Test │ ├── Data.hs │ ├── Data │ │ ├── Arbitrary.hs │ │ ├── Flat.hs │ │ ├── Model.hs │ │ └── Values.hs │ ├── Data2.hs │ ├── Data2 │ │ └── Flat.hs │ ├── Data3.hs │ ├── Data3 │ │ └── Flat.hs │ ├── E.hs │ ├── E │ │ ├── Arbitrary.hs │ │ ├── Binary.hs │ │ └── Flat.hs │ └── ZM │ │ └── ADT │ │ ├── ADT │ │ └── K3e8257255cbf.hs │ │ ├── ADTRef │ │ └── K07b1b045ac3c.hs │ │ ├── AbsRef │ │ └── K4bbd38587b9e.hs │ │ ├── All.hs │ │ ├── Array │ │ └── K2e8b4519aeaa.hs │ │ ├── BLOB │ │ └── Kf139d4751fda.hs │ │ ├── Bit │ │ └── K65149ce3b366.hs │ │ ├── Bits11 │ │ └── K8ae75e67a616.hs │ │ ├── Bits23 │ │ └── K338888222364.hs │ │ ├── Bits52 │ │ └── Kf727da8aa8ad.hs │ │ ├── Bits8 │ │ └── K9e3b8c835fe9.hs │ │ ├── Bool │ │ └── K306f1981b41c.hs │ │ ├── ByAny │ │ └── Ka4d0bf8f6fb5.hs │ │ ├── ByPattern │ │ └── Kcf6c76b3f808.hs │ │ ├── ByType │ │ └── K87f090a54ea3.hs │ │ ├── Bytes │ │ └── Kf8844385a443.hs │ │ ├── Celsius │ │ └── Ka5782c1002a5.hs │ │ ├── ChannelSelectionResult │ │ └── Kc6627a317dbc.hs │ │ ├── Char │ │ └── K066db52af145.hs │ │ ├── ConTree │ │ └── K86653e040025.hs │ │ ├── Content │ │ ├── K1ba230d92eb8.hs │ │ └── K957357183935.hs │ │ ├── Either │ │ └── K6260e465ae74.hs │ │ ├── Filler │ │ └── Kae1dfeece189.hs │ │ ├── FlatEncoding │ │ └── K982148c09ddb.hs │ │ ├── HostAddress │ │ └── K64f93d94a73d.hs │ │ ├── HostPort │ │ └── K0ab5ac6303b9.hs │ │ ├── IEEE_754_binary32 │ │ └── Kb53bec846608.hs │ │ ├── IEEE_754_binary64 │ │ └── Kcba9596b4657.hs │ │ ├── III │ │ └── K4cf5dd973ae4.hs │ │ ├── IP4Address │ │ └── K6cb2ee3ac409.hs │ │ ├── Identifier │ │ └── Kdc26e9d90047.hs │ │ ├── Int │ │ └── K102a3bb904e3.hs │ │ ├── Int16 │ │ └── K3dac6bd4fa9c.hs │ │ ├── Int64 │ │ └── Kfb94cb4d4ede.hs │ │ ├── Int8 │ │ └── Kb3a2642b4a84.hs │ │ ├── LeastSignificantFirst │ │ └── K20ffacc8f8c9.hs │ │ ├── List │ │ └── Kb8cd13187198.hs │ │ ├── Match │ │ └── Kc23b20389114.hs │ │ ├── Maybe │ │ └── Kda6836778fd4.hs │ │ ├── Message │ │ └── K551d9f2adb72.hs │ │ ├── MostSignificantFirst │ │ └── K74e2b3b89941.hs │ │ ├── Msg │ │ └── Kfb89a57cdc09.hs │ │ ├── NonEmptyList │ │ └── Kbf2d1c86eb20.hs │ │ ├── PreAligned │ │ └── Kb2f28cf37d12.hs │ │ ├── RepoProtocol │ │ └── K05c7d893e9d5.hs │ │ ├── SHA3_256_6 │ │ └── K2008e8e3f4a4.hs │ │ ├── SHAKE128_48 │ │ └── K9f214799149b.hs │ │ ├── SensorReading │ │ └── Ke45682c11f7b.hs │ │ ├── Sign │ │ └── K549f91f3b0ec.hs │ │ ├── SocketAddress │ │ └── Ke5d02571ce7b.hs │ │ ├── StoreProtocol │ │ └── Ke83859e52e9a.hs │ │ ├── Subject │ │ └── Kfced5b0f3c1f.hs │ │ ├── Time │ │ └── Kf3f0f3c453f7.hs │ │ ├── Tuple2 │ │ └── Ka5583bf3ad34.hs │ │ ├── Type │ │ └── K7028aa556ebc.hs │ │ ├── TypedBLOB │ │ └── K614edd84c8bd.hs │ │ ├── UTF8Encoding │ │ └── K0f448be80580.hs │ │ ├── UnicodeLetter │ │ └── K3878b3580fc5.hs │ │ ├── UnicodeLetterOrNumberOrLine │ │ └── K33445520c45a.hs │ │ ├── UnicodeSymbol │ │ └── K801030ef543c.hs │ │ ├── Unit │ │ └── K794aef6e21aa.hs │ │ ├── User │ │ └── K0e1df25dc480.hs │ │ ├── WebSocketAddress │ │ └── Kc802c6aae1af.hs │ │ ├── Word │ │ └── Kf92e8339908a.hs │ │ ├── Word16 │ │ └── K295e24d62fac.hs │ │ ├── Word32 │ │ └── K2412799c99f1.hs │ │ ├── Word64 │ │ └── K50d018f7593a.hs │ │ ├── Word7 │ │ └── Kf4c946334a7e.hs │ │ ├── Word8 │ │ └── Kb1f46a49c8f8.hs │ │ └── ZigZag │ │ └── K03226796ede4.hs └── ZM │ └── Prim.hs └── zm.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | *.nix 2 | *.bk 3 | **/.stack-work 4 | stack.yaml.lock 5 | dist/** 6 | dist-newstyle/** 7 | other/** 8 | tmp/** 9 | private/** 10 | _build/** -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: required 2 | 3 | language: c 4 | 5 | services: 6 | - docker 7 | 8 | matrix: 9 | include: 10 | # FAIL Compiles library, compiles tests (if doc is commented out) but does not pass all tests (FloatCast issue) 11 | #- env: IMG=quid2/eta CMD="etlas --version;etlas update;etlas build --enable-tests;etlas test" 12 | # ghcjs OK 13 | #- env: IMG=quid2/ghcjs-8.4.0.1 CMD='cabal --ghcjs new-build --enable-tests;node dist-newstyle/build/x86_64-linux/ghcjs-8.4.0.1/flat-0.4/t/doc-static/build/doc-static/doc-static.jsexe/all.js;node dist-newstyle/build/x86_64-linux/ghcjs-8.4.0.1/flat-0.4/t/spec/build/spec/spec.jsexe/all.js' 14 | # # cabal OK 15 | # - env: IMG=quid2/x32-ubuntu-cabal CMD="cabal v2-update;cabal v2-build --only-dependencies --enable-tests;cabal v2-build;cabal v2-test" 16 | # # ghc 7.10.3 OK 17 | # - env: IMG=quid2/x64-ubuntu-stack-lts-6.35 CMD="stack test --no-terminal --stack-yaml stack-6.35.yaml" 18 | # # #ghc 8.0.2 OK 19 | # - env: IMG=quid2/x64-ubuntu-stack-lts-9.21 CMD="stack test --no-terminal --stack-yaml stack-9.21.yaml" 20 | # # #ghc 8.2.2 OK 21 | # - env: IMG=quid2/x64-ubuntu-stack-lts-11.22 CMD="stack test --no-terminal --resolver lts-11.22" 22 | # # # ghc 8.4.4 OK 23 | #- env: IMG=quid2/x64-ubuntu-stack-lts-12.26 CMD="stack test --no-terminal --resolver lts-12.26" 24 | # # # ghc 8.6.5 OK 25 | #- env: IMG=quid2/x64-ubuntu-stack-lts-14.27 CMD="stack test --no-terminal --resolver lts-14.27" 26 | # # # ghc 8.8.3 (OK, but slow in running some tests) 27 | - env: IMG=quid2/x64-ubuntu-stack-lts-15.11 CMD="stack test --no-terminal --resolver lts-15.14" 28 | 29 | before_install: 30 | - PKG=${PWD##*/} 31 | - docker pull $IMG 32 | 33 | script: 34 | - docker run -it $IMG bash -c "rm -r $PKG;git clone https://github.com/Quid2/$PKG;cd $PKG;$CMD" 35 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | Significant and compatibility-breaking changes. 2 | 3 | Version 0.3.2: 4 | - ZM.Abs: added absEnvWith 5 | - Moved getADTRef form ZM.Transform to ZM.Types 6 | - cabal: updated dependencies 7 | 8 | Version 0.3: 9 | - cabal: added upper bounds for dependencies 10 | - Removed instance of StringLike (replaced with Convertible) for Identifier 11 | - Moved stringADT from ZM.Transform to ZM.Pretty 12 | - ZM.Abs 13 | - Modified signature of absTypeModelMaybe 14 | - Added additional model checking functions 15 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | JavaScript code from https://github.com/emn178/js-sha3 2 | Copyright (c) 2015 Chen Yi-Cyuan 3 | MIT License 4 | 5 | Copyright Pasqualino `Titto` Assini (c) 2016 6 | 7 | All rights reserved. 8 | 9 | Redistribution and use in source and binary forms, with or without 10 | modification, are permitted provided that the following conditions are met: 11 | 12 | * Redistributions of source code must retain the above copyright 13 | notice, this list of conditions and the following disclaimer. 14 | 15 | * Redistributions in binary form must reproduce the above 16 | copyright notice, this list of conditions and the following 17 | disclaimer in the documentation and/or other materials provided 18 | with the distribution. 19 | 20 | * Neither the name of Pasqualino `Titto` Assini nor the names of other 21 | contributors may be used to endorse or promote products derived 22 | from this software without specific prior written permission. 23 | 24 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 27 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 28 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 29 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 30 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 31 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 32 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 33 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 34 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | 3 | source-repository-package 4 | type: git 5 | location: https://github.com/Quid2/model 6 | tag: c7de393 7 | 8 | -- ignore-project: False 9 | 10 | -- tests: True 11 | 12 | -- Modified doctest, used to generate static tests (doc-static) 13 | -- not working properly, use stack instead 14 | -- source-repository-package 15 | -- type: git 16 | -- location: https://github.com/tittoassini/doctest.git 17 | -- tag: 3954e94449901764e28cfed1c35490af970e9b01 18 | -------------------------------------------------------------------------------- /jsbits/test.js: -------------------------------------------------------------------------------- 1 | // node test.js 2 | var c = require('./sha3') 3 | console.log(c.shake_128("abc",256)); 4 | console.log(c.shake_128([97,98,99],256)); 5 | console.log(c.shake_128.array([97,98,99],256)); 6 | console.log(c.shake_128.array([],256)); 7 | console.log(c.sha3_256.array([],256)); 8 | -------------------------------------------------------------------------------- /src/Data/Annotate.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Recursive Annotation 3 | 4 | >>> data ArithR c = Plus c c | Minus c c | Num Int deriving (Show,Functor) 5 | >>> type Arith = Annotate String ArithR 6 | 7 | >>> Ann "One" (Num 1) :: Arith 8 | Ann "One" (Num 1) 9 | 10 | >>> Ann "Plus" $ Plus (Ann "One" $ Num 1) (Ann "Two" $ Num 2) :: Arith 11 | Ann "sulP" (Plus (Ann "enO" (Num 1)) (Ann "owT" (Num 2))) 12 | -} 13 | {-# LANGUAGE DeriveTraversable #-} 14 | {-# LANGUAGE StandaloneDeriving #-} 15 | {-# LANGUAGE TypeInType #-} 16 | {-# LANGUAGE UndecidableInstances #-} 17 | module Data.Annotate( 18 | Annotate, 19 | Ann(..), 20 | foldVal, 21 | foldAnnVal, 22 | annToX, 23 | annToF, 24 | F (..), 25 | foldF, 26 | fToX 27 | ) where 28 | 29 | -- import Data.Fix 30 | import Data.Bifunctor 31 | import qualified Prettyprinter as P 32 | 33 | -- Example 34 | type Arith = Ann ArithR 35 | 36 | data ArithR c = Plus c c | Num Int deriving (Eq,Show,Functor,Foldable,Traversable) 37 | 38 | {- 39 | >>> P.pretty a1 40 | Plus@Plus (One@Num 1) (Five@Plus (Two@Num 2) (Three@Num 3)) 41 | 42 | >>> P.pretty $ annToF a1 43 | Plus (Num 1) (Plus (Num 2) (Num 3)) 44 | -} 45 | instance (P.Pretty r,Show r) => P.Pretty (ArithR r) where 46 | pretty r@(Num _) = P.viaShow r 47 | pretty (Plus n1 n2) = P.pretty "Plus" P.<+> P.parens (P.pretty n1) P.<+> P.parens (P.pretty n2) 48 | 49 | a1 = Ann "Plus" $ Plus (Ann "One" $ Num 1) (Ann "Five" $ Plus (Ann "Two" $ Num 2) (Ann "Three" $ Num 3)) 50 | 51 | 52 | {- 53 | To modify annotation use fmap: 54 | 55 | >>> P.pretty $ fmap reverse a1 56 | sulP@Plus (enO@Num 1) (eviF@Plus (owT@Num 2) (eerhT@Num 3)) 57 | -} 58 | 59 | {- 60 | To fold on values use foldVal: 61 | 62 | >>> foldVal (\case ; Num n -> n ; Plus n1 n2 -> n1 + n2) a1 63 | 6 64 | -} 65 | 66 | {- 67 | To reannotate as function of both annotation and value, use foldAnnVal: 68 | 69 | >>> P.pretty $ eval a1 70 | (Plus, 6)@Plus ((One, 1)@Num 1) ((Five, 5)@Plus ((Two, 2)@Num 2) (( Three 71 | , 3 )@Num 3)) 72 | -} 73 | eval :: Ann ArithR ann -> Ann ArithR (ann, Int) 74 | eval = foldAnnVal go 75 | where 76 | go :: a -> ArithR (Ann ArithR (a, Int)) -> Ann ArithR (a, Int) 77 | go a r@(Num n) = Ann (a,n) r 78 | go a r@(Plus n1 n2) = Ann (a,snd (annotation n1) + snd (annotation n2)) r 79 | 80 | -- Code 81 | 82 | type Annotate label f = Ann f label -- Backward compatibility 83 | 84 | -- data Annotate label f = Ann label (f (Annotate label f)) 85 | -- deriving instance (Eq label, Eq (f (Annotate label f))) => Eq (Annotate label f) 86 | -- deriving instance (Ord label, Ord (f (Annotate label f))) => Ord (Annotate label f) 87 | -- deriving instance (Show label, Show (f (Annotate label f))) => Show (Annotate label f) 88 | 89 | data Ann f ann = Ann {annotation::ann,annotated:: f (Ann f ann)} deriving (Functor,Foldable,Traversable) 90 | deriving instance (Eq ann, Eq (f (Ann f ann))) => Eq (Ann f ann) 91 | deriving instance (Ord ann, Ord (f (Ann f ann))) => Ord (Ann f ann) 92 | deriving instance (Show ann, Show (f (Ann f ann))) => Show (Ann f ann) 93 | 94 | instance (P.Pretty l, P.Pretty (f (Ann f l))) => P.Pretty (Ann f l) where 95 | pretty (Ann l f) = P.pretty l <> P.pretty '@' <> P.pretty f 96 | 97 | -- Fold values (ignoring annotation) 98 | foldVal :: Functor f => (f b -> b) -> Ann f ann -> b 99 | foldVal f = go 100 | where 101 | go (Ann _ r) = f . fmap go $ r 102 | 103 | -- Fold values and annotations use foldAnnVal 104 | foldAnnVal :: Functor f => (ann -> f b -> b) -> Ann f ann -> b 105 | foldAnnVal f = go 106 | where 107 | go (Ann a r) = f a . fmap go $ r 108 | 109 | {- 110 | Convert an Ann to an F 111 | 112 | >>> annToF a1 113 | F (Plus (F (Num 1)) (F (Plus (F (Num 2)) (F (Num 3))))) 114 | -} 115 | annToF :: (Functor f) => Ann f ann -> F f 116 | annToF = annToX F 117 | 118 | -- annToF (Ann _ r) = F (fmap annToF r) 119 | 120 | {- 121 | Convert an Ann to another Fix 122 | 123 | >>> annToX F a1 124 | F (Plus (F (Num 1)) (F (Plus (F (Num 2)) (F (Num 3))))) 125 | -} 126 | annToX :: Functor f => (f b -> b) -> Ann f ann -> b 127 | annToX x (Ann _ r) = x (fmap (annToX x) r) 128 | 129 | -- Our own Fix, to derive Show automatically 130 | newtype F f = F (f (F f)) 131 | deriving instance (Eq (f (F f))) => Eq (F f) 132 | deriving instance (Ord (f (F f))) => Ord (F f) 133 | deriving instance (Show (f (F f))) => Show (F f) 134 | 135 | {- 136 | >>> fToX (Ann ()) $ annToF a1 137 | Ann {annotation = (), annotated = Plus (Ann {annotation = (), annotated = Num 1}) (Ann {annotation = (), annotated = Plus (Ann {annotation = (), annotated = Num 2}) (Ann {annotation = (), annotated = Num 3})})} 138 | -} 139 | fToX :: Functor f => (f b -> b) -> F f -> b 140 | fToX x (F r) = x (fmap (fToX x) r) 141 | 142 | 143 | {- 144 | To fold on values use foldVal: 145 | 146 | >>> annToF a1 147 | 148 | >>> foldF (\case ; Num n -> n ; Plus n1 n2 -> n1 + n2) $ annToF a1 149 | 6 150 | -} 151 | foldF :: Functor f => (f b -> b) -> F f -> b 152 | foldF f = go 153 | where 154 | go (F r) = f . fmap go $ r 155 | 156 | 157 | 158 | {- Pretty instance for F, hiding the presence of F 159 | 160 | >>> P.pretty $ annToF a1 161 | Plus (Num 1) (Plus (Num 2) (Num 3)) 162 | -} 163 | instance (P.Pretty (f (F f))) => P.Pretty (F f) where pretty (F f) = P.pretty f 164 | 165 | 166 | -- data A a e = A a e 167 | 168 | -- type Exp = A () ExpR 169 | 170 | -- e1, e2 :: Exp 171 | -- e1 = A "" (I 4) 172 | -- e2 = A "" (Times e1 e1) 173 | 174 | -- data ExpR = 175 | -- I Int 176 | -- | Times Exp Exp 177 | -------------------------------------------------------------------------------- /src/Data/Digest/Keccak.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE ForeignFunctionInterface #-} 4 | {-# LANGUAGE JavaScriptFFI #-} 5 | {-# LANGUAGE PackageImports #-} 6 | 7 | -- |Crypto algorithms of the Keccak family (SHA3/SHAKE), with support for GHCJS. 8 | module Data.Digest.Keccak (sha3_256, shake_128) where 9 | 10 | import qualified Data.ByteString as B 11 | 12 | #ifdef ghcjs_HOST_OS 13 | 14 | import GHCJS.Marshal 15 | import GHCJS.Types 16 | import System.IO.Unsafe 17 | 18 | #else 19 | 20 | import qualified "cryptonite" Crypto.Hash as S 21 | import qualified Data.ByteArray as S 22 | #endif 23 | 24 | --import qualified Data.ByteString as B 25 | 26 | 27 | -- $setup 28 | -- >>> :set -XOverloadedStrings 29 | -- >>> import ZM.Pretty 30 | -- >>> import Data.String 31 | -- >>> 32 | 33 | {- |Return the specified number of bytes of the SHAKE-128 hash of the provided byte string 34 | >>> shake_128 8 B.empty == B.pack [127, 156, 43, 164, 232, 143, 130, 125] 35 | True 36 | 37 | >>> shake_128 32 (B.pack [1..10]) == B.pack [142,56,168,122,207,188,35,211,233,209,95,158,63,91,102,156,114,204,22,38,177,105,130,116,173,114,190,153,159,101,10,150] 38 | True 39 | 40 | >>> let i = B.pack [1..10] in shake_128 4 i == B.take 4 (shake_128 32 i) 41 | True 42 | -} 43 | shake_128 :: Int -> B.ByteString -> B.ByteString 44 | shake_128 numBytes bs | numBytes <=0 || numBytes > 32 = error "shake128: Invalid number of bytes" 45 | | otherwise = shake_128_ numBytes bs 46 | 47 | -- |Return the specified number of bytes of the SHA-3 hash of the provided byte string 48 | sha3_256 :: Int -> B.ByteString -> B.ByteString 49 | sha3_256 numBytes bs | numBytes <=0 || numBytes > 32 = error "sha3_256: Invalid number of bytes" 50 | | otherwise = sha3_256_ numBytes bs 51 | 52 | #ifdef ghcjs_HOST_OS 53 | 54 | -- CHECK: is it necessary to pack/unpack the ByteStrings? 55 | shake_128_ :: Int -> B.ByteString -> B.ByteString 56 | shake_128_ numBytes = stat (js_shake128 $ numBytes*8) numBytes -- 256) 57 | 58 | sha3_256_ :: Int -> B.ByteString -> B.ByteString 59 | sha3_256_ = stat js_sha3_256 60 | 61 | stat :: (JSVal -> JSVal) -> Int -> B.ByteString -> B.ByteString 62 | stat f n bs = unsafePerformIO $ do 63 | jbs <- toJSVal $ B.unpack $ bs 64 | Just bs' <- fromJSVal $ f jbs 65 | return . B.take n . B.pack $ bs' 66 | 67 | -- PROB: these references will be scrambled by the `closure` compiler, as they are not static functions but are setup dynamically by the sha3.hs library 68 | foreign import javascript unsafe "shake_128.array($2, $1)" js_shake128 :: Int -> JSVal -> JSVal 69 | 70 | --foreign import javascript unsafe "sha3_224.array($1)" js_sha3_224 :: JSVal -> JSVal 71 | 72 | foreign import javascript unsafe "sha3_256.array($1)" js_sha3_256 :: JSVal -> JSVal 73 | 74 | -- foreign import javascript unsafe "keccak_256.array($1)" js_keccak256 :: JSVal -> JSVal 75 | -- foreign import javascript unsafe "(window == undefined ? global : window)['keccak_256']['array']($1)" js_keccak256 :: JSVal -> JSVal 76 | 77 | #else 78 | 79 | shake_128_ :: Int -> B.ByteString -> B.ByteString 80 | shake_128_ = stat (S.SHAKE128 :: S.SHAKE128 256) 81 | 82 | sha3_256_ :: Int -> B.ByteString -> B.ByteString 83 | sha3_256_ = stat S.SHA3_256 84 | 85 | stat 86 | :: (S.ByteArrayAccess ba, S.HashAlgorithm alg) => 87 | alg -> Int -> ba -> B.ByteString 88 | stat f numBytes = B.take numBytes . S.convert . S.hashWith f 89 | 90 | #endif 91 | -------------------------------------------------------------------------------- /src/Data/List/Extra.hs: -------------------------------------------------------------------------------- 1 | {- Additional List functions, from the 'extra' package -} 2 | module Data.List.Extra (list) where 3 | 4 | {-| 5 | Non-recursive transform over a list, like maybe. 6 | 7 | >>> list 1 (\v _ -> v - 2) [] 8 | 1 9 | 10 | >>> list 1 (\v _ -> v - 2) [5,6,7] 11 | 3 12 | -} 13 | list :: b -> (a -> [a] -> b) -> [a] -> b 14 | list nil _ [] = nil 15 | list _ cons (x:xs) = cons x xs -------------------------------------------------------------------------------- /src/Data/These/Extra.hs: -------------------------------------------------------------------------------- 1 | module Data.These.Extra 2 | ( These, 3 | -- , equivalent 4 | aThese 5 | , both 6 | , hasThis 7 | , hasThat 8 | , fromThis 9 | , fromThat 10 | ) where 11 | 12 | import Data.Maybe (fromJust, isJust) 13 | import Data.These 14 | 15 | -- |A data type that represents either a value of type `this`, or a value of type `that`, or both. 16 | -- data These this that 17 | -- = This this 18 | -- | That that 19 | -- | These this that 20 | -- deriving (Eq,Ord, Read, Show) 21 | 22 | {- 23 | Does not satisfy extensionality: 24 | f (This _) = 0 25 | f (That _) = 1 26 | f (These _ _) = 2 27 | 28 | prop> \(x::These Bool Bool) -> x == x 29 | 30 | >>> This 'a' == These 'a' False 31 | True 32 | 33 | >>> This 'b' == These 'a' False 34 | False 35 | 36 | >>> That False == These 'a' False 37 | True 38 | 39 | >>> These 'a' False == That False 40 | True 41 | 42 | >>> These 'a' False == That False 43 | True 44 | 45 | >>> This 'a'== That 'a' 46 | True 47 | -} 48 | 49 | -- |Constructor function, from Maybes 50 | aThese :: Maybe a -> Maybe b -> These a b 51 | aThese Nothing Nothing = 52 | error "aThese:you must provide either this or that or both" 53 | aThese Nothing (Just b) = That b 54 | aThese (Just a) Nothing = This a 55 | aThese (Just a) (Just b) = These a b 56 | 57 | 58 | -- ??? use a different kind of eq? 59 | -- instance (Eq a, Eq b) => Eq (These a b) where 60 | -- t1 == t2 = 61 | -- equivalent :: (Eq a1, Eq a) => These a1 a -> These a1 a -> Bool 62 | -- t1 `equivalent` t2 = 63 | -- (maybeThis t1 `meq` maybeThis t2) && (maybeThat t1 `meq` maybeThat t2) 64 | -- where 65 | -- meq Nothing _ = True 66 | -- meq _ Nothing = True 67 | -- meq (Just a) (Just b) = a == b 68 | 69 | -- This a1 == This a2 = a1 == a2 70 | -- This a1 == These a2 _ = a1 == a2 71 | -- That b1 == That b2 = b1 == b2 72 | -- That b1 == These _ b2 = b1 == b2 73 | -- These a1 b1 == These a2 b2 = a1 == a2 && b1 == b2 74 | -- These a1 _ == This a2 = a1 == a2 75 | -- These _ b1 == That b2 = b1 == b2 76 | -- _ == _ = False 77 | hasThis :: These a b -> Bool 78 | hasThis = isJust . maybeThis 79 | 80 | hasThat :: These a1 a -> Bool 81 | hasThat = isJust . maybeThat 82 | 83 | fromThis :: These c b -> c 84 | fromThis = fromJust . maybeThis 85 | 86 | fromThat :: These a1 c -> c 87 | fromThat = fromJust . maybeThat 88 | 89 | maybeThis :: These a b -> Maybe a 90 | maybeThis (This a) = Just a 91 | maybeThis (These a _) = Just a 92 | maybeThis _ = Nothing 93 | 94 | maybeThat :: These a1 a2 -> Maybe a2 95 | maybeThat (That b) = Just b 96 | maybeThat (These _ b) = Just b 97 | maybeThat _ = Nothing 98 | 99 | 100 | {- 101 | Eliminator function 102 | 103 | >>> both ((:[]) . not) ((:[]) . (>0)) $ These False (3::Int) 104 | [True,True] 105 | 106 | >>> both ((:[]) . not) (:[]) $ This False 107 | [True] 108 | -} 109 | both :: Semigroup a => (t1 -> a) -> (t2 -> a) -> These t1 t2 -> a 110 | both f g = these f g (\a b -> f a <> g b) 111 | -------------------------------------------------------------------------------- /src/Data/Timeless.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TupleSections #-} 6 | -- |A long-term storage/exchange format 7 | -- that supports different meta models 8 | module Data.Timeless ( 9 | Timeless(..), 10 | timelessHash, 11 | timelessExplicit, 12 | timelessSimple, 13 | untimeless, 14 | ) where 15 | 16 | import qualified Data.ByteString as B 17 | import Flat 18 | import Data.Model 19 | import ZM.Abs 20 | import ZM.BLOB 21 | 22 | import ZM.Types 23 | 24 | {- 25 | Dynamically recover a value, discover metamodel of a data type, its type 26 | 27 | instance Pretty Timeless where 28 | pPrint (Timeless 29 | -} 30 | 31 | -- import Debug.Trace 32 | traceShowId = id 33 | 34 | -- |Value serialised in the timeless format 35 | data Timeless = Timeless { timelessMeta :: TypedBLOB, timelessValue :: BLOB FlatEncoding } 36 | deriving (Eq, Ord, Show, NFData, Generic, Flat, Model) 37 | 38 | -- ex: True :: TypeCon .. :: Type AbsRef 39 | -- ex: True :: BoolType :: SimpleType 40 | timelessHash :: forall a . (Model a, Flat a) => a -> Timeless 41 | timelessHash a = Timeless (typedBLOB (absType (Proxy :: Proxy a))) (blob FlatEncoding . flat $ a) 42 | 43 | timelessExplicit :: forall a . (Model a, Flat a) => a -> Timeless 44 | timelessExplicit a = Timeless (typedBLOB (absTypeModel (Proxy :: Proxy a))) (blob FlatEncoding . flat $ a) 45 | 46 | timelessSimple :: Bool -> Timeless 47 | timelessSimple a = Timeless (typedBLOB BoolType) (blob FlatEncoding . flat $ a) 48 | 49 | untimelessDynamic_ :: Timeless -> TypedDecoded (B.ByteString,AbsType, AbsType) 50 | untimelessDynamic_ (Timeless (TypedBLOB meta tbs) bs) = 51 | if meta == metaAbsType 52 | then (unblob bs,,meta) <$> (errMap DecodeError . unflat . unblob $ tbs :: TypedDecoded AbsType) 53 | else Left $ UnknownMetaModel meta 54 | 55 | --untimeless :: forall a. (Flat a, Model a) => TypedDecoded Timeless -> TypedDecoded a 56 | --untimeless dt = dt >>= untimeless_ 57 | 58 | untimeless :: forall a. (Flat a, Model a) => Timeless -> TypedDecoded a 59 | untimeless (Timeless (TypedBLOB meta tbs) bs) = 60 | let expectedType = absType (Proxy :: Proxy a) 61 | in if meta == metaAbsType 62 | then let Right (actualType :: AbsType) = unflat . unblob $ tbs 63 | in if expectedType == actualType 64 | then errMap DecodeError . unflat . unblob $ bs 65 | else typeErr expectedType actualType 66 | else if meta == metaExplicitType 67 | then let Right (actualTypeModel :: AbsTypeModel) = unflat . unblob $ tbs 68 | actualType = typeName actualTypeModel 69 | in if expectedType == actualType 70 | then errMap DecodeError . unflat . unblob $ bs 71 | else typeErr expectedType actualType 72 | else if meta == metaSimpleType 73 | then let Right (simpleType :: SimpleType) = unflat . unblob $ tbs 74 | actualType = if simpleType == BoolType then metaBool else metaChar 75 | in if expectedType == actualType 76 | then errMap DecodeError . unflat . unblob $ bs 77 | else typeErr expectedType actualType -- Left "SimpleType can only be a Boolean or a Char" 78 | else Left $ UnknownMetaModel meta 79 | 80 | -- Fake type system 81 | -- just for demo purposes 82 | data SimpleType = BoolType 83 | | CharType deriving (Eq, Ord, Show, Generic,Flat,Model) 84 | 85 | metaAbsType :: AbsType 86 | metaAbsType = absType (Proxy :: Proxy AbsType) 87 | 88 | metaExplicitType :: AbsType 89 | metaExplicitType = absType (Proxy :: Proxy AbsTypeModel) 90 | 91 | metaSimpleType :: AbsType 92 | metaSimpleType = absType (Proxy :: Proxy SimpleType) 93 | 94 | metaBool :: AbsType 95 | metaBool = absType (Proxy :: Proxy Bool) 96 | 97 | metaChar :: AbsType 98 | metaChar = absType (Proxy :: Proxy Char) 99 | 100 | fun :: Type t -> Type t 101 | fun ta = let TypeApp f a = ta in f 102 | -------------------------------------------------------------------------------- /src/Data/Timeless/Mutual.hs: -------------------------------------------------------------------------------- 1 | -- |Model for mutually recursive data 2 | module Data.Timeless.Mutual where 3 | import ZM.Types 4 | import Data.Word 5 | 6 | -- Mutual recursive data types 7 | 8 | -- Test 9 | data Forest a = Forest (List (Tree a)) 10 | 11 | data Tree a = Tree a (Forest a) 12 | 13 | data List a = Cons a (List a) 14 | | Nil 15 | 16 | type MutualADTEnv = [(MutualAbsRef,MutualAbsADT)] 17 | 18 | type MutualAbsType = Type MutualAbsRef 19 | 20 | -- newtype or type? 21 | newtype MutualAbsRef = MutualAbsRef (SHA3_256_6 MutualAbsADT) 22 | 23 | type MutualAbsADT = ADT Identifier Identifier (MutualADTRef AbsRef) 24 | 25 | data MutualADTRef a = 26 | Var Word8 -- Variable 27 | | Rec String -- Recursive reference, either to the type being defined or a mutually recursive type 28 | | Ext MutualAbsRef -- Pointer to external definition 29 | 30 | 31 | -- Single type 32 | 33 | data SingleRef a = SingleRef 34 | 35 | type SingleType = Type (SingleRef Boolean) 36 | 37 | data Boolean = And Boolean Boolean | Or Boolean Boolean | Not Boolean | True | False 38 | 39 | 40 | -- Alternative Hash 41 | -------------------------------------------------------------------------------- /src/ZM.hs: -------------------------------------------------------------------------------- 1 | module ZM 2 | ( -- |Check the . 3 | module Flat 4 | , module Data.Model 5 | , module ZM.Abs 6 | , module ZM.BLOB 7 | -- , module ZM.Dynamic 8 | , module ZM.Pretty 9 | , module ZM.Transform 10 | , module ZM.Types 11 | ) 12 | where 13 | 14 | import Flat 15 | import Data.Model hiding ( Name ) 16 | import ZM.Abs 17 | import ZM.BLOB hiding ( content ) 18 | -- import ZM.Dynamic 19 | import ZM.Model ( ) 20 | import ZM.Pretty 21 | -- import ZM.Pretty.Value () 22 | import ZM.Transform 23 | import ZM.Types 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /src/ZM/BLOB.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveFunctor #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE InstanceSigs #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | 9 | module ZM.BLOB ( 10 | BLOB (..), 11 | blob, 12 | unblob, 13 | TypedBLOB (..), 14 | typedBLOB, 15 | typedBLOB_, 16 | untypedBLOB, 17 | TypedValue (..), 18 | typedValue, 19 | untypedValue, 20 | typeErr, 21 | ) where 22 | 23 | import Control.DeepSeq 24 | import Data.Bifunctor 25 | import qualified Data.ByteString as B 26 | import Data.ByteString.Convert 27 | import Data.Model 28 | import qualified Data.Text.Encoding as T 29 | import Flat 30 | import Text.PrettyPrint.HughesPJClass hiding (first) 31 | import Text.Read 32 | import ZM.Abs 33 | import qualified ZM.BLOB.BLOBList as BL 34 | import ZM.Model () 35 | import qualified ZM.Type.BLOB as Z 36 | import ZM.Types 37 | import ZM.Util (proxyOf) 38 | 39 | -- | A BLOB is binary value encoded according to a specified encoding (e.g. UTF8) 40 | data BLOB encoding = BLOB 41 | { encoding :: encoding 42 | , content :: B.ByteString 43 | } 44 | deriving (Eq, Ord, NFData, Generic, Flat) 45 | 46 | instance (Model encoding) => Model (BLOB encoding) 47 | 48 | {- | 49 | \$setup 50 | >>> import Data.Word 51 | >>> b = blob NoEncoding [11::Word8,22,33] 52 | 53 | >>> b 54 | BLOB {encoding= NoEncoding ,content= [11,22,33] } 55 | 56 | >>> read (show b) == b 57 | True 58 | -} 59 | instance (Show encoding) => Show (BLOB encoding) where 60 | show (BLOB enc bs) = 61 | unwords ["BLOB {encoding=", show enc, ",content=", show $ B.unpack bs, "}"] 62 | 63 | instance (Read encoding) => Read (BLOB encoding) where 64 | readPrec = (\(BL.BLOB e c) -> BLOB e (B.pack c)) <$> readPrec 65 | 66 | -- | Extract the binary content of a BLOB 67 | unblob :: BLOB t -> B.ByteString 68 | unblob = content 69 | 70 | -- | Build a BLOB from an encoding and a ByteString-like value 71 | blob :: (AsByteString a) => encoding -> a -> BLOB encoding 72 | blob enc = BLOB enc . toByteString 73 | 74 | -- | A typed value, a Flat encoded value and its absolute type 75 | data TypedBLOB 76 | = TypedBLOB AbsType (BLOB Z.FlatEncoding) 77 | deriving (Eq, Ord, Show, NFData, Generic, Flat, Model) 78 | 79 | {- | Build a TypedBLOB out of a value 80 | 81 | >>> typedBLOB True 82 | TypedBLOB (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) BLOB {encoding= FlatEncoding ,content= [129] } 83 | -} 84 | typedBLOB :: forall a. (Model a, Flat a) => a -> TypedBLOB 85 | typedBLOB = typedBLOB_ (absType (Proxy :: Proxy a)) 86 | 87 | -- | Build a TypedBLOB out of a type and a value 88 | typedBLOB_ :: (Flat a) => AbsType -> a -> TypedBLOB 89 | typedBLOB_ t v = TypedBLOB t (blob Z.FlatEncoding . flat $ v) 90 | 91 | -- | A typed value, a value and its absolute type 92 | data TypedValue a 93 | = TypedValue AbsType a 94 | deriving (Eq, Ord, Show, Functor, NFData, Generic, Flat) 95 | 96 | -- | Build a TypedValue out of a value 97 | typedValue :: forall a. (Model a) => a -> TypedValue a 98 | typedValue = TypedValue (absType (Proxy :: Proxy a)) 99 | 100 | -- | Type-checked extraction of a value of a known type from a decoded TypedBLOB 101 | untypedBLOB :: 102 | forall a. (Flat a, Model a) => Decoded TypedBLOB -> TypedDecoded a 103 | untypedBLOB ea = case ea of 104 | Left e -> Left . DecodeError $ e 105 | Right (TypedBLOB typ' bs) -> 106 | let typ = absType (Proxy :: Proxy a) 107 | in if typ' /= typ 108 | then typeErr typ typ' 109 | else first DecodeError . unflat $ (unblob bs :: B.ByteString) 110 | 111 | -- | Type-checked extraction of a value of a known type from a decoded TypedValue 112 | untypedValue :: (Model a) => Decoded (TypedValue a) -> TypedDecoded a 113 | untypedValue ea = case ea of 114 | Left e -> Left . DecodeError $ e 115 | Right (TypedValue typ' a) -> 116 | let typ = absType (proxyOf a) 117 | in if typ' /= typ then typeErr typ typ' else Right a 118 | 119 | -- | Return a WrongType error 120 | typeErr :: AbsType -> AbsType -> TypedDecoded a 121 | typeErr typ typ' = Left $ WrongType typ typ' 122 | 123 | instance (Show a) => Pretty (TypedValue a) where 124 | pPrint (TypedValue t v) = text (show v) <+> text "::" <+> pPrint t 125 | 126 | instance (Pretty encoding) => Pretty (BLOB encoding) where 127 | pPrint (BLOB enc bs) = text "BLOB" <+> pPrint enc <+> pPrint bs 128 | 129 | instance {-# OVERLAPS #-} Pretty (BLOB UTF8Encoding) where 130 | pPrint :: BLOB UTF8Encoding -> Doc 131 | pPrint = pPrint . T.decodeUtf8 . unblob 132 | 133 | instance {-# OVERLAPS #-} Pretty (BLOB UTF16LEEncoding) where 134 | pPrint = pPrint . T.decodeUtf16LE . unblob 135 | -------------------------------------------------------------------------------- /src/ZM/BLOB/BLOBList.hs: -------------------------------------------------------------------------------- 1 | module ZM.BLOB.BLOBList where 2 | 3 | import Data.Word 4 | 5 | data BLOB encoding = 6 | BLOB 7 | { encoding :: encoding 8 | , content :: [Word8] 9 | } 10 | deriving (Show, Read) 11 | -------------------------------------------------------------------------------- /src/ZM/Coerce.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE KindSignatures #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE TypeOperators #-} 9 | {-# LANGUAGE UndecidableInstances #-} 10 | 11 | module ZM.Coerce (coerce) where 12 | 13 | import Data.Model (Model, Proxy (..)) 14 | import Data.Type.Equality 15 | import Flat 16 | import GHC.TypeLits 17 | import Unsafe.Coerce (unsafeCoerce) 18 | import ZM.Abs (absType) 19 | import ZM.Pretty 20 | import ZM.Type.Char 21 | import ZM.Type.Float32 22 | 23 | {- 24 | Safely?? coerce between two types that have the same ZM type and the same memory layout 25 | 26 | ZM type identity does not correspond necessarily to the same memory layout 27 | 28 | Many types that share the same in memory structure have different ZM types. 29 | 30 | >>> import ZM.Type.Char 31 | >>> import ZM.Type.Float32 32 | 33 | >>> import ZM.Type.Float32 34 | >>> absType (Proxy :: Proxy Float) == absType (Proxy :: Proxy IEEE_754_binary32) 35 | True 36 | 37 | Also crashes:: 38 | 39 | >>> coerceFlat (11.1::Float) :: Maybe IEEE_754_binary32 40 | 41 | >>> absType (Proxy :: Proxy Float) 42 | TypeCon (AbsRef (SHAKE128_48 181 59 236 132 102 8)) 43 | 44 | >>> absType (Proxy :: Proxy IEEE_754_binary32) 45 | TypeCon (AbsRef (SHAKE128_48 181 59 236 132 102 8)) 46 | 47 | >>> import ZM.Type.Bit 48 | 49 | -} 50 | 51 | {- 52 | And unfortunately is possible to give the same ZM type to types with different memory layouts 53 | 54 | For example, this will SegFault as a Char is equivalent but has a very different memory layout from ZM.Type.Char : 55 | 56 | >>> import ZM.Type.Char 57 | >>> coerce 'a' :: Maybe ZM.Type.Char.Char 58 | -} 59 | coerce :: forall a b. (Flat a, Flat b, Model a, Model b) => a -> Maybe b 60 | coerce a 61 | | absType (Proxy :: Proxy a) == absType (Proxy :: Proxy b) = 62 | case unflat (flat a) :: Decoded b of 63 | Right b -> Just b 64 | Left _ -> error "coerce:impossible" 65 | | otherwise = Nothing 66 | 67 | -- c1 = c (32.23::Float) :: IEEE_754_binary32 68 | 69 | -- -- c2 = c 'a' :: IEEE_754_binary32 70 | 71 | -- c :: forall a b . (Flat a, Flat b, Model a , Model b,ZZ a ~ ZZ b) => a -> b 72 | -- -- c :: forall a b . (Flat a, Flat b) => a -> b 73 | -- c a = case unflat (flat a) :: Decoded b of 74 | -- Right b -> b 75 | -- Left _ -> error "impossible" 76 | -- type family ZZ t where 77 | -- ZZ Float = ZM "IEEE_754_binary32" 78 | -- ZZ IEEE_754_binary32 = ZM "IEEE_754_binary32" 79 | -- ZZ Prelude.Char = ZM "Char" 80 | 81 | -- asym :: forall a. Model a => a -> SomeSymbol 82 | -- asym _ = someSymbolVal $ show $ absType (Proxy::Proxy a) 83 | 84 | -- class Model a => X a where 85 | -- x :: ZM s 86 | -- data ZM (zm::Symbol) = ZM 87 | -------------------------------------------------------------------------------- /src/ZM/Model.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveFoldable #-} 4 | {-# LANGUAGE DeriveFunctor #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE DeriveTraversable #-} 7 | {-# LANGUAGE FlexibleInstances #-} 8 | {-# LANGUAGE ScopedTypeVariables #-} 9 | 10 | -- |Mapping of basic Haskell types to equivalent ZhengMing types (Char, (), Words, Ints, Floats, Text, Tuples, List, Seq, Map) 11 | module ZM.Model () where 12 | 13 | import qualified Data.ByteString as B 14 | import qualified Data.ByteString.Lazy as L 15 | import qualified Data.ByteString.Short as SBS 16 | import Flat (UTF16Text, UTF8Text) 17 | --import qualified Data.Int as H 18 | import qualified Data.Map as M 19 | import Data.Model 20 | import qualified Data.Sequence as S 21 | import Data.Text (Text) 22 | -- import ZM.Type.Array 23 | import qualified ZM.Type.BLOB as Z 24 | import qualified ZM.Type.Char as Z 25 | import ZM.Type.Float32 26 | import ZM.Type.Float64 27 | import ZM.Type.List 28 | import qualified ZM.Type.Map as Z 29 | import ZM.Type.Tuples 30 | import ZM.Type.Unit 31 | -- import qualified ZM.Type.Words as Z 32 | -- import qualified Data.Word as H 33 | -- import Numeric.Natural as H 34 | import qualified Prelude as H 35 | import Type.Analyse 36 | import ZM.Type.Array 37 | import ZM.Type.Prims() 38 | 39 | #include "MachDeps.h" 40 | 41 | instance Model H.Char where envType _ = envType (Proxy::Proxy Z.Char) 42 | 43 | instance Model () where envType _ = envType (Proxy::Proxy Unit) 44 | 45 | -- Signed and Unsigned Whole Numbers 46 | 47 | -- #if WORD_SIZE_IN_BITS == 64 48 | -- instance Model H.Word where envType _ = envType (Proxy::Proxy Z.Word64) 49 | -- instance Model H.Int where envType _ = envType (Proxy::Proxy Z.Int64) 50 | -- #elif WORD_SIZE_IN_BITS == 32 51 | -- instance Model H.Word where envType _ = envType (Proxy::Proxy Z.Word32) 52 | -- instance Model H.Int where envType _ = envType (Proxy::Proxy Z.Int32) 53 | -- #else 54 | -- #error expected WORD_SIZE_IN_BITS to be 32 or 64 55 | -- #endif 56 | 57 | -- instance Model H.Word8 where envType _ = envType (Proxy::Proxy Z.Word8) 58 | -- instance Model H.Word16 where envType _ = envType (Proxy::Proxy Z.Word16) 59 | -- instance Model H.Word32 where envType _ = envType (Proxy::Proxy Z.Word32) 60 | -- instance Model H.Word64 where envType _ = envType (Proxy::Proxy Z.Word64) 61 | -- instance Model H.Int8 where envType _ = envType (Proxy::Proxy Z.Int8) 62 | -- instance Model H.Int16 where envType _ = envType (Proxy::Proxy Z.Int16) 63 | -- instance Model H.Int32 where envType _ = envType (Proxy::Proxy Z.Int32) 64 | -- instance Model H.Int64 where envType _ = envType (Proxy::Proxy Z.Int64) 65 | -- instance Model H.Integer where envType _ = envType (Proxy::Proxy Z.Int) 66 | -- instance Model H.Natural where envType _ = envType (Proxy::Proxy Z.Word) 67 | 68 | -- Floating-Point Numbers 69 | instance Model H.Float where envType _ = envType (Proxy::Proxy IEEE_754_binary32) 70 | instance Model H.Double where envType _ = envType (Proxy::Proxy IEEE_754_binary64) 71 | 72 | -- Data Structures 73 | instance Model a => Model [a] where envType _ = envType (Proxy::Proxy (List a)) 74 | 75 | instance Model a => Model (S.Seq a) where envType _ = envType (Proxy::Proxy (List a)) 76 | -- Changed in flat 0.4.*? 77 | -- instance Model a => Model (S.Seq a) where envType _ = envType (Proxy::Proxy (Array a)) 78 | 79 | instance (Model a,Model b) => Model (M.Map a b) where envType _ = envType (Proxy::Proxy (Z.Map a b)) 80 | -- instance {-# OVERLAPPING #-} (AsType a, AsType b) => AsType (App (App (Typ (Map A0 A1)) a) b) where asType _ = asType (undefined::(App (Typ [A0]) (App (App (Typ (A0, A1)) a) b))) 81 | 82 | 83 | -- ByteStrings 84 | instance Model B.ByteString where envType _ = envType (Proxy::Proxy Bytes) 85 | instance Model L.ByteString where envType _ = envType (Proxy::Proxy Bytes) 86 | instance Model SBS.ShortByteString where envType _ = envType (Proxy::Proxy Bytes) 87 | 88 | -- Texts 89 | 90 | -- NOTE: When the kind of the type for which we define the model does not match that of the type we are mapping to we also need to define an AsType instance 91 | instance Model Text where envType _ = envType (Proxy::Proxy (Z.BLOB Z.UTF8Encoding)) 92 | instance {-# OVERLAPPING #-} AsType (Typ Text) where asType _ = asType (H.undefined::Ana (Z.BLOB Z.UTF8Encoding)) 93 | 94 | instance Model UTF8Text where envType _ = envType (Proxy::Proxy (Z.BLOB Z.UTF8Encoding)) 95 | instance {-# OVERLAPPING #-} AsType (Typ UTF8Text) where asType _ = asType (H.undefined::Ana (Z.BLOB Z.UTF8Encoding)) 96 | 97 | instance Model UTF16Text where envType _ = envType (Proxy::Proxy (Z.BLOB Z.UTF16LEEncoding)) 98 | instance {-# OVERLAPPING #-} AsType (Typ UTF16Text) where asType _ = asType (H.undefined::Ana (Z.BLOB Z.UTF16LEEncoding)) 99 | 100 | -- Tuples 101 | instance (Model a,Model b) => Model (a,b) where envType _ = envType (Proxy::Proxy (Tuple2 a b)) 102 | 103 | instance (Model a,Model b,Model c) => Model (a,b,c) where envType _ = envType (Proxy::Proxy (Tuple3 a b c)) 104 | 105 | instance (Model a,Model b,Model c,Model d) => Model (a,b,c,d) where envType _ = envType (Proxy::Proxy (Tuple4 a b c d)) 106 | 107 | instance (Model a1,Model a2,Model a3,Model a4,Model a5) => Model (a1,a2,a3,a4,a5) where envType _ = envType (Proxy::Proxy (Tuple5 a1 a2 a3 a4 a5)) 108 | 109 | instance (Model a1,Model a2,Model a3,Model a4,Model a5,Model a6) => Model (a1,a2,a3,a4,a5,a6) where envType _ = envType (Proxy::Proxy (Tuple6 a1 a2 a3 a4 a5 a6)) 110 | 111 | instance (Model a1,Model a2,Model a3,Model a4,Model a5,Model a6,Model a7) => Model (a1,a2,a3,a4,a5,a6,a7) where envType _ = envType (Proxy::Proxy (Tuple7 a1 a2 a3 a4 a5 a6 a7)) 112 | 113 | instance (Model a1,Model a2,Model a3,Model a4,Model a5,Model a6,Model a7,Model a8) => Model (a1,a2,a3,a4,a5,a6,a7,a8) where envType _ = envType (Proxy::Proxy (Tuple8 a1 a2 a3 a4 a5 a6 a7 a8)) 114 | 115 | instance (Model a1,Model a2,Model a3,Model a4,Model a5,Model a6,Model a7,Model a8,Model a9) => Model (a1,a2,a3,a4,a5,a6,a7,a8,a9) where envType _ = envType (Proxy::Proxy (Tuple9 a1 a2 a3 a4 a5 a6 a7 a8 a9)) 116 | 117 | -------------------------------------------------------------------------------- /src/ZM/Parser.hs: -------------------------------------------------------------------------------- 1 | module ZM.Parser ( 2 | module X, 3 | parseMaybe, 4 | parseErrorPretty, 5 | ) where 6 | 7 | import Text.Megaparsec 8 | import ZM.Parser.ADT as X 9 | import ZM.Parser.Bracket as X 10 | import ZM.Parser.Env as X 11 | import ZM.Parser.Exp as X 12 | import ZM.Parser.Lexer as X 13 | import ZM.Parser.Literal as X 14 | import ZM.Parser.Types as X 15 | import ZM.Parser.Util as X 16 | import ZM.Parser.Value as X 17 | -------------------------------------------------------------------------------- /src/ZM/Parser/Bracket.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveTraversable #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | module ZM.Parser.Bracket ( 6 | Bracket (..), 7 | bracket, 8 | prettyBracket, 9 | ) where 10 | 11 | import Data.Maybe (fromMaybe) 12 | import Data.Text (Text) 13 | import Prettyprinter 14 | import qualified Prettyprinter as PP 15 | import Text.Megaparsec 16 | import Text.Megaparsec.Char 17 | import ZM.Parser.Lexer 18 | import ZM.Parser.Literal 19 | import ZM.Parser.Types 20 | import ZM.Parser.Util (testParse) 21 | 22 | -- import Text.PrettyPrint (vcat) 23 | 24 | {- List of values between brackets, space separated, with an optional operand/modifier 25 | >>> import ZM.Parser.Lexer 26 | 27 | >>> p = parseMaybe (bracket signedInt) 28 | 29 | >>> p "{11 {3 4} 22}" 30 | Nothing 31 | 32 | >>> p "{11\n 22}" 33 | Just (Bracket {open = '{', close = '}', op = Nothing, values = [11,22]}) 34 | 35 | NOTE: not all symbols are accepted: 36 | 37 | >>> p "{* 11 22 *}" 38 | Just (Bracket {open = '{', close = '}', op = Just "*", values = [11,22]}) 39 | 40 | >>> p "{ %%11 22%%}" == Nothing 41 | True 42 | 43 | >>> p "{%%11 22%%}" 44 | Just (Bracket {open = '{', close = '}', op = Just "%%", values = [11,22]}) 45 | 46 | >>> p "{|11 22|}" 47 | Just (Bracket {open = '{', close = '}', op = Just "|", values = [11,22]}) 48 | 49 | >>> p "{11 22}" 50 | Just (Bracket {open = '{', close = '}', op = Nothing, values = [11,22]}) 51 | 52 | >>> parseMaybe (bracket (symbol "a")) "[a a]" 53 | Just (Bracket {open = '[', close = ']', op = Nothing, values = ["a","a"]}) 54 | 55 | >>> parseMaybe (bracket (char 'a')) "[]" 56 | Just (Bracket {open = '[', close = ']', op = Nothing, values = ""}) 57 | 58 | >>> p "[ 1 , 2 ]" 59 | Nothing 60 | 61 | >>> p "[,1]" 62 | Nothing 63 | 64 | >>> p "[1,\n]" 65 | Nothing 66 | 67 | >>> p "[1\n 2,3\n4 , 5\n]" 68 | Nothing 69 | 70 | >>> p "[\n1,2,3]" 71 | Nothing 72 | 73 | >>> p "[1,2,3]" 74 | Nothing 75 | 76 | >>> p "[ 1 \n2 \n\n]" 77 | Just (Bracket {open = '[', close = ']', op = Nothing, values = [1,2]}) 78 | 79 | >>> p "[1 2]" 80 | Just (Bracket {open = '[', close = ']', op = Nothing, values = [1,2]}) 81 | 82 | >>> p "[ 1\n\n 2\n\n] " 83 | Just (Bracket {open = '[', close = ']', op = Nothing, values = [1,2]}) 84 | -} 85 | -- generate test cases 86 | -- gen = [ T.concat ["[","]"] | n<-[0..2] ,l <- [0..2],sp <- T.take n (T.replicate " ") 87 | 88 | bracket :: Parser e -> Parser (Bracket e) 89 | bracket pe = lexeme $ do 90 | (o, c) <- choice (map (\oc@(o, _) -> oc <$ char o) bracketsOpenClose) 91 | msym <- optional sym 92 | _ <- optional wsn 93 | -- vs <- many (sepElem pe) 94 | vs <- pe `endBy` elemSep 95 | -- _ <- optional wsn 96 | _ <- maybe (string "") string msym 97 | _ <- char c 98 | return $ Bracket o c msym vs 99 | 100 | sepElem pe = 101 | choice 102 | [ pe 103 | , elemSep *> pe 104 | ] 105 | 106 | elemSep = 107 | choice 108 | [ -- void $ symbol "," -- This will be parser by 'expr' 109 | wsn 110 | , pure () 111 | ] 112 | 113 | bracketsOpenClose :: [(Char, Char)] 114 | bracketsOpenClose = [('{', '}'), ('[', ']')] -- ('<','>'),('«','»')] 115 | 116 | data Bracket e = Bracket 117 | { open, close :: Char 118 | , op :: Maybe Text 119 | , values :: [e] 120 | } 121 | deriving (Show, Eq, Ord, Functor) 122 | 123 | {- 124 | >>> p = either id (show . pretty) . testParse (bracket charLiteral) 125 | 126 | >>> error $ p "{}" 127 | { 128 | } 129 | 130 | >>> error $ p "{%% %%}" 131 | {%% 132 | %%} 133 | 134 | >>> error $ p "{%% ?a ?b %%}" 135 | {%% 136 | a 137 | b 138 | %%} 139 | -} 140 | instance (Pretty e) => Pretty (Bracket e) where 141 | pretty = prettyBracket pretty 142 | 143 | -- pretty (Bracket{..}) = 144 | -- let sop = pretty . fromMaybe "" $ op 145 | -- in pretty open 146 | -- <> sop 147 | -- <> column (\l -> let n = l + 1 in hardline <> indent n (vcat (map pretty values)) <> hardline) 148 | -- <> hardlinesop 149 | -- <> pretty close 150 | 151 | -- ?TODO: add compact single line form {1 2 3} 152 | prettyBracket :: (a -> Doc ann) -> Bracket a -> Doc ann 153 | prettyBracket prettyE (Bracket{..}) = 154 | let sop = pretty . fromMaybe "" $ op 155 | beg = pretty open <> sop 156 | end = sop <> pretty close 157 | in align 158 | ( beg 159 | <> PP.space 160 | <> PP.space 161 | <> align (foldMap (\e -> hardline <> prettyE e) values) 162 | <> hardline 163 | <> end 164 | ) 165 | 166 | -- prettyBracket prettyE (Bracket{..}) = 167 | -- let sop = pretty . fromMaybe "" $ op 168 | -- in column 169 | -- ( \s -> 170 | -- pretty open 171 | -- <> sop 172 | -- <> column 173 | -- ( \l -> 174 | -- hardline 175 | -- <> indent (l + 2) (align (vsep (map prettyE values))) 176 | -- <> hardline 177 | -- ) 178 | -- <> indent s (sop <> pretty close) 179 | -- ) 180 | 181 | -- <> hardline 182 | -- <> PP.space 183 | -- <> PP.space 184 | -- <> align (vsep (map prettyE values)) 185 | -- <> hardline 186 | -- <> sop 187 | -- <> pretty close 188 | 189 | -- instance (Pretty e) => Pretty (Bracket e) where 190 | -- pPrint (Bracket open close mop vs) = 191 | -- let op = txt . fromMaybe "" $ mop 192 | -- in chr open <> op <> vcat (map pPrint vs) <> op <> chr close 193 | -------------------------------------------------------------------------------- /src/ZM/Parser/Lexer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE NoMonomorphismRestriction #-} 8 | 9 | module ZM.Parser.Lexer ( 10 | ws, 11 | wsn, 12 | lineEnd, 13 | eof, 14 | lexeme, 15 | -- $lexemes 16 | wild, 17 | identifier, 18 | sym, 19 | constr, 20 | localId, 21 | symbol, 22 | shake, 23 | -- unsigned, 24 | ) where 25 | 26 | -- import Data.Word 27 | 28 | import Data.Char as C 29 | import Data.Maybe 30 | import Data.Text (Text, pack) 31 | import qualified Data.Text as T 32 | import Text.Megaparsec hiding (Label) 33 | import Text.Megaparsec.Char 34 | import qualified Text.Megaparsec.Char.Lexer as L 35 | import Text.Megaparsec.Debug 36 | import ZM hiding () 37 | import ZM.Parser.Types (Annotate, Ann(..), Label (..), Parser) 38 | 39 | -- lexeme :: (AnnotatePos a b) => Parser a -> Parser b 40 | -- lexeme p = do 41 | -- pos <- getOffset 42 | -- annotatePos pos <$> lexeme_ p 43 | 44 | {- | Add trailing space removal to a parser 45 | lexeme :: Parser a -> Parser a 46 | -} 47 | lexeme = L.lexeme ws 48 | 49 | ws :: Parser () 50 | ws = L.space hspace1 empty empty 51 | 52 | wsn = L.space space1 empty empty 53 | 54 | {- | Space consumer 55 | |Removes spaces and haskell style line and block comments "--.." "{\- ..-\}" 56 | -} 57 | 58 | -- sc = L.space space1 lineComment blockComment 59 | -- where 60 | -- lineComment = L.skipLineComment ("--" :: Text) 61 | 62 | -- blockComment = L.skipBlockCommentNested ("{-" :: Text) "-}" 63 | 64 | -- end parser = (<* eof) 65 | -- doc = between sc (sc >> eof) 66 | 67 | {- $lexemes 68 | Lexemes remove any trailing space, including comments: 69 | 70 | >>> parseMaybe float "3.3 -- a nice float" 71 | Just 3.3 72 | 73 | but do not remove initial space: 74 | 75 | >>> parseMaybe float " 3.3" 76 | Nothing 77 | -} 78 | 79 | {- Parse and normalise linux/windows/mac line endings 80 | >>> parseMaybe lineEnd "\n" 81 | Just '\n' 82 | 83 | >>> parseMaybe lineEnd "\r\n" 84 | Just '\n' 85 | 86 | >>> parseMaybe lineEnd "\r" 87 | Just '\n' 88 | -} 89 | lineEnd :: Parser Char 90 | lineEnd = 91 | choice 92 | [ char '\r' >> optional (char '\n') >> return '\n' 93 | , char '\n' 94 | ] 95 | 96 | -- TODO:add check on 97 | -- withPredicate 98 | -- :: (a -> Bool) -- ^ The check to perform on parsed input 99 | -- -> String -- ^ Message to print when the check fails 100 | -- -> Parser a -- ^ Parser to run 101 | -- -> Parser a -- ^ Resulting parser that performs the check 102 | -- withPredicate f msg p = do 103 | -- o <- getOffset 104 | -- r <- p 105 | -- if f r 106 | -- then return r 107 | -- else do 108 | -- setOffset o 109 | -- fail msg 110 | 111 | localId :: Parser Text 112 | localId = lexeme name 113 | 114 | identifier :: Parser Text 115 | identifier = lexeme (name <|> sym) 116 | 117 | {- 118 | 119 | FIX THIS? 120 | 121 | >>> parseMaybe name "_asd" 122 | Nothing 123 | 124 | >>> parseMaybe name "abc12" 125 | Just "abc12" 126 | 127 | >>> parseMaybe name "abc1*" 128 | Nothing 129 | 130 | >>> Nothing == parseMaybe name "True" 131 | True 132 | 133 | >>> Nothing == parseMaybe name "_" 134 | True 135 | -} 136 | name :: Parser Text 137 | name = T.cons <$> lowerChar <*> takeWhileP (Just "alpha numeric or _") (\c -> isAlphaNum c || c == '_') 138 | 139 | {- 140 | Allow _ ? 141 | 142 | >>> Nothing == parseMaybe constr "_" 143 | True 144 | 145 | >>> parseMaybe constr "N" 146 | 147 | >>> parseMaybe constr "Nil" 148 | Just "Nil" 149 | 150 | >>> parseMaybe constr "abc1*" 151 | Nothing 152 | -} 153 | constr :: Parser Text 154 | constr = lexeme $ T.cons <$> upperChar <*> takeWhileP (Just "alpha numeric") isAlphaNum 155 | 156 | {- 157 | >>> parseMaybe infixOp "+" 158 | Just "+" 159 | 160 | >>> parseMaybe sym "-−" 161 | Just "-\8722" 162 | 163 | >>> parseMaybe sym "->" 164 | Just "->" 165 | 166 | >>> parseMaybe sym "+−+=×÷<√∊≠><&!`~!@#$%^&*+=:;'?,.-_/!*/+" 167 | Just "+\8722+=\215\247<\8730\8714\8800><&!`~!@#$%^&*+=:;'?,.-_/!*/+" 168 | -} 169 | sym :: Parser Text 170 | sym = pack <$> some symChar 171 | 172 | -- TODO: spell out allowed categories 173 | symChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s) 174 | symChar = 175 | satisfy 176 | ( \c -> 177 | C.isSymbol c 178 | || elem (C.generalCategory c) [C.MathSymbol, C.OtherPunctuation, C.CurrencySymbol] 179 | || elem c ['-', '_'] 180 | ) 181 | "sym" 182 | {-# INLINE symChar #-} 183 | 184 | {- 185 | >>> let p = parseMaybe wild 186 | 187 | >>> p "_" 188 | Just "" 189 | 190 | >>> p "__" 191 | Just "_" 192 | 193 | >>> p "___" 194 | Just "__" 195 | 196 | >>> p "_a" 197 | Just "a" 198 | 199 | >>> p "_是不是" 200 | Nothing 201 | -} 202 | wild :: Parser Text 203 | wild = lexeme $ T.tail <$> wld 204 | where 205 | wld = T.cons <$> char '_' <*> (fromMaybe T.empty <$> optional (name <|> wld)) 206 | 207 | {- | 208 | Parse a specific string 209 | 210 | >>> parseMaybe (symbol "=") "" 211 | Nothing 212 | 213 | >>> parseMaybe (symbol "=") "*" 214 | Nothing 215 | 216 | >>> parseMaybe (symbol "=") "= -- an equal sign" 217 | Just "=" 218 | 219 | >>> parseMaybe (symbol "if then") "if then" 220 | Just "if then" 221 | 222 | >>> parseMaybe (symbol "Gold金en") "Gold金en" 223 | Just "Gold\37329en" 224 | -} 225 | symbol :: Text -> Parser Text 226 | symbol = L.symbol ws 227 | 228 | {- | 229 | Parse absolute reference's compact string format 230 | 231 | >>> parseMaybe shake "Ke45682c11f7b" 232 | Just (SHAKE128_48 228 86 130 193 31 123) 233 | 234 | >>> parseMaybe shake "KE45682C11F7B " 235 | Just (SHAKE128_48 228 86 130 193 31 123) 236 | -} 237 | shake :: Parser (SHAKE128_48 a) 238 | shake = lexeme k 239 | where 240 | k = 241 | ( \k0 k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 k12 -> 242 | unPrettyRef [k0, k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12] 243 | ) 244 | <$> char 'K' 245 | <*> hexDigitChar 246 | <*> hexDigitChar 247 | <*> hexDigitChar 248 | <*> hexDigitChar 249 | <*> hexDigitChar 250 | <*> hexDigitChar 251 | <*> hexDigitChar 252 | <*> hexDigitChar 253 | <*> hexDigitChar 254 | <*> hexDigitChar 255 | <*> hexDigitChar 256 | <*> hexDigitChar 257 | -------------------------------------------------------------------------------- /src/ZM/Parser/Op.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module ZM.Parser.Op ( 4 | prefixOp, 5 | infixOp, 6 | ) where 7 | 8 | import Data.Char as C 9 | import Data.Text (Text) 10 | import qualified Data.Text as T 11 | import Text.Megaparsec 12 | import Text.Megaparsec.Char 13 | import ZM.Parser.Lexer 14 | import ZM.Parser.Types 15 | 16 | -- TODO: test that the different syntactical classes (infix,prefix,wild) are mutually exclusive 17 | 18 | {- | 19 | Parse a ZM prefixOp (a unicode letter followed by zero or more unicode alphanumeric characters or '_') 20 | 21 | >>> let p = parseMaybe prefixOp 22 | 23 | >>> p "*" 24 | Nothing 25 | 26 | >>> p "1" 27 | Nothing 28 | 29 | >>> p "A" 30 | Nothing 31 | 32 | NOTE: no support for non-ascii characters 33 | 34 | >>> p "Gold金en" 35 | Nothing 36 | 37 | >>> p "是不是" 38 | Nothing 39 | 40 | >>> p "Bool -- a bool" 41 | Nothing 42 | 43 | >>> p "ant_13_" 44 | Just "ant_13_" 45 | 46 | >>> p "abc12" 47 | Just "abc12" 48 | 49 | >>> p "abc1*" 50 | Nothing 51 | 52 | >>> Nothing == p "True" 53 | True 54 | 55 | >>> Nothing == p "_" 56 | True 57 | -} 58 | 59 | -- TODO: add (+) `add` 60 | 61 | prefixOp :: Parser Text 62 | prefixOp = lexeme var 63 | 64 | var :: Parser Text 65 | var = T.cons <$> lowerChar <*> takeWhileP (Just "alpha numeric or _") (\c -> isAlphaNum c || c == '_') 66 | 67 | {- 68 | >>> parseMaybe infixOp "++" 69 | Just "++" 70 | 71 | >>> parseMaybe infixOp "_" 72 | Just "_" 73 | 74 | >>> parseMaybe infixOp "_xyz" 75 | Nothing 76 | 77 | >>> parseMaybe (infixOp >> char '}') "*}" 78 | Just '}' 79 | -} 80 | infixOp :: Parser Text 81 | infixOp = lexeme sym 82 | 83 | -- wild = char '_' >> return PWild 84 | -------------------------------------------------------------------------------- /src/ZM/Parser/Pretty.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE InstanceSigs #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE RecordWildCards #-} 7 | {-# LANGUAGE TypeSynonymInstances #-} 8 | {-# LANGUAGE UndecidableInstances #-} 9 | 10 | module ZM.Parser.Pretty (pretty) where 11 | 12 | import Data.Bifunctor (first) 13 | import Data.Maybe (fromMaybe) 14 | import qualified Data.Text as T 15 | import qualified Data.Text.IO as T 16 | import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle) 17 | import Prettyprinter 18 | import qualified Prettyprinter as Pretty 19 | import qualified Prettyprinter.Render.Terminal as Pretty.Terminal 20 | import qualified Prettyprinter.Render.Text as Pretty.Text 21 | import Text.Megaparsec (errorBundlePretty, parse, parseTest, runParser) 22 | import ZM.Parser.Types 23 | 24 | {- 25 | >>> tt "numbers" 26 | -} 27 | 28 | -- then Left (unlines ["bad pretty: ", src2, "semantic was", show syntax1, "now is", show syntax2]) 29 | -- else Right $ T.pack src2 30 | 31 | {- $setup 32 | let p = maybe "Nothing" (show . pretty) . P.parseMaybe P.mdl 33 | Not in scope: `P.mdl' 34 | Not in scope: `P.parseMaybe' 35 | -} 36 | 37 | {- 38 | >>> testPretty "[ 1 \n2]" 39 | Right "[\n 1\n 2\n]" 40 | 41 | >>> testPretty "f 1" 42 | Right "f 1" 43 | 44 | BAD 45 | >>> testPretty "1+2" 46 | Right "1 2" 47 | 48 | >>> testPretty "1 + 2" 49 | Right "1 + 2" 50 | 51 | >>> testPretty "1 + f 2 / g 4" 52 | Right "1 + f 2 / g 4" 53 | 54 | >>> testPretty "Cons 1 Nil" 55 | Right "Cons 1 Nil" 56 | 57 | >>> testPretty "{\n T->F\nF -> T}" 58 | Right "{\n T -> F\n F -> T\n}" 59 | 60 | >>> testPretty "*" 61 | Left "1:1:\n |\n1 | *\n | ^\nunexpected '*'\nexpecting '\"', ''', '(', '+', '-', '?', '[', '{', digit, integer, lowercase letter, or uppercase letter\n" 62 | -} 63 | 64 | -- instance (Pretty l, Pretty (f (Annotate l f))) => Pretty (Annotate l f) where 65 | -- pPrint (Ann l f) = pPrint f <> chr '@' <> pPrint l 66 | 67 | -- instance (Pretty r) => Pretty (ExpR r) where 68 | 69 | {- 70 | >>> p = error . either id (show . pretty) . parseMdl 71 | 72 | >>> p "{% 11\n22\n%" 73 | 3:2: 74 | | 75 | 3 | % 76 | | ^ 77 | unexpected end of input 78 | expecting '}' 79 | 80 | >>> p "{&\nx=1\ny=2\nf={T->x\nF->y\n}\nf1=f T\nf2=f F\n&} x" 81 | {& 82 | x = 1 83 | y = 2 84 | f = { 85 | T -> x 86 | F -> y 87 | } 88 | f1 = f T 89 | f2 = f F 90 | &} x 91 | 92 | >>> p "{T->x\nF->{T->{X->N\nH->M\n}\nF->O\n}y\n}" 93 | { 94 | T -> x 95 | F -> { 96 | T -> { 97 | X -> N 98 | H -> M 99 | } 100 | F -> O 101 | } y 102 | } 103 | 104 | >>> parseMdl $ "{%\n1\n22\n%}" 105 | Right (Ann 0 (Arr (Bracket {open = '{', close = '}', op = Just "%", values = [Ann 3 (Lit (LInteger 1)),Ann 5 (Lit (LInteger 22))]}))) 106 | 107 | -} 108 | 109 | -- instance Pretty Char where pretty c = pretty [c] 110 | 111 | -- Add Styles? 112 | 113 | -- class AnnPretty a style where apretty :: a -> Doc style 114 | 115 | -- instance AnnPretty Literal Style where apretty = scalar . pretty 116 | 117 | -- data Style = Scalar | Symbol 118 | 119 | -- Semantic Style 120 | -- scalar :: Doc Style -> Doc Style 121 | -- scalar = Pretty.annotate Scalar 122 | 123 | -- Render Specific Style 124 | -- scalar :: Doc AnsiStyle -> Doc AnsiStyle 125 | -- scalar = Pretty.annotate (Pretty.Terminal.colorDull Pretty.Terminal.Magenta) 126 | -------------------------------------------------------------------------------- /src/ZM/Parser/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE NoMonomorphismRestriction #-} 5 | 6 | module ZM.Parser.Util ( 7 | -- * Parsing 8 | parseDoc, 9 | -- , parseE 10 | syntaxError, -- PUBLIC? 11 | testParse, 12 | 13 | -- * Position Handling 14 | mkAt, 15 | at, 16 | 17 | -- * Parser transformers 18 | doc, 19 | parenthesis, 20 | cpars, 21 | spars, 22 | ) where 23 | 24 | import Data.Bifunctor (Bifunctor (first)) 25 | import qualified Data.List.NonEmpty as NE 26 | import Text.Megaparsec hiding (Label) 27 | import ZM.Parser.Lexer 28 | import ZM.Parser.Types ( 29 | Label (Label), 30 | Parser, 31 | RangeLine (..), 32 | ) 33 | import ZM.Pretty 34 | 35 | {- $setup 36 | >>> import ZM.Parser.Lexer(float) 37 | -} 38 | 39 | {- | Parse a string using the provided parser 40 | parseDoc :: Parser a -> String -> Either AtError a 41 | -} 42 | parseDoc parser = parseE (doc parser) 43 | 44 | -- parseE :: Parser a -> String -> Either AtError a 45 | parseE :: (TraversableStream s, VisualStream s, ShowErrorComponent e) => Parsec e s c -> s -> Either (Label RangeLine String) c 46 | parseE p = first syntaxError . parse p "" 47 | 48 | testParse :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Parsec e s c -> s -> Either String c 49 | testParse p = first errorBundlePretty . runParser p "" 50 | 51 | #if MIN_VERSION_megaparsec(9,0,0) 52 | syntaxError :: (TraversableStream s, VisualStream s,ShowErrorComponent e) => ParseErrorBundle s e -> Label RangeLine String 53 | 54 | #elif MIN_VERSION_megaparsec(8,0,0) 55 | syntaxError :: (Stream s, ShowErrorComponent e) => ParseErrorBundle s e -> AtError 56 | 57 | #elif MIN_VERSION_megaparsec(7,0,0) 58 | syntaxError :: (ShowErrorComponent e, Stream s) => ParseErrorBundle s e -> AtError 59 | #endif 60 | 61 | #if MIN_VERSION_megaparsec(8,0,0) 62 | syntaxError errs = 63 | let 64 | msg = unwords . lines . parseErrorTextPretty $ err 65 | err = NE.head . bundleErrors $ errs 66 | (_, pst') = reachOffset (errorOffset err) (bundlePosState errs) 67 | pos = pstateSourcePos pst' 68 | in mkAt pos 1 msg 69 | 70 | #elif MIN_VERSION_megaparsec(7,0,0) 71 | 72 | -- NOTE: for 7 and 8 might also parse the output of 'errorBundlePretty' 73 | syntaxError errs = 74 | let 75 | msg = unwords . lines . parseErrorTextPretty $ err 76 | err = NE.head . bundleErrors $ errs 77 | (pos, _, _) = reachOffset (errorOffset err) (bundlePosState errs) 78 | in mkAt pos 1 msg 79 | 80 | #else 81 | 82 | syntaxError :: (Ord t, ShowErrorComponent e, ShowToken t) => ParseError t e -> AtError 83 | syntaxError err = 84 | let pos = NE.head $ errorPos err 85 | in mkAt pos 1 (unwords $ tail $ lines $ parseErrorPretty err) 86 | 87 | #endif 88 | 89 | {- | 90 | Make the parser into a document parser (that will parse any initial space and till eof) 91 | -} 92 | doc :: Parser a -> Parser a 93 | doc = between wsn (wsn >> eof) 94 | 95 | -- doc = between ws eof 96 | 97 | {- | 98 | Parses something between square parenthesis "[..]" 99 | 100 | >>> parseMaybe (spars float) "[3.7 ]" 101 | Just 3.7 102 | -} 103 | spars :: Parser a -> Parser a 104 | spars = between (symbol "[") (symbol "]") 105 | 106 | {- | 107 | Parses something between curly parenthesis "{..}" 108 | 109 | >>> parseMaybe (cpars float) "{ 3.7 }" 110 | Just 3.7 111 | 112 | >>> parseMaybe (cpars float) "{ 3.7 -- a number\n} -- curly stuff" 113 | Just 3.7 114 | -} 115 | cpars :: Parser a -> Parser a 116 | cpars = between (symbol "{") (symbol "}") 117 | 118 | {- | Parses something between parenthesis "(..)" 119 | 120 | >>> parseMaybe (parenthesis float) "()" 121 | Nothing 122 | 123 | >>> parseMaybe (parenthesis float) "( 3.7)" 124 | Just 3.7 125 | -} 126 | parenthesis :: Parser a -> Parser a 127 | parenthesis = between (symbol "(") (symbol ")") 128 | 129 | -- Position 130 | 131 | {- Add location information to the result of a parser. 132 | 133 | We assume that: 134 | \* the parser does not parse initial space 135 | \* the length of parsed text is equal to the length of the pretty-shown result 136 | \* the parsed text is disposed on a single line 137 | -} 138 | 139 | at :: (TraversableStream s, MonadParsec e s m, Pretty a2) => m a2 -> m (Label RangeLine a2) 140 | at parser = do 141 | pos <- getSourcePos 142 | r <- parser 143 | return $ mkAt pos (length (prettyShow r)) r 144 | 145 | -- at parser = do 146 | -- pos1 <- getPosition 147 | -- r <- parser 148 | -- (mr,ms) <- match parser 149 | -- let l = length . dropWhile (== ' ') . reverse $ ms 150 | -- --pos2 <- getPosition 151 | -- -- when (sourceLine pos2 /= sourceLine pos1) $ fail "at: unexpected multiline parser" 152 | -- --return $ At (mkRange pos1 (unPos (sourceColumn pos2) - unPos (sourceColumn pos1))) r 153 | -- return $ At (mkRange pos1 l) rr 154 | 155 | mkAt :: SourcePos -> Int -> a -> Label RangeLine a 156 | mkAt pos len = Label (mkRange pos len) 157 | 158 | mkRange :: (Integral a) => SourcePos -> a -> RangeLine 159 | mkRange pos len = 160 | let asP f = (\n -> n - 1) . fromIntegral . unPos . f 161 | st = asP sourceColumn pos 162 | in RangeLine (asP sourceLine pos) st (st + fromIntegral len - 1) 163 | -------------------------------------------------------------------------------- /src/ZM/Parser/Val.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE InstanceSigs #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE PatternSynonyms #-} 7 | {-# LANGUAGE RankNTypes #-} 8 | {-# LANGUAGE StandaloneDeriving #-} 9 | 10 | module ZM.Parser.Val ( 11 | ValueF, 12 | Value, 13 | pattern Value, 14 | valType, 15 | valName, 16 | valBits, 17 | valFields, 18 | Val, 19 | ValF (..), 20 | Binder (..), 21 | pattern Constr, 22 | pattern VInteger, 23 | pattern VChar, 24 | pattern VString, 25 | pattern VFloat, 26 | -- pattern VArray, 27 | pattern PBind, 28 | pattern PWild, 29 | ) where 30 | 31 | import Data.Aeson hiding (Value) -- (ToJSON (..)) 32 | import qualified Data.Aeson as A 33 | import qualified Data.Aeson.Key as A 34 | import Data.Bifunctor (bimap) 35 | import Data.Text (Text, unpack) 36 | import qualified Data.Text as T 37 | import GHC.IsList 38 | import Text.PrettyPrint hiding ((<>)) 39 | import ZM 40 | import ZM.Parser.Literal 41 | import ZM.Parser.Types 42 | import ZM.Pretty 43 | 44 | -- import qualified Text.Read.Lex as A 45 | 46 | -- Result of the generic parsing of a Flat-codified value 47 | type Value = Annotate (AbsType, [Bool]) (ValF Literal Void) 48 | 49 | type ValueF = Fix (ValF Literal Void) 50 | 51 | {- 52 | JSON representation of ZM values. 53 | 54 | >>> toJSON (Fix (BinderF undefined) :: ValueF 55 | Prelude.undefined 56 | 57 | >>> toJSON (Fix (ConstrF "True" (Left [])) :: ValueF) 58 | Array [String "True"] 59 | 60 | >>> toJSON (Fix (ConstrF "URL" (Right [("domain", VString "google.com"), ("port", VInteger 8080)])) :: ValueF) 61 | Array [String "URL",Object (fromList [("domain",String "google.com"),("port",Number 8080.0)])] 62 | -} 63 | 64 | instance ToJSON1 (ValF Literal Void) where 65 | liftToJSON _ j _ (ConstrF name (Left flds)) = A.Array . fromList $ toJSON name : map j flds 66 | liftToJSON _ j _ (ConstrF name (Right flds)) = A.Array . fromList $ [toJSON name, A.object (map (uncurry (.=) . bimap A.fromText j) flds)] 67 | liftToJSON _ _ _ (LitF (LString l)) = A.String l 68 | liftToJSON _ _ _ (LitF (LChar l)) = A.String . T.singleton $ l 69 | liftToJSON _ _ _ (LitF (LInteger l)) = A.Number (fromInteger l) 70 | liftToJSON _ _ _ (LitF (LFloat l)) = A.Number (realToFrac l) 71 | liftToJSON _ _ _ (BinderF _) = undefined 72 | 73 | -- FIX 74 | liftToEncoding = undefined -- toJSON a 75 | 76 | -- instance ToJSON (ValueF) where 77 | -- toJSON (Fix (ConstrF name (Left flds))) = A.Array . fromList $ toJSON name : map toJSON flds 78 | 79 | instance Pretty Value where 80 | pPrint :: Value -> Doc 81 | pPrint v = 82 | let hasFields = not $ null (valFields v) 83 | open = if hasFields then char '(' else mempty 84 | close = if hasFields then char ')' else mempty 85 | in open 86 | <> text (unpack $ valName v) 87 | <> char ' ' 88 | <> hsep (map pPrint (valFields v)) 89 | <> close 90 | 91 | pattern Value :: 92 | forall a b lit binder. 93 | a -> 94 | Text -> 95 | b -> 96 | [Annotate (a, b) (ValF lit binder)] -> 97 | Annotate (a, b) (ValF lit binder) 98 | pattern Value{valType, valName, valBits, valFields} = Ann (valType, valBits) (ConstrF valName (Left valFields)) 99 | 100 | type Val lit binder = Fix (ValF lit binder) 101 | 102 | -- deriving instance (Eq binder, Eq lit) => Eq (Val lit binder) 103 | -- deriving instance (Ord binder, Ord lit) => Ord (Val lit binder) 104 | 105 | -- Keep the recursion open so that we can Annotate every level 106 | data ValF lit binder r 107 | = ConstrF 108 | -- | Name of the constructor (e.g. "True") 109 | Text 110 | -- | Constructor parameters, possibly named 111 | -- e.g. ConstrF "True" [] 112 | (Either [r] [(Text, r)]) 113 | | -- | A pattern that might bind a matched value to a name 114 | BinderF binder 115 | | -- | A variable or a lit pattern (e.g. a string or a number) 116 | LitF lit 117 | 118 | -- deriving (Generic1) 119 | 120 | -- | BracketF BracketKind [ValF lit binder r] 121 | 122 | deriving instance (Eq r, Eq binder, Eq lit) => Eq (ValF lit binder r) 123 | 124 | deriving instance (Ord r, Ord binder, Ord lit) => Ord (ValF lit binder r) 125 | 126 | deriving instance (Show r, Show binder, Show lit) => Show (ValF lit binder r) 127 | 128 | instance Functor (ValF lit binder) where 129 | fmap :: (a -> b) -> ValF lit binder a -> ValF lit binder b 130 | fmap f (ConstrF s fs) = ConstrF s (bimap (map f) (map (fmap f)) fs) 131 | fmap _ (BinderF b) = BinderF b 132 | fmap _ (LitF l) = LitF l 133 | 134 | pattern Constr :: 135 | Text -> 136 | Either [Val lit binder] [(Text, Val lit binder)] -> 137 | Val lit binder 138 | pattern Constr s fs = Fix (ConstrF s fs) 139 | 140 | pattern VInteger :: Integer -> Val Literal binder 141 | pattern VInteger f = Fix (LitF (LInteger f)) 142 | 143 | pattern VFloat :: Double -> Val Literal binder 144 | pattern VFloat f = Fix (LitF (LFloat f)) 145 | 146 | pattern VChar :: Char -> Val Literal binder 147 | pattern VChar f = Fix (LitF (LChar f)) 148 | 149 | pattern VString :: Text -> Val Literal binder 150 | pattern VString f = Fix (LitF (LString f)) 151 | 152 | -- pattern VArray :: [Val Literal binder] -> Val Literal binder 153 | -- pattern VArray f = Fix (LitF (LArray f)) 154 | 155 | pattern PWild :: Val lit Binder 156 | pattern PWild = Fix (BinderF Wild) 157 | 158 | pattern PBind :: Text -> Val lit Binder 159 | pattern PBind s = Fix (BinderF (Bind s)) 160 | 161 | -- instance Model v => Model (Pat v) 162 | 163 | data Binder 164 | = Wild 165 | | Bind Text 166 | deriving (Eq, Ord, Show) 167 | -------------------------------------------------------------------------------- /src/ZM/Parser/Value.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module ZM.Parser.Value ( 4 | value, 5 | pattern, 6 | Value, 7 | Pattern, 8 | ) 9 | where 10 | 11 | import Data.Text (Text) 12 | import qualified Data.Text as T 13 | import Text.Megaparsec 14 | import ZM.Parser.Lexer ( localId, symbol, wild ) 15 | import ZM.Parser.Literal 16 | import ZM.Parser.Types 17 | import ZM.Parser.Util 18 | import ZM.Parser.Val hiding (Value) 19 | 20 | {- | Generic ZM value, a constructor followed by optional, optionally named, fields. 21 | data Value = Value String ValueFields 22 | deriving (Show) 23 | |Constructor fields 24 | type ValueFields = Either [Value] [(String, Value)] 25 | -} 26 | type Value = Val Literal Void 27 | 28 | {- | Parse a document as a ZM value 29 | valueD :: Parser Value 30 | valueD = doc value 31 | |A Pattern matches a subset of values of a ZM Type 32 | -} 33 | type Pattern = Val Literal Binder 34 | 35 | {- | 36 | Parse a plain ZM value. 37 | 38 | >>> parseMaybe value "" 39 | 40 | >>> parseMaybe value "_" 41 | Nothing 42 | 43 | >>> parseMaybe value "_bv" 44 | Nothing 45 | 46 | Special syntax for numbers,chars,strings: 47 | >>> parseMaybe value "33" == Just (VInteger 33) 48 | True 49 | 50 | >>> parseMaybe value "-33" == Just (VInteger (-33)) 51 | True 52 | 53 | >>> parseMaybe value "-33.45" == Just (VFloat (-33.45)) 54 | True 55 | 56 | >>> parseMaybe value "3.3E-12" == Just (VFloat (3.3e-12)) 57 | True 58 | 59 | >>> parseMaybe value "-3.3E-12" == Just (VFloat (-3.3e-12)) 60 | True 61 | 62 | >>> parseMaybe value "'a'" == Just (VChar 'a') 63 | True 64 | 65 | >>> parseMaybe value "((\"abc\"))" == Just (VString "abc") 66 | True 67 | 68 | >>> parseMaybe value "False" == Just (Constr "False" (Left [])) 69 | True 70 | 71 | >>> parseMaybe value "(Cons False (Cons True Nil))" == Just (Constr "Cons" (Left [Constr "False" (Left []),Constr "Cons" (Left [Constr "True" (Left []),Constr "Nil" (Left [])])])) 72 | True 73 | 74 | >>> parseMaybe value "Flag {val=True}" == Just (Constr "Flag" (Right [("val",Constr "True" (Left []))])) 75 | True 76 | 77 | >>> parseMaybe value "T False \"abc\" (True) (N {name='g'})" == Just (Constr "T" (Left [Constr "False" (Left []),VString "abc",Constr "True" (Left []),Constr "N" (Right [("name",VChar 'g')])])) 78 | True 79 | 80 | >>> parseMaybe value "T {left=False,right=X 'g' V0}" == Just (Constr "T" (Right [("left",Constr "False" (Left [])),("right",Constr "X" (Left [VChar 'g',Constr "V0" (Left [])]))])) 81 | True 82 | 83 | No type annotations: 84 | BAD >>> parseMaybe value "False::Bool" 85 | Nothing 86 | -} 87 | value :: Parser Value 88 | value = valueV special 89 | 90 | {- | 91 | Parse a pattern. 92 | 93 | A wildcard: 94 | 95 | >>> parseMaybe pattern "_ " == Just PWild 96 | True 97 | 98 | A named variable (variables must start with an _): 99 | 100 | >>> parseMaybe pattern "_A" == Just (PBind "A") 101 | True 102 | 103 | No pattern matching on constructor, a variable corresponds to a full value: 104 | 105 | >>> parseMaybe pattern "_ Nil" 106 | Nothing 107 | 108 | Variables can appear at any level: 109 | 110 | >>> parse pattern "" "(T _ (T2 _b 'N'))" == Right (Constr "T" (Left [PWild,Constr "T2" (Left [PBind "b",VChar 'N'])])) 111 | True 112 | -} 113 | 114 | -- PROB: ambiguity between variable names and constructors, we require a '_' before variable name 115 | pattern :: Parser Pattern 116 | pattern = valueV (special <|> binds) 117 | 118 | constr, valueV :: Parser (Val lit binder) -> Parser (Val lit binder) 119 | valueV v = parenthesis (valueV v) <|> v <|> constr v 120 | constr v = Constr <$> localId <*> fieldsV v 121 | 122 | special :: Parser (Val Literal binder) 123 | special = 124 | try (VInteger <$> signedInt) 125 | <|> (VFloat <$> signedFloat) 126 | <|> (VChar <$> charLiteral) 127 | <|> (VString <$> textLiteral) 128 | 129 | -- TODO: Add VArray 130 | binds :: Parser (Val lit Binder) 131 | -- binds = maybe PWild PBind <$> wild 132 | -- ??? 133 | binds = (\w -> if T.null w then PWild else PBind w) <$> wild 134 | 135 | nestedValue :: Parser (Val lit binder) -> Parser (Val lit binder) 136 | nestedValue v = 137 | parenthesis (valueV v) <|> v <|> (\n -> Constr n (Left [])) <$> localId 138 | 139 | fieldsV 140 | , unnamedFields :: 141 | Parser (Val lit binder) -> 142 | Parser (Either [Val lit binder] [(Text, Val lit binder)]) 143 | -- fields :: Parser ValueFields 144 | fieldsV v = namedFields v <|> unnamedFields v 145 | 146 | -- | Parse unnamed fields 147 | unnamedFields v = Left <$> many (nestedValue v) 148 | 149 | {- | Parse a set of named fields 150 | 151 | \$setup 152 | >>> let pflds = parseMaybe (namedFields value) 153 | 154 | >>> pflds "{}" 155 | Just (Right []) 156 | 157 | Fields can be separated by commas: 158 | 159 | >>> pflds "{a=False,b=True}" == Just (Right [("a",Constr "False" (Left [])),("b",Constr "True" (Left []))]) 160 | True 161 | 162 | Or just by spaces, but you might need to use parenthesis to avoid ambiguity. 163 | 164 | This might be interpreted as 'False b' and so it fails: 165 | 166 | >>> pflds "{a=False b=True}" 167 | Nothing 168 | 169 | >>> pflds "{a=False\nb=True}" 170 | 171 | >>> pflds "{a=(False) b=True}" == Just (Right [("a",Constr "False" (Left [])),("b",Constr "True" (Left []))]) 172 | True 173 | 174 | >>> pflds "{a= Msg {from=Joe} b=True}" 175 | Just (Right [("a",Fix (ConstrF "Msg" (Right [("from",Fix (ConstrF "Joe" (Left [])))]))),("b",Fix (ConstrF "True" (Left [])))]) 176 | 177 | Haskell style comments are allowed: 178 | 179 | >>> pflds "{ l1 = cons false {\- we are in the middle of a Constr ()-\} nil , l2= nil } -- named fields are completed" == Just (Right [("l1",Constr "cons" (Left [Constr "false" (Left []),Constr "nil" (Left [])])),("l2",Constr "nil" (Left []))]) 180 | True 181 | -} 182 | namedFields :: 183 | Parser (Val lit binder) -> 184 | Parser (Either [Val lit binder] [(Text, Val lit binder)]) 185 | namedFields v = Right <$> cpars (sepBy (namedField v) (optional $ symbol ",")) 186 | 187 | namedField :: Parser (Val lit binder) -> Parser (Text, Val lit binder) 188 | namedField v = do 189 | name <- localId 190 | _ <- symbol "=" 191 | v <- valueV v 192 | return (name, v) 193 | -------------------------------------------------------------------------------- /src/ZM/Pretty/Base.hs: -------------------------------------------------------------------------------- 1 | module ZM.Pretty.Base ( 2 | prettyWords, 3 | hex, 4 | ) where 5 | 6 | import Data.Word 7 | import Text.PrettyPrint.HughesPJClass 8 | import qualified Text.PrettyPrint.HughesPJClass as P 9 | import Text.Printf 10 | import ZM.Types 11 | import Prelude 12 | 13 | instance (Pretty t) => Pretty (ZMError t) where 14 | pPrint (UnknownType t) = text "Reference to unknown type: " P.<> pPrint t 15 | pPrint (WrongKind t expPars actPars) = 16 | hsep 17 | [ text "Incorrect application of" 18 | , pPrint t P.<> text ", should have" 19 | , text $ show expPars 20 | , text "parameters but has" 21 | , text $ show actPars 22 | ] 23 | pPrint (MutuallyRecursive ts) = 24 | text "Found mutually recursive types: " P.<> pPrint ts 25 | 26 | instance Pretty AbsRef where 27 | pPrint (AbsRef sha3) = pPrint sha3 28 | 29 | instance Pretty (SHA3_256_6 a) where 30 | pPrint (SHA3_256_6 k1 k2 k3 k4 k5 k6) = 31 | char 'S' P.<> prettyWords [k1, k2, k3, k4, k5, k6] 32 | 33 | instance Pretty (SHAKE128_48 a) where 34 | pPrint (SHAKE128_48 k1 k2 k3 k4 k5 k6) = 35 | char 'K' P.<> prettyWords [k1, k2, k3, k4, k5, k6] 36 | 37 | {- | Display a list of Words in hexadecimal format 38 | 39 | >>> prettyWords [22,33,44::Word8] 40 | 16212c 41 | -} 42 | prettyWords :: [Word8] -> Doc 43 | prettyWords = text . concatMap hex 44 | 45 | -- | Display a Word in hexadecimal format 46 | hex :: Word8 -> String 47 | hex = printf "%02x" 48 | -------------------------------------------------------------------------------- /src/ZM/To/Decoder.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | -- | Dynamical decoding of serialised typed values 6 | module ZM.To.Decoder ( 7 | decodeAbsTypeModel, 8 | typeDecoder, 9 | typeDecoderMap, 10 | ) where 11 | 12 | import qualified Data.ByteString as B 13 | import qualified Data.Map as M 14 | import Data.Model ( 15 | ConTree (Con, ConTree), 16 | Convertible, 17 | Type, 18 | TypeModel (typeName), 19 | convert, 20 | fieldsTypes, 21 | solve, 22 | ) 23 | import Data.Text (Text) 24 | import Flat (Decoded, Flat (decode), unflatWith) 25 | import Flat.Decoder.Types (Get) 26 | import ZM.Parser.Val 27 | import ZM.Transform (typeTree) 28 | import ZM.Types (AbsRef (..), AbsType, AbsTypeModel, Identifier) 29 | 30 | {- $setup 31 | >>> :set -XScopedTypeVariables -XOverloadedStrings 32 | >>> import ZM 33 | >>> import ZM.Abs 34 | >>> import ZM.Pretty 35 | >>> import Data.Word 36 | >>> import Data.Int 37 | >>> import ZM.Types 38 | >>> import ZM.Parser.Types 39 | -} 40 | 41 | {- | Decode a Flat encoded value with a known type model to the corresponding Value. 42 | 43 | >>> decodeAbsTypeModel (absTypeModel (Proxy::Proxy Bool)) (flat True) 44 | Right (Ann {annotation = (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28)),[True]), annotated = ConstrF "True" (Left [])}) 45 | 46 | >>> decodeAbsTypeModel (absTypeModel (Proxy::Proxy (Maybe Bool))) (flat $ Just True) == Right (Value {valType = TypeApp (TypeCon (AbsRef (SHAKE128_48 218 104 54 119 143 212))) (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))), valName = "Just", valBits = [True], valFields = [Value {valType = TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28)), valName = "True", valBits = [True], valFields = []}]}) 47 | True 48 | 49 | If we use the wrong type we get an error: 50 | 51 | >>> decodeAbsTypeModel (absTypeModel (Proxy::Proxy Word8)) (flat 1.1) 52 | 53 | Or not, if the binary sequence happens to have the same length of a value of the wrong type: 54 | 55 | >>> decodeAbsTypeModel (absTypeModel (Proxy::Proxy Word8)) (flat (11::Int)) == Right (Value {valType = TypeCon (AbsRef (SHAKE128_48 177 244 106 73 200 248)), valName = "V22", valBits = [False,False,False,True,False,True,True,False], valFields = []}) 56 | True 57 | 58 | >>> decodeAbsTypeModel (absTypeModel (Proxy::Proxy Word8)) (flat (11::Word8)) == Right (Value {valType = TypeCon (AbsRef (SHAKE128_48 177 244 106 73 200 248)), valName = "V11", valBits = [False,False,False,False,True,False,True,True], valFields = []}) 59 | True 60 | 61 | The valBits refer only to the bottom level: 62 | 63 | >>> decodeAbsTypeModel (absTypeModel (Proxy::Proxy (Maybe Bool))) (flat $ Just False) 64 | Right (Ann {annotation = (TypeApp (TypeCon (AbsRef (SHAKE128_48 218 104 54 119 143 212))) (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))),[True]), annotated = ConstrF "Just" (Left [Ann {annotation = (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28)),[False]), annotated = ConstrF "False" (Left [])}])}) 65 | 66 | >>> decodeAbsTypeModel (absTypeModel (Proxy::Proxy Char)) (flat 'a') 67 | Right (Ann {annotation = (TypeCon (AbsRef (SHAKE128_48 6 109 181 42 241 69)),[]), annotated = ConstrF "Char" (Left [Ann {annotation = (TypeCon (AbsRef (SHAKE128_48 36 18 121 156 153 241)),[]), annotated = ConstrF "Word32" (Left [Ann {annotation = (TypeCon (AbsRef (SHAKE128_48 249 46 131 57 144 138)),[]), annotated = ConstrF "Word" (Left [Ann {annotation = (TypeApp (TypeCon (AbsRef (SHAKE128_48 32 255 172 200 248 201))) (TypeApp (TypeCon (AbsRef (SHAKE128_48 191 45 28 134 235 32))) (TypeApp (TypeCon (AbsRef (SHAKE128_48 116 226 179 184 153 65))) (TypeCon (AbsRef (SHAKE128_48 244 201 70 51 74 126))))),[]), annotated = ConstrF "LeastSignificantFirst" (Left [Ann {annotation = (TypeApp (TypeCon (AbsRef (SHAKE128_48 191 45 28 134 235 32))) (TypeApp (TypeCon (AbsRef (SHAKE128_48 116 226 179 184 153 65))) (TypeCon (AbsRef (SHAKE128_48 244 201 70 51 74 126)))),[False]), annotated = ConstrF "Elem" (Left [Ann {annotation = (TypeApp (TypeCon (AbsRef (SHAKE128_48 116 226 179 184 153 65))) (TypeCon (AbsRef (SHAKE128_48 244 201 70 51 74 126))),[]), annotated = ConstrF "MostSignificantFirst" (Left [Ann {annotation = (TypeCon (AbsRef (SHAKE128_48 244 201 70 51 74 126)),[True,True,False,False,False,False,True]), annotated = ConstrF "V97" (Left [])}])}])}])}])}])}])}) 68 | 69 | >>> let Right (Value {valType = TypeApp (TypeCon (AbsRef (SHAKE128_48 184 205 19 24 113 152))) (TypeCon (AbsRef (SHAKE128_48 6 109 181 42 241 69))), valName = "Cons", valBits = [True] , valFields=_}) = decodeAbsTypeModel (absTypeModel (Proxy::Proxy String)) (flat "abc") in True 70 | True 71 | 72 | >>> prettyShow <$> decodeAbsTypeModel (absTypeModel (Proxy::Proxy Bool)) (flat True) 73 | Right "True " 74 | 75 | prettyShow <$> decodeAbsTypeModel (absTypeModel (Proxy::Proxy Word8)) (flat (11 :: Word8)) 76 | Right "11" 77 | -} 78 | decodeAbsTypeModel :: AbsTypeModel -> B.ByteString -> Decoded Value 79 | decodeAbsTypeModel = unflatWith . typeDecoder 80 | 81 | -- | Returns a decoder for the type defined by the given model 82 | typeDecoder :: AbsTypeModel -> Get Value 83 | typeDecoder = typeOp typeDecoderMap 84 | 85 | -- | A mapping between references to absolute types and the corresponding decoder 86 | type TypeDecoderMap = TypeMap (Get Value) 87 | 88 | -- | Returns decoders for all types in the given model 89 | typeDecoderMap :: AbsTypeModel -> TypeDecoderMap 90 | typeDecoderMap = typeOpMap (conDecoder []) 91 | 92 | conDecoder :: 93 | (Convertible name Text) => 94 | [Bool] -> 95 | TypeDecoderMap -> 96 | AbsType -> 97 | ConTree name AbsRef -> 98 | Get Value 99 | conDecoder bs env t (ConTree l r) = do 100 | tag :: Bool <- decode 101 | conDecoder (tag : bs) env t (if tag then r else l) 102 | conDecoder bs env t (Con cn cs) = 103 | Value t (convert cn) (reverse bs) <$> mapM (`solve` env) (fieldsTypes cs) 104 | 105 | typeOp :: (AbsTypeModel -> TypeMap r) -> AbsTypeModel -> r 106 | typeOp opMap tm = solve (typeName tm) (opMap tm) 107 | 108 | -- | A mapping between references to absolute types and the corresponding operation 109 | type TypeMap r = M.Map (Type AbsRef) r 110 | 111 | typeOpMap :: 112 | (TypeMap r -> AbsType -> ConTree Identifier AbsRef -> r) -> 113 | AbsTypeModel -> 114 | TypeMap r 115 | typeOpMap op tm = 116 | let denv = M.mapWithKey (op denv) (typeTree tm) in denv 117 | -------------------------------------------------------------------------------- /src/ZM/Transform.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} 2 | 3 | -- | Utilities to operate on the absolute type model 4 | module ZM.Transform ( 5 | -- * Saturated ADTs 6 | MapTypeTree, 7 | typeTree, 8 | solvedADT, 9 | 10 | -- * Dependencies 11 | typeDefinition, 12 | adtDefinition, 13 | innerReferences, 14 | references, 15 | ) where 16 | 17 | import Control.Monad.Trans.State 18 | import Data.Foldable (toList) 19 | import Data.List 20 | import qualified Data.Map as M 21 | import Data.Maybe 22 | -- import Data.Model.Util (transitiveClosure) 23 | import ZM.Abs 24 | import ZM.Pretty () 25 | import ZM.Types 26 | import ZM.Util 27 | 28 | -- | A map of fully applied types to the corresponding saturated constructor tree 29 | type MapTypeTree = M.Map (Type AbsRef) (ConTree Identifier AbsRef) 30 | 31 | -- | Return the map of types to saturated constructor trees corresponding to the type model 32 | typeTree :: AbsTypeModel -> MapTypeTree 33 | typeTree tm = execEnv (addType (typeEnv tm) (typeName tm)) 34 | where 35 | -- \|Insert in the env the saturated constructor trees corresponding to the passed type 36 | -- and any type nested in its definition 37 | addType env t = do 38 | mct <- M.lookup t <$> get 39 | case mct of 40 | Nothing -> 41 | case declCons $ solvedADT env t of 42 | Just ct -> do 43 | modify (M.insert t ct) 44 | -- Recursively on all saturated types inside the contructor tree 45 | mapM_ (addType env) (conTreeTypeList ct) 46 | Nothing -> return () 47 | Just _ -> return () 48 | 49 | -- | Return all the ADTs referred, directly or indirectly, by the provided type, and defined in the provided environment 50 | typeDefinition :: AbsEnv -> AbsType -> Either [ZMError AbsRef] [AbsADT] 51 | typeDefinition env t = mapSolve env . nub . concat <$> (mapM (absRecDeps env) . references $ t) 52 | 53 | -- | Return all the ADTs referred, directly or indirectly, by the ADT identified by the provided reference, and defined in the provided environment 54 | adtDefinition :: AbsEnv -> AbsRef -> Either [ZMError AbsRef] [AbsADT] 55 | adtDefinition env t = mapSolve env <$> absRecDeps env t 56 | 57 | -- | Return the list of references found in the ADT definition 58 | innerReferences :: AbsADT -> [AbsRef] 59 | innerReferences = nub . mapMaybe getADTRef . nub . toList 60 | 61 | -- | Return the list of references found in the absolute type 62 | references :: AbsType -> [AbsRef] 63 | references = nub . toList 64 | 65 | -- absRecDeps :: AbsEnv -> AbsRef -> Either String [AbsRef] 66 | -- absRecDeps env ref = either (Left . unlines . map prettyShow) Right $ transitiveClosure getADTRef env ref 67 | absRecDeps :: AbsEnv -> AbsRef -> Either [ZMError AbsRef] [AbsRef] 68 | absRecDeps = transitiveClosure getADTRef 69 | 70 | mapSolve :: (Ord k, Show k) => M.Map k b -> [k] -> [b] 71 | mapSolve env = map (`solve` env) 72 | 73 | -- stringADT :: AbsEnv -> AbsADT -> ADT LocalName Identifier (TypeRef LocalName) 74 | -- stringADT env adt = 75 | -- let name = declName adt 76 | -- in ADT (LocalName name) (declNumParameters adt) ((solveS name <$>) <$> declCons adt) 77 | -- where solveS _ (Var n) = TypVar n 78 | -- solveS _ (Ext k) = TypRef . LocalName . declName . solve k $ env 79 | -- solveS name Rec = TypRef $ LocalName name 80 | 81 | -- | Convert a type to an equivalent concrete ADT whose variables have been substituted by the type parameters (e.g. Maybe Bool -> Maybe = Nothing | Just Bool) 82 | solvedADT :: (Ord ref, Show ref) => M.Map ref (ADT name consName (ADTRef ref)) -> Type ref -> ADT name consName ref 83 | solvedADT env at = 84 | let 85 | TypeN t ts = typeN at 86 | as = map typeA ts 87 | adt = solve t env 88 | name = declName adt 89 | in 90 | ADT name 0 (conTreeTypeMap (saturate t as) <$> declCons adt) 91 | 92 | -- | Substitute variables in a type with the provided types 93 | saturate :: ref -> [Type ref] -> Type (ADTRef ref) -> Type ref 94 | saturate ref vs (TypeApp a b) = TypeApp (saturate ref vs a) (saturate ref vs b) 95 | saturate _ vs (TypeCon (Var n)) = vs !! fromIntegral n -- Different! 96 | saturate _ _ (TypeCon (Ext r)) = TypeCon r 97 | saturate selfRef _ (TypeCon Rec) = TypeCon selfRef 98 | 99 | -- saturate2 :: ref -> [ref] -> Type (ADTRef ref) -> Type ref 100 | -- saturate2 ref vs t = subs ref vs <$> t 101 | -- where 102 | -- subs _ vars (Var n) = vars !! fromIntegral n 103 | -- subs selfRef _ Rec = selfRef 104 | -- subs _ _ (Ext r) = r 105 | -------------------------------------------------------------------------------- /src/ZM/Type/Array.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveFoldable #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | 5 | module ZM.Type.Array 6 | ( Array(..) 7 | , Bytes(..) 8 | ) 9 | where 10 | 11 | import Data.Model 12 | import qualified Data.Word as H 13 | import Flat 14 | import Flat.Decoder 15 | import Flat.Encoder 16 | import ZM.Type.Generate 17 | import ZM.Type.Prims () 18 | 19 | {-|An Array. 20 | 21 | A sequence of sequences of up to to 255 values. 22 | @ 23 | Array a = A0 24 | | A1 a (Array a) 25 | | A2 a a (Array a) 26 | ... 27 | | A255 a ... (Array a) 28 | @ 29 | -} 30 | data Array a = 31 | Array [a] 32 | deriving (Eq, Ord, Show, Foldable) 33 | 34 | --data Array a = Array (S.Seq (S.Seq a)) -- A sequence of non null sequences 35 | instance Model a => Model (Array a) where 36 | envType = useCT arrayCT 37 | 38 | instance Flat a => Flat (Array a) 39 | --encode (Array ss) = mapM_ enc ss where enc s = encode (fromIntegral (S.length s)::H.Word8) >> foldMap encode s 40 | where 41 | encode (Array l) = encodeArrayWith encode l 42 | decode = Array <$> decodeArrayWith decode 43 | size l n = foldr size (n + arrayBits (length l)) l 44 | 45 | -- |A byte-aligned byte array 46 | -- To encode and decode efficiently an Array of Bytes, we pre-align it to the nearest byte border. 47 | data Bytes = 48 | Bytes (PreAligned (Array H.Word8)) -- Could this be H.Word8? 49 | deriving (Generic, Model) 50 | 51 | -- instance Read Bytes where 52 | -- readPrec = Bytes . preAligned . Array . map Z.Word8 <$> readPrec 53 | instance Model Filler 54 | 55 | instance Model a => Model (PreAligned a) 56 | -------------------------------------------------------------------------------- /src/ZM/Type/BLOB.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | 4 | -- |Binary Large OBjects (BLOBs) 5 | module ZM.Type.BLOB 6 | ( BLOB(..) 7 | , UTF8Encoding(..) 8 | , UTF16LEEncoding(..) 9 | , FlatEncoding(..) 10 | , NoEncoding(..) 11 | ) 12 | where 13 | 14 | import Control.DeepSeq 15 | import Flat 16 | import Data.Model 17 | import ZM.Type.Array 18 | 19 | -- |A BLOB is binary value encoded according to a specified encoding (e.g. UTF8) 20 | data BLOB encoding = 21 | BLOB 22 | { encoding :: encoding 23 | , content :: Bytes 24 | } 25 | deriving (Generic) 26 | 27 | instance Model encoding => Model (BLOB encoding) 28 | 29 | -- |UTF-8 Encoding 30 | data UTF8Encoding = 31 | UTF8Encoding 32 | deriving (Eq, Ord, Show, Read, NFData, Generic, Flat, Model) 33 | 34 | -- |UTF-16 Little Endian Encoding 35 | data UTF16LEEncoding = 36 | UTF16LEEncoding 37 | deriving (Eq, Ord, Show, Read, NFData, Generic, Flat, Model) 38 | 39 | -- |Flat encoding 40 | data FlatEncoding = 41 | FlatEncoding 42 | deriving (Eq, Ord, Show, Read, NFData, Generic, Flat, Model) 43 | 44 | -- |Unspecified encoding 45 | data NoEncoding = 46 | NoEncoding 47 | deriving (Eq, Ord, Show, Read, NFData, Generic, Flat, Model) 48 | -------------------------------------------------------------------------------- /src/ZM/Type/Bit.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Bit where 4 | import Flat 5 | import Data.Model 6 | 7 | -- | A Bit 8 | data Bit = V0 | V1 deriving (Eq,Ord,Show,Generic,Flat,Model) 9 | -------------------------------------------------------------------------------- /src/ZM/Type/Bits11.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Bits11 where 4 | import ZM.Type.Bit 5 | import Flat 6 | import Data.Model 7 | 8 | data Bits11 = 9 | Bits11 10 | { bit0 :: Bit 11 | , bit1 :: Bit 12 | , bit2 :: Bit 13 | , bit3 :: Bit 14 | , bit4 :: Bit 15 | , bit5 :: Bit 16 | , bit6 :: Bit 17 | , bit7 :: Bit 18 | , bit8 :: Bit 19 | , bit9 :: Bit 20 | , bit10 :: Bit 21 | } 22 | deriving (Eq, Ord, Show, Generic, Flat, Model) 23 | -------------------------------------------------------------------------------- /src/ZM/Type/Bits23.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Bits23 where 4 | import ZM.Type.Bit 5 | import Flat 6 | import Data.Model 7 | 8 | data Bits23 = 9 | Bits23 10 | { bit0 :: Bit 11 | , bit1 :: Bit 12 | , bit2 :: Bit 13 | , bit3 :: Bit 14 | , bit4 :: Bit 15 | , bit5 :: Bit 16 | , bit6 :: Bit 17 | , bit7 :: Bit 18 | , bit8 :: Bit 19 | , bit9 :: Bit 20 | , bit10 :: Bit 21 | , bit11 :: Bit 22 | , bit12 :: Bit 23 | , bit13 :: Bit 24 | , bit14 :: Bit 25 | , bit15 :: Bit 26 | , bit16 :: Bit 27 | , bit17 :: Bit 28 | , bit18 :: Bit 29 | , bit19 :: Bit 30 | , bit20 :: Bit 31 | , bit21 :: Bit 32 | , bit22 :: Bit 33 | } 34 | deriving (Eq, Ord, Show, Generic, Model, Flat) 35 | -------------------------------------------------------------------------------- /src/ZM/Type/Bits52.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Bits52 where 4 | import ZM.Type.Bit 5 | import Flat 6 | import Data.Model 7 | 8 | data Bits52 = 9 | Bits52 10 | { bit0 :: Bit 11 | , bit1 :: Bit 12 | , bit2 :: Bit 13 | , bit3 :: Bit 14 | , bit4 :: Bit 15 | , bit5 :: Bit 16 | , bit6 :: Bit 17 | , bit7 :: Bit 18 | , bit8 :: Bit 19 | , bit9 :: Bit 20 | , bit10 :: Bit 21 | , bit11 :: Bit 22 | , bit12 :: Bit 23 | , bit13 :: Bit 24 | , bit14 :: Bit 25 | , bit15 :: Bit 26 | , bit16 :: Bit 27 | , bit17 :: Bit 28 | , bit18 :: Bit 29 | , bit19 :: Bit 30 | , bit20 :: Bit 31 | , bit21 :: Bit 32 | , bit22 :: Bit 33 | , bit23 :: Bit 34 | , bit24 :: Bit 35 | , bit25 :: Bit 36 | , bit26 :: Bit 37 | , bit27 :: Bit 38 | , bit28 :: Bit 39 | , bit29 :: Bit 40 | , bit30 :: Bit 41 | , bit31 :: Bit 42 | , bit32 :: Bit 43 | , bit33 :: Bit 44 | , bit34 :: Bit 45 | , bit35 :: Bit 46 | , bit36 :: Bit 47 | , bit37 :: Bit 48 | , bit38 :: Bit 49 | , bit39 :: Bit 50 | , bit40 :: Bit 51 | , bit41 :: Bit 52 | , bit42 :: Bit 53 | , bit43 :: Bit 54 | , bit44 :: Bit 55 | , bit45 :: Bit 56 | , bit46 :: Bit 57 | , bit47 :: Bit 58 | , bit48 :: Bit 59 | , bit49 :: Bit 60 | , bit50 :: Bit 61 | , bit51 :: Bit 62 | } 63 | deriving (Eq, Ord, Show, Generic, Flat, Model) 64 | -------------------------------------------------------------------------------- /src/ZM/Type/Bits8.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Bits8 where 4 | import ZM.Type.Bit 5 | import Flat 6 | import Data.Model 7 | 8 | data Bits8 = 9 | Bits8 10 | { bit0 :: Bit 11 | , bit1 :: Bit 12 | , bit2 :: Bit 13 | , bit3 :: Bit 14 | , bit4 :: Bit 15 | , bit5 :: Bit 16 | , bit6 :: Bit 17 | , bit7 :: Bit 18 | } 19 | deriving (Eq, Ord, Show, Generic, Flat, Model) 20 | -------------------------------------------------------------------------------- /src/ZM/Type/Char.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Char where 4 | import Data.Model 5 | 6 | import Flat 7 | import ZM.Type.Words (Word32) 8 | 9 | import ZM.Type.Words 10 | 11 | -- |A Unicode Char 12 | data Char = Char Word32 deriving (Eq, Ord, Show, Generic, Model) 13 | 14 | -------------------------------------------------------------------------------- /src/ZM/Type/Float32.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Float32(IEEE_754_binary32(..)) where 4 | 5 | import Data.Model 6 | import Flat 7 | import ZM.Type.Bits23 8 | import ZM.Type.Bits8 9 | import ZM.Type.Words (MostSignificantFirst, Sign) 10 | 11 | -- |An IEEE-754 Big Endian 32 bits Float 12 | data IEEE_754_binary32 = 13 | IEEE_754_binary32 14 | { sign :: Sign 15 | , exponent :: MostSignificantFirst Bits8 16 | , fraction :: MostSignificantFirst Bits23 17 | } 18 | deriving (Eq, Ord, Show, Generic, Model,Flat) 19 | 20 | 21 | -- Low Endian 22 | -- data IEEE_754_binary32_LE = 23 | -- IEEE_754_binary32_LE 24 | -- { fractionLE :: LeastSignificantFirst Bits23 25 | -- , exponentLE :: LeastSignificantFirst Bits8 26 | -- , signLE :: Sign 27 | -- } 28 | -- or data IEEE_754_binary32_LE = IEEE_754_binary32 Word64 29 | -------------------------------------------------------------------------------- /src/ZM/Type/Float64.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Float64(IEEE_754_binary64(..)) where 4 | 5 | import Data.Model 6 | import ZM.Type.Bits11 7 | import ZM.Type.Bits52 8 | import ZM.Type.Words 9 | 10 | -- |An IEEE-754 Big Endian 64 bits Float 11 | data IEEE_754_binary64 = 12 | IEEE_754_binary64 13 | { sign :: Sign 14 | , exponent :: MostSignificantFirst Bits11 15 | , fraction :: MostSignificantFirst Bits52 16 | } 17 | deriving (Eq, Ord, Show, Generic, Model) 18 | 19 | -------------------------------------------------------------------------------- /src/ZM/Type/Function.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | 4 | module ZM.Type.Function where 5 | 6 | import Flat 7 | import Data.Model 8 | import ZM.Types ( SHAKE128_48 ) 9 | 10 | -- Here we would need higher order types: 11 | -- data Function f k r = Call f | Reply (k f) r deriving (Eq,Ord,Show,Generic,Flat) 12 | -- instance (Model a,Model (b a),Model c) => Model (Function a b c) 13 | -- data Function f k r = Call f | Reply k r deriving (Eq,Ord,Show,Generic,Flat) 14 | -- instance (Model a,Model b,Model c) => Model (Function a b c) 15 | -- Or: 16 | data Function f r 17 | = Call f 18 | | Reply (SHAKE128_48 f) r 19 | deriving (Eq, Ord, Show, Generic, Flat) 20 | 21 | instance (Model a, Model b) => Model (Function a b) 22 | -------------------------------------------------------------------------------- /src/ZM/Type/Generate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- |Generate the large constructor trees of some primitive types (Array,Word8,Word7) 3 | module ZM.Type.Generate (arrayCT, word8CT, word7CT) where 4 | 5 | import Data.Model.Types 6 | 7 | -- |Constructor Tree for: 8 | -- data Array a = A0 | A1 a (Array a) .. | A255 a .. a (Array a) 9 | arrayCT :: Maybe (ConTree String (TypeRef QualName)) 10 | arrayCT = Just (asACT $ mkCons 256) 11 | 12 | asACT :: Cons -> ConTree String (TypeRef QualName) 13 | asACT (P t1 t2) = ConTree (asACT t1) (asACT t2) 14 | asACT (L 0) = Con "A0" (Left []) 15 | asACT (L n) = let a = TypeCon $ TypVar 0 16 | in Con ("A"++show n) (Left $ replicate n a ++ [TypeApp (TypeCon (TypRef (QualName "" "" "Array"))) a]) 17 | 18 | --word8ADT = ADT {declName = "Word8", declNumParameters = 0, declCons = word8CT} 19 | 20 | -- |Constructor Tree for: 21 | -- data Word8 = V0 | V1 .. | V255 22 | word8CT :: Maybe (ConTree String ref) 23 | word8CT = Just (asWCT $ mkCons 256) 24 | 25 | -- |Constructor Tree for: 26 | -- data Word7 = V0 | V1 .. | V127 27 | word7CT :: Maybe (ConTree String ref) 28 | word7CT = Just (asWCT $ mkCons 128) 29 | 30 | asWCT :: Cons -> ConTree String ref 31 | asWCT (P t1 t2) = ConTree (asWCT t1) (asWCT t2) 32 | asWCT (L n) = Con ("V"++show n) (Left []) 33 | 34 | -- |A binary tree with integer leaves, used to represent constructor trees 35 | data Cons = L Int | P Cons Cons deriving (Show) 36 | 37 | -- |Generate a right heavier binary tree whose leaves are marked 38 | -- with the position (starting with 0) of the corresponding constructor 39 | -- in the list of constructors 40 | mkCons :: Int -> Cons 41 | mkCons = makeTree 0 42 | 43 | makeTree :: Int -> Int -> Cons 44 | makeTree p 1 = L p 45 | makeTree p n = let (d,m) = n `divMod` 2 46 | in P (makeTree p d) (makeTree (p+d) (d+m)) 47 | -------------------------------------------------------------------------------- /src/ZM/Type/List.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveFoldable #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE DeriveTraversable #-} 6 | module ZM.Type.List 7 | ( List(..) 8 | ) 9 | where 10 | 11 | import Control.DeepSeq 12 | import Flat 13 | import Data.Model 14 | 15 | -- | A list 16 | data List a = Nil 17 | | Cons a (List a) 18 | deriving (Eq, Ord, Show, NFData, Generic, Functor, Foldable, Traversable, Flat) 19 | 20 | instance Model a => Model (List a) 21 | -------------------------------------------------------------------------------- /src/ZM/Type/Map.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Map(Map) where 4 | import Data.Model 5 | import ZM.Type.List 6 | import ZM.Type.Tuples 7 | 8 | -- |A Map is represented as a list of key and value couples 9 | data Map a b = Map (List (Tuple2 a b)) deriving Generic 10 | 11 | instance (Model a, Model b) => Model (Map a b) 12 | -------------------------------------------------------------------------------- /src/ZM/Type/NonEmptyList.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveFoldable #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE DeriveTraversable #-} 6 | module ZM.Type.NonEmptyList 7 | ( NonEmptyList(..) 8 | , nonEmptyList 9 | ) 10 | where 11 | 12 | import Control.DeepSeq 13 | import Data.Model 14 | import Flat 15 | 16 | -- | A list that contains at least one element 17 | data NonEmptyList a = Elem a 18 | | Cons a (NonEmptyList a) 19 | deriving (Eq, Ord, Show, NFData, Generic, Functor, Foldable, Traversable, Flat) 20 | 21 | instance Model a => Model (NonEmptyList a) 22 | 23 | -- | Convert a list to a `NonEmptyList`, returns an error if the list is empty 24 | nonEmptyList :: [a] -> NonEmptyList a 25 | nonEmptyList [] = error "Cannot convert an empty list to NonEmptyList" 26 | nonEmptyList [h ] = Elem h 27 | nonEmptyList (h : t) = Cons h (nonEmptyList t) 28 | -------------------------------------------------------------------------------- /src/ZM/Type/Prims.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module ZM.Type.Prims() where 3 | 4 | import qualified ZM.Type.Words as Z 5 | import Data.Model 6 | import qualified Data.Word as H 7 | import qualified Data.Int as H 8 | import Numeric.Natural as H 9 | import qualified Prelude as H 10 | 11 | 12 | #include "MachDeps.h" 13 | 14 | #if WORD_SIZE_IN_BITS == 64 15 | instance Model H.Word where envType _ = envType (Proxy::Proxy Z.Word64) 16 | instance Model H.Int where envType _ = envType (Proxy::Proxy Z.Int64) 17 | #elif WORD_SIZE_IN_BITS == 32 18 | instance Model H.Word where envType _ = envType (Proxy::Proxy Z.Word32) 19 | instance Model H.Int where envType _ = envType (Proxy::Proxy Z.Int32) 20 | #else 21 | #error expected WORD_SIZE_IN_BITS to be 32 or 64 22 | #endif 23 | 24 | instance Model H.Word8 where envType _ = envType (Proxy::Proxy Z.Word8) 25 | instance Model H.Word16 where envType _ = envType (Proxy::Proxy Z.Word16) 26 | instance Model H.Word32 where envType _ = envType (Proxy::Proxy Z.Word32) 27 | instance Model H.Word64 where envType _ = envType (Proxy::Proxy Z.Word64) 28 | instance Model H.Int8 where envType _ = envType (Proxy::Proxy Z.Int8) 29 | instance Model H.Int16 where envType _ = envType (Proxy::Proxy Z.Int16) 30 | instance Model H.Int32 where envType _ = envType (Proxy::Proxy Z.Int32) 31 | instance Model H.Int64 where envType _ = envType (Proxy::Proxy Z.Int64) 32 | instance Model H.Integer where envType _ = envType (Proxy::Proxy Z.Int) 33 | instance Model H.Natural where envType _ = envType (Proxy::Proxy Z.Word) 34 | -------------------------------------------------------------------------------- /src/ZM/Type/Repo.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | 4 | module ZM.Type.Repo 5 | --RepoProtocol(..) 6 | where 7 | 8 | import Flat 9 | import Data.Model 10 | import Prelude hiding ( String ) 11 | 12 | -- import ZM 13 | -- import ZM.Type.String 14 | -- {-| 15 | -- A (simplistic) protocol to permanently store and retrieve ADT definitions. 16 | -- -} 17 | -- data RepoProtocol = Record AbsADT -- ^Permanently record an absolute type 18 | -- | Solve AbsRef -- ^Retrieve the absolute type 19 | -- | Solved AbsRef AbsADT -- ^Return the absolute type identified by an absolute reference 20 | -- | AskDataTypes -- ^Request the list of all known data types 21 | -- | KnownDataTypes [(AbsRef, AbsADT)] -- ^Return the list of all known data types 22 | -- | AskDataTypesRefs -- ^Request the list of all known data types references (absolute references and names) 23 | -- | KnownDataTypesRefs [(AbsRef, String)] -- ^Return the list of all known data types 24 | -- deriving (Eq, Ord, Show, Generic, Flat, Model) 25 | -- Ask for all known values of type a 26 | data AllKnown a = 27 | AllKnown 28 | deriving (Eq, Ord, Show, Generic, Flat) 29 | 30 | instance Model a => Model (AllKnown a) 31 | 32 | -- Record a value of type a 33 | data Record a = 34 | Record a 35 | deriving (Eq, Ord, Show, Generic, Flat) 36 | 37 | instance (Model a) => Model (Record a) 38 | 39 | -- Solve a reference of type to the corresponding value of type to if it exists. 40 | data Solve ref to = 41 | Solve ref 42 | deriving (Eq, Ord, Show, Generic, Flat) 43 | 44 | instance (Model a, Model b) => Model (Solve a b) 45 | -------------------------------------------------------------------------------- /src/ZM/Type/Repo0.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Repo0 4 | ( RepoProtocol(..) 5 | ) 6 | where 7 | 8 | import Prelude hiding ( String ) 9 | import Data.Model 10 | import Flat 11 | import ZM 12 | 13 | 14 | {-| 15 | A (simplistic) protocol to permanently store and retrieve ADT definitions. 16 | -} 17 | data RepoProtocol = Record AbsADT -- ^Permanently record an absolute type 18 | | Solve AbsRef -- ^Retrieve the absolute type 19 | | Solved AbsRef AbsADT -- ^Return the absolute type identified by an absolute reference 20 | | AskDataTypes -- ^Request the list of all known data types 21 | | KnownDataTypes [(AbsRef, AbsADT)] -- ^Return the list of all known data types 22 | deriving (Eq, Ord, Show, Generic, Flat, Model) 23 | -------------------------------------------------------------------------------- /src/ZM/Type/String.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | 4 | module ZM.Type.String 5 | ( String(..) 6 | ) 7 | where 8 | 9 | import Control.DeepSeq 10 | import Flat 11 | import Data.Model 12 | import Prelude hiding ( String ) 13 | import ZM.Model ( ) 14 | 15 | data String = 16 | String [Char] 17 | deriving (Eq, Ord, Show, Generic, Flat, Model, NFData) 18 | -------------------------------------------------------------------------------- /src/ZM/Type/Tuples.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module ZM.Type.Tuples ( 3 | Tuple2(..), 4 | Tuple3(..), 5 | Tuple4(..), 6 | Tuple5(..), 7 | Tuple6(..), 8 | Tuple7(..), 9 | Tuple8(..), 10 | Tuple9(..) 11 | ) where 12 | 13 | import Data.Model 14 | 15 | data Tuple2 a b = Tuple2 a b deriving (Eq, Ord, Show, Generic) 16 | instance (Model a,Model b) => Model (Tuple2 a b) 17 | 18 | data Tuple3 a b c = Tuple3 a b c deriving (Eq, Ord, Show, Generic) 19 | instance (Model a,Model b,Model c) => Model (Tuple3 a b c) 20 | 21 | data Tuple4 a b c d = Tuple4 a b c d deriving (Eq, Ord, Show, Generic) 22 | instance (Model a,Model b,Model c,Model d) => Model (Tuple4 a b c d) 23 | 24 | data Tuple5 a1 a2 a3 a4 a5 = Tuple5 a1 a2 a3 a4 a5 deriving (Eq, Ord, Show, Generic) 25 | instance (Model a1,Model a2,Model a3,Model a4,Model a5) => Model (Tuple5 a1 a2 a3 a4 a5) 26 | 27 | data Tuple6 a1 a2 a3 a4 a5 a6 = Tuple6 a1 a2 a3 a4 a5 a6 deriving (Eq, Ord, Show, Generic) 28 | instance (Model a1,Model a2,Model a3,Model a4,Model a5,Model a6) => Model (Tuple6 a1 a2 a3 a4 a5 a6) 29 | 30 | data Tuple7 a1 a2 a3 a4 a5 a6 a7= Tuple7 a1 a2 a3 a4 a5 a6 a7 deriving (Eq, Ord, Show, Generic) 31 | instance (Model a1,Model a2,Model a3,Model a4,Model a5,Model a6,Model a7) => Model (Tuple7 a1 a2 a3 a4 a5 a6 a7) 32 | 33 | data Tuple8 a1 a2 a3 a4 a5 a6 a7 a8 = Tuple8 a1 a2 a3 a4 a5 a6 a7 a8 deriving (Eq, Ord, Show, Generic) 34 | instance (Model a1,Model a2,Model a3,Model a4,Model a5,Model a6,Model a7,Model a8) => Model (Tuple8 a1 a2 a3 a4 a5 a6 a7 a8) 35 | 36 | data Tuple9 a1 a2 a3 a4 a5 a6 a7 a8 a9 = Tuple9 a1 a2 a3 a4 a5 a6 a7 a8 a9 deriving (Eq, Ord, Show, Generic) 37 | instance (Model a1,Model a2,Model a3,Model a4,Model a5,Model a6,Model a7,Model a8,Model a9) => Model (Tuple9 a1 a2 a3 a4 a5 a6 a7 a8 a9) 38 | -------------------------------------------------------------------------------- /src/ZM/Type/Unit.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Unit where 4 | import Data.Model 5 | 6 | -- |The Unit type 7 | data Unit = Unit deriving (Eq, Ord, Show, Generic, Model) 8 | -------------------------------------------------------------------------------- /src/ZM/Type/Words.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module ZM.Type.Words 4 | ( Sign(..) 5 | , Word7(..) 6 | , Word(..) 7 | , Word8(..) 8 | , Word16(..) 9 | , Word32(..) 10 | , Word64(..) 11 | , Int(..) 12 | , Int8(..) 13 | , Int16(..) 14 | , Int32(..) 15 | , Int64(..) 16 | , ZigZag(..) 17 | , MostSignificantFirst(..) 18 | , LeastSignificantFirst(..) 19 | ) 20 | where 21 | 22 | import Prelude hiding ( Word 23 | , Int 24 | ) 25 | import Flat 26 | import Data.Model 27 | import ZM.Type.NonEmptyList 28 | import ZM.Type.Generate 29 | import qualified Data.Word as H 30 | 31 | 32 | -- |A 7 bits unsigned integer 33 | -- data Word7 = V0 .. V127 34 | data Word7 = Word7 H.Word8 deriving (Eq, Ord, Read, Show, Generic) 35 | instance Model Word7 where 36 | envType = useCT word7CT 37 | 38 | -- |An 8 bits unsigned integer 39 | -- data Word8 = V0 | V1 .. | V255 40 | data Word8 = Word8 H.Word8 deriving (Eq, Ord, Read, Show, Generic) 41 | instance Model Word8 where 42 | envType = useCT word8CT 43 | 44 | {- | 45 | An unsigned integer of arbitrary length encoded as a non empty list of Word7 words with least significant word first and, inside each word, most significant bit first. 46 | 47 | Example: 48 | 3450 :: Word 49 | 50 | Binary representation: 0000110101111010 51 | 52 | Split in 7bits groups: 0011010(==26 decimal) 1111010(==122 decimal) 53 | 54 | Build a non-empty list whose elements are the groups in reverse order: Word (Cons V122 (Elem V26)) 55 | 56 | So Least Significant Byte first with Most Significant Bit first in every 7 bits group. 57 | 58 | -- BUG: MostSignificantFirst is useless, Word7 already has an order. 59 | -} 60 | data Word = Word (LeastSignificantFirst (NonEmptyList (MostSignificantFirst Word7))) 61 | deriving (Eq, Ord, Show, Generic, Model) 62 | 63 | data Word16 = Word16 Word 64 | deriving (Eq, Ord, Show, Generic, Model) 65 | 66 | data Word32 = Word32 Word 67 | deriving (Eq, Ord, Show, Generic, Model) 68 | 69 | data Word64 = Word64 Word 70 | deriving (Eq, Ord, Show, Generic, Model) 71 | 72 | 73 | 74 | data Int = Int (ZigZag Word) deriving (Eq, Ord, Show, Generic, Model) 75 | 76 | data Int8 = Int8 (ZigZag Word8) 77 | deriving (Eq, Ord, Show, Generic, Model) 78 | 79 | data Int16 = Int16 (ZigZag Word16) 80 | deriving (Eq, Ord, Show, Generic, Model) 81 | 82 | data Int32 = Int32 (ZigZag Word32) 83 | deriving (Eq, Ord, Show, Generic, Model) 84 | 85 | data Int64 = Int64 (ZigZag Word64) 86 | deriving (Eq, Ord, Show, Generic, Model) 87 | 88 | -- |ZigZag encoding, map signed integers to unsigned integers 89 | -- Positive integers are mapped to even unsigned values, negative integers to odd values: 90 | -- 0 -> 0, -1 -> 1, 1 -> 2, -2 -> 3, 2 -> 4 ... 91 | data ZigZag a = ZigZag a 92 | deriving (Eq, Ord, Show, Generic, Flat) 93 | instance Model a => Model (ZigZag a) 94 | 95 | data LeastSignificantFirst a = LeastSignificantFirst a 96 | deriving (Eq, Ord, Show, Generic, Flat) 97 | instance Model a => Model (LeastSignificantFirst a) 98 | 99 | data MostSignificantFirst a = MostSignificantFirst a 100 | deriving (Eq, Ord, Show, Generic, Flat) 101 | instance Model a => Model (MostSignificantFirst a) 102 | 103 | data Sign = Positive | Negative deriving (Eq, Ord, Show, Generic, Model, Flat) 104 | -------------------------------------------------------------------------------- /src/ZM/Util.hs: -------------------------------------------------------------------------------- 1 | module ZM.Util ( 2 | proxyOf, 3 | 4 | -- * State Monad utilities 5 | runEnv, 6 | execEnv, 7 | ) where 8 | 9 | import Control.Monad.Trans.State 10 | import qualified Data.Map as M 11 | import Data.Proxy 12 | 13 | -- | Return the proxy for the type of the given value 14 | proxyOf :: a -> Proxy a 15 | proxyOf _ = Proxy :: Proxy a 16 | 17 | ----------- State Utils 18 | 19 | -- | Run a State monad with an empty map as environment 20 | runEnv :: State (M.Map k a1) a -> (a, M.Map k a1) 21 | runEnv op = runState op M.empty 22 | 23 | -- | Exec a State monad with an empty map as environment 24 | execEnv :: State (M.Map k a1) a -> M.Map k a1 25 | execEnv op = execState op M.empty 26 | -------------------------------------------------------------------------------- /stack.yaml.bk: -------------------------------------------------------------------------------- 1 | resolver: lts-18.28 2 | #resolver: nightly-2023-01-08 3 | 4 | packages: 5 | - "." 6 | #- ../model 7 | #- ../flat 8 | 9 | extra-deps: 10 | - model-0.5@sha256:c54661de2ba056cc59add51970979db6ef86258f470b9cc1a39bc4b6ae4a146a,2468 11 | 12 | - flat-0.6 13 | 14 | # - github: Quid2/flat 15 | # commit: 122d9943a6a73500ffc7368d237d69d8c2802e6a 16 | 17 | # Modified doctest, used to generate static tests 18 | - git: https://github.com/tittoassini/doctest 19 | commit: 3954e94449901764e28cfed1c35490af970e9b01 20 | 21 | - quickcheck-instances-0.3.28@sha256:eeed853ebe7194bb1c5ac888a5a084a65d05d7f8ed5b049f908544ab632c297c,4866 22 | - OneTuple-0.3.1@sha256:fc32cb744477befa450a538ea4975cc523f0a2f1585cb5a36e9936a3d18e9a3c,2276 23 | - hashable-1.4.1.0@sha256:50b2f002c68fe67730ee7a3cd8607486197dd99b084255005ad51ecd6970a41b,5019 24 | - text-short-0.1.5 25 | -------------------------------------------------------------------------------- /test/DocSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, FlexibleContexts, ViewPatterns #-} 2 | 3 | module Main where 4 | 5 | import Data.List ( isSuffixOf ) 6 | import System.FilePath.Find 7 | import Test.DocTest 8 | import System.Environment 9 | import qualified Data.Text as T 10 | t = main 11 | 12 | -- e.g.: stack test :doc --file-watch --fast --test-arguments="Data.ZigZag Flat.Instances Flat.Instances.Base" 13 | main :: IO () 14 | main = do 15 | args <- getArgs 16 | -- print args 17 | files <- if length args > 0 18 | then return $ map 19 | ( T.unpack 20 | . (`T.append` ".hs") 21 | . ("src/" `T.append`) 22 | . T.replace "." "/" 23 | . T.pack 24 | ) 25 | args 26 | else find always ((extension ==? ".hs") &&? exceptFiles excepts) "src" 27 | -- print files 28 | runTests runOpts files 29 | -- genTests genOpts files 30 | 31 | runTests opts files = doctest $ opts ++ files 32 | 33 | excepts = ["src/ZM/Test.hs", "src/ZM/Pretty/Value.hs", "src/Data/Timeless.hs"] 34 | 35 | runOpts = ["--fast", "-XCPP"] 36 | 37 | genOpts = runOpts ++ ["-Dghcjs_HOST_OS", "-DETA"] 38 | 39 | exceptFiles :: Foldable t => t String -> FindClause Bool 40 | exceptFiles mdls = 41 | let excludes = liftOp (\fp modules -> not $ any (`isSuffixOf` fp) modules) 42 | in filePath `excludes` mdls 43 | -- let excludes = liftOp (\fp mdls -> not $ any (\mdl -> isSuffixOf mdl (traceShowId fp)) mdls) 44 | -------------------------------------------------------------------------------- /test/DocTest/Test.hs: -------------------------------------------------------------------------------- 1 | 2 | {-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-} 3 | module DocTest.Test where 4 | import qualified DocTest 5 | import Test.Tasty(TestTree,testGroup) 6 | import Test 7 | 8 | tests :: IO TestTree 9 | tests = testGroup "Test" <$> sequence [ DocTest.test "src/Test.hs:43" "[]" (DocTest.asPrint( ))] 10 | -------------------------------------------------------------------------------- /test/DocTest/ZM/AsValue.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables#-} 2 | 3 | {-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-} 4 | module DocTest.ZM.AsValue where 5 | import qualified DocTest 6 | import Test.Tasty(TestTree,testGroup) 7 | import ZM.AsValue 8 | import ZM 9 | import ZM.Abs 10 | import ZM.Pretty 11 | import Data.Word 12 | import Data.Int 13 | import ZM.Types 14 | import ZM.Parser.Types 15 | import ZM.Type.Words(Word7(..)) 16 | import Numeric.Natural 17 | import Test.QuickCheck.Instances.Natural 18 | import Data.List 19 | 20 | tests :: IO TestTree 21 | tests = testGroup "ZM.AsValue" <$> sequence [ DocTest.testProp "src/ZM/AsValue.hs:77" ( \(w::Word8) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:79" ( \(w::Word16) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:81" ( \(w::Word32) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:83" ( \(w::Word64) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:85" ( \(w::Natural) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:87" ( \(w::Int8) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:89" ( \(w::Int16) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:91" ( \(w::Int32) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:93" ( \(w::Int64) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:95" ( \(w::Int) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:97" ( \(w::Word) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:103" ( \(w::Integer) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:105" ( \(w::Float) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:107" ( \(w::Double) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:109" ( \(a1::Double,a2::Bool) -> unValue (value (a1,a2)) == (a1,a2) ), DocTest.testProp "src/ZM/AsValue.hs:111" ( \(a1::Double,a2::Bool,a3::Integer) -> unValue (value (a1,a2,a3)) == (a1,a2,a3) ), DocTest.testProp "src/ZM/AsValue.hs:113" ( \(a1::Double,a2::Bool,a3::Integer,a4::Word8) -> unValue (value (a1,a2,a3,a4)) == (a1,a2,a3,a4) ), DocTest.testProp "src/ZM/AsValue.hs:115" ( \(w::String) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:117" ( \(w::[Word16]) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:119" ( \(w::S.Seq Word16) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:127" ( \(w::M.Map Int32 Word8) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:144" ( \(w::Char) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:146" ( \(w::Maybe Bool) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:148" ( \(w::Either () Bool) -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:162" ( \(w::T.Text -> unValue (value w) == w ), DocTest.testProp "src/ZM/AsValue.hs:164" ( \(w::T.Text -> unValue (value (UTF8Text w)) == (UTF8Text w) ), DocTest.testProp "src/ZM/AsValue.hs:166" ( \(w::T.Text -> unValue (value (UTF16Text w)) == (UTF16Text w) ), DocTest.test "src/ZM/AsValue.hs:121" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w=Array [] ::Array Float in unValue (value w) == w )), DocTest.test "src/ZM/AsValue.hs:124" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w=Array [1,3..1000::Word16] in unValue (value w) == w )), DocTest.test "src/ZM/AsValue.hs:129" "[ExpectedLine [LineChunk \"()\"]]" (DocTest.asPrint( unValue (value ()) )), DocTest.test "src/ZM/AsValue.hs:132" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unValue (value E.NoEncoding) == NoEncoding )), DocTest.test "src/ZM/AsValue.hs:135" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unValue (value E.FlatEncoding) == FlatEncoding )), DocTest.test "src/ZM/AsValue.hs:138" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unValue (value E.UTF8Encoding) == UTF8Encoding )), DocTest.test "src/ZM/AsValue.hs:141" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unValue (value E.UTF16LEEncoding) == UTF16LEEncoding )), DocTest.test "src/ZM/AsValue.hs:150" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w=B.empty in unValue (value w) == w )), DocTest.test "src/ZM/AsValue.hs:153" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w=B.pack (replicate 300 33) in unValue (value w) == w )), DocTest.test "src/ZM/AsValue.hs:156" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w=L.pack (replicate 300 33) in unValue (value w) == w )), DocTest.test "src/ZM/AsValue.hs:159" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w=SBS.pack (replicate 300 33) in unValue (value w) == w )), DocTest.test "src/ZM/AsValue.hs:617" "[ExpectedLine [LineChunk \"0\"]]" (DocTest.asPrint( addLSFList [] )), DocTest.test "src/ZM/AsValue.hs:620" "[ExpectedLine [LineChunk \"3\"]]" (DocTest.asPrint( addLSFList [3] )), DocTest.test "src/ZM/AsValue.hs:623" "[ExpectedLine [LineChunk \"255\"]]" (DocTest.asPrint( addLSFList [127,1] )), DocTest.test "src/ZM/AsValue.hs:655" "[ExpectedLine [LineChunk \"24\"]]" (DocTest.asPrint( bitsVal [True,True,False,False,False] ))] 22 | -------------------------------------------------------------------------------- /test/DocTest/ZM/To/Decoder.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables#-} 2 | 3 | {-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-} 4 | module DocTest.ZM.To.Decoder where 5 | import qualified DocTest 6 | import Test.Tasty(TestTree,testGroup) 7 | import ZM.To.Decoder 8 | import ZM 9 | import ZM.Abs 10 | import ZM.Pretty 11 | import Data.Word 12 | import Data.Int 13 | import ZM.Types 14 | import ZM.Parser.Types 15 | 16 | tests :: IO TestTree 17 | tests = testGroup "ZM.To.Decoder" <$> sequence [ DocTest.test "src/ZM/To/Decoder.hs:41" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( decodeAbsTypeModel (absTypeModel (Proxy::Proxy Bool)) (flat True) == Right (Value {valType = TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28)), valName = "True", valBits = [True], valFields = []}) )), DocTest.test "src/ZM/To/Decoder.hs:44" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( decodeAbsTypeModel (absTypeModel (Proxy::Proxy (Maybe Bool))) (flat $ Just True) == Right (Value {valType = TypeApp (TypeCon (AbsRef (SHAKE128_48 218 104 54 119 143 212))) (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))), valName = "Just", valBits = [True], valFields = [Value {valType = TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28)), valName = "True", valBits = [True], valFields = []}]}) )), DocTest.test "src/ZM/To/Decoder.hs:49" "[ExpectedLine [LineChunk \"Left (TooMuchSpace \",WildCardChunk]]" (DocTest.asPrint( decodeAbsTypeModel (absTypeModel (Proxy::Proxy Word8)) (flat 1.1) )), DocTest.test "src/ZM/To/Decoder.hs:54" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( decodeAbsTypeModel (absTypeModel (Proxy::Proxy Word8)) (flat (11::Int)) == Right (Value {valType = TypeCon (AbsRef (SHAKE128_48 177 244 106 73 200 248)), valName = "V22", valBits = [False,False,False,True,False,True,True,False], valFields = []}) )), DocTest.test "src/ZM/To/Decoder.hs:57" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( decodeAbsTypeModel (absTypeModel (Proxy::Proxy Word8)) (flat (11::Word8)) == Right (Value {valType = TypeCon (AbsRef (SHAKE128_48 177 244 106 73 200 248)), valName = "V11", valBits = [False,False,False,False,True,False,True,True], valFields = []}) )), DocTest.test "src/ZM/To/Decoder.hs:62" "[ExpectedLine [LineChunk \"Right (Annotate (TypeApp (TypeCon (AbsRef (SHAKE128_48 218 104 54 119 143 212))) (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))),[True]) (ConstrF \\\"Just\\\" (Left [Annotate (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28)),[False]) (ConstrF \\\"False\\\" (Left []))])))\"]]" (DocTest.asPrint( decodeAbsTypeModel (absTypeModel (Proxy::Proxy (Maybe Bool))) (flat $ Just False) )), DocTest.test "src/ZM/To/Decoder.hs:65" "[ExpectedLine [LineChunk \"Right (Annotate (TypeCon (AbsRef (SHAKE128_48 6 109 181 42 241 69)),[]) (ConstrF \\\"Char\\\" (Left [Annotate (TypeCon (AbsRef (SHAKE128_48 36 18 121 156 153 241)),[]) (ConstrF \\\"Word32\\\" (Left [Annotate (TypeCon (AbsRef (SHAKE128_48 249 46 131 57 144 138)),[]) (ConstrF \\\"Word\\\" (Left [Annotate (TypeApp (TypeCon (AbsRef (SHAKE128_48 32 255 172 200 248 201))) (TypeApp (TypeCon (AbsRef (SHAKE128_48 191 45 28 134 235 32))) (TypeApp (TypeCon (AbsRef (SHAKE128_48 116 226 179 184 153 65))) (TypeCon (AbsRef (SHAKE128_48 244 201 70 51 74 126))))),[]) (ConstrF \\\"LeastSignificantFirst\\\" (Left [Annotate (TypeApp (TypeCon (AbsRef (SHAKE128_48 191 45 28 134 235 32))) (TypeApp (TypeCon (AbsRef (SHAKE128_48 116 226 179 184 153 65))) (TypeCon (AbsRef (SHAKE128_48 244 201 70 51 74 126)))),[False]) (ConstrF \\\"Elem\\\" (Left [Annotate (TypeApp (TypeCon (AbsRef (SHAKE128_48 116 226 179 184 153 65))) (TypeCon (AbsRef (SHAKE128_48 244 201 70 51 74 126))),[]) (ConstrF \\\"MostSignificantFirst\\\" (Left [Annotate (TypeCon (AbsRef (SHAKE128_48 244 201 70 51 74 126)),[True,True,False,False,False,False,True]) (ConstrF \\\"V97\\\" (Left []))]))]))]))]))]))])))\"]]" (DocTest.asPrint( decodeAbsTypeModel (absTypeModel (Proxy::Proxy Char)) (flat 'a') )), DocTest.test "src/ZM/To/Decoder.hs:68" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let Right (Value {valType = TypeApp (TypeCon (AbsRef (SHAKE128_48 184 205 19 24 113 152))) (TypeCon (AbsRef (SHAKE128_48 6 109 181 42 241 69))), valName = "Cons", valBits = [True] , valFields=_}) = decodeAbsTypeModel (absTypeModel (Proxy::Proxy String)) (flat "abc") in True ))] 18 | -------------------------------------------------------------------------------- /test/DocTests.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | import Test.Tasty 3 | import Test.Tasty.HUnit 4 | import qualified DocTest.Test 5 | 6 | main = (testGroup "DocTests" <$> sequence [DocTest.Test.tests]) >>= defaultMain 7 | -------------------------------------------------------------------------------- /test/Driver.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF tasty-discover -optF --modules="*Test.hs" -optF --debug #-} 2 | -------------------------------------------------------------------------------- /test/Info.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} 2 | module Info 3 | ( codes 4 | , models 5 | ) 6 | where 7 | import Data.Int 8 | import qualified Data.Sequence as S 9 | import Data.Word 10 | import Test.Data hiding ( Unit ) 11 | import Test.Data.Model ( ) 12 | import qualified Test.Data2 as Data2 13 | import qualified Test.Data3 as Data3 14 | import ZM 15 | 16 | -- m :: HTypeModel 17 | -- m = typeModel (Proxy :: Proxy (List (Data2.List (Data3.List Bool)))) 18 | 19 | -- a :: AbsTypeModel 20 | -- a = absTypeModel (Proxy :: Proxy (List (Data2.List (Data3.List Bool)))) 21 | 22 | models :: [AbsTypeModel] 23 | models = 24 | [ typ (Proxy :: Proxy AbsADT) 25 | , typ (Proxy :: Proxy Bool) 26 | , typ (Proxy :: Proxy (List Bool)) 27 | , typ (Proxy :: Proxy (Data2.List Bool)) 28 | , typ (Proxy :: Proxy (Data3.List Bool)) 29 | , typ (Proxy :: Proxy (List (Data2.List (Data3.List Bool)))) 30 | , typ (Proxy :: Proxy (Forest2 Bool)) 31 | , typ (Proxy :: Proxy Char) 32 | , typ (Proxy :: Proxy String) 33 | , typ (Proxy :: Proxy Word) 34 | , typ (Proxy :: Proxy Word8) 35 | , typ (Proxy :: Proxy Word16) 36 | , typ (Proxy :: Proxy Word32) 37 | , typ (Proxy :: Proxy Word64) 38 | , typ (Proxy :: Proxy Int) 39 | , typ (Proxy :: Proxy Int8) 40 | , typ (Proxy :: Proxy Int16) 41 | , typ (Proxy :: Proxy Int32) 42 | , typ (Proxy :: Proxy Int64) 43 | , typ (Proxy :: Proxy Integer) 44 | -- ,typ (Proxy :: Proxy (S.Seq Bool)) TODO: check, was array not is a list, changed in Flat 45 | , typ (Proxy :: Proxy (List Bool)) 46 | , typ (Proxy :: Proxy D2) 47 | , typ (Proxy :: Proxy D4) 48 | , typ (Proxy :: Proxy (Phantom ())) 49 | , typ (Proxy :: Proxy (Either Bool ())) 50 | , typ (Proxy :: Proxy (Either Bool Bool)) 51 | , typ (Proxy :: Proxy (RR Un () N)) 52 | , typ (Proxy :: Proxy (BLOB UTF8Encoding)) 53 | , typ (Proxy :: Proxy (BLOB UTF16LEEncoding)) 54 | ] 55 | where typ = absTypeModel 56 | 57 | codes :: [Type AbsRef] 58 | codes = 59 | [ TypeApp 60 | (TypeApp 61 | (TypeApp (TypeCon (AbsRef (SHAKE128_48 62 130 87 37 92 191))) 62 | (TypeCon (AbsRef (SHAKE128_48 220 38 233 217 0 71))) 63 | ) 64 | (TypeCon (AbsRef (SHAKE128_48 220 38 233 217 0 71))) 65 | ) 66 | (TypeApp (TypeCon (AbsRef (SHAKE128_48 7 177 176 69 172 60))) 67 | (TypeCon (AbsRef (SHAKE128_48 75 189 56 88 123 158))) 68 | ) 69 | , TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28)) 70 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 212 160 181 74 243 52))) 71 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 72 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 148 55 180 1 191 163))) 73 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 74 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 212 160 181 74 243 52))) 75 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 76 | , TypeApp 77 | (TypeCon (AbsRef (SHAKE128_48 212 160 181 74 243 52))) 78 | (TypeApp 79 | (TypeCon (AbsRef (SHAKE128_48 148 55 180 1 191 163))) 80 | (TypeApp (TypeCon (AbsRef (SHAKE128_48 212 160 181 74 243 52))) 81 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 82 | ) 83 | ) 84 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 144 198 49 59 57 208))) 85 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 86 | , TypeCon (AbsRef (SHAKE128_48 6 109 181 42 241 69)) 87 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 184 205 19 24 113 152))) 88 | (TypeCon (AbsRef (SHAKE128_48 6 109 181 42 241 69))) 89 | , TypeCon (AbsRef (SHAKE128_48 80 208 24 247 89 58)) 90 | , TypeCon (AbsRef (SHAKE128_48 177 244 106 73 200 248)) 91 | , TypeCon (AbsRef (SHAKE128_48 41 94 36 214 47 172)) 92 | , TypeCon (AbsRef (SHAKE128_48 36 18 121 156 153 241)) 93 | , TypeCon (AbsRef (SHAKE128_48 80 208 24 247 89 58)) 94 | , TypeCon (AbsRef (SHAKE128_48 251 148 203 77 78 222)) 95 | , TypeCon (AbsRef (SHAKE128_48 179 162 100 43 74 132)) 96 | , TypeCon (AbsRef (SHAKE128_48 61 172 107 212 250 156)) 97 | , TypeCon (AbsRef (SHAKE128_48 90 31 178 147 33 165)) 98 | , TypeCon (AbsRef (SHAKE128_48 251 148 203 77 78 222)) 99 | , TypeCon (AbsRef (SHAKE128_48 16 42 59 185 4 227)) 100 | -- , TypeApp (TypeCon (AbsRef (SHAKE128_48 46 139 69 25 174 170))) 101 | -- (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 102 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 212 160 181 74 243 52))) 103 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 104 | , TypeCon (AbsRef (SHAKE128_48 180 209 66 111 91 138)) 105 | , TypeCon (AbsRef (SHAKE128_48 179 88 47 48 3 203)) 106 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 204 16 207 144 173 119))) 107 | (TypeCon (AbsRef (SHAKE128_48 121 74 239 110 33 170))) 108 | , TypeApp 109 | (TypeApp (TypeCon (AbsRef (SHAKE128_48 98 96 228 101 174 116))) 110 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 111 | ) 112 | (TypeCon (AbsRef (SHAKE128_48 121 74 239 110 33 170))) 113 | , TypeApp 114 | (TypeApp (TypeCon (AbsRef (SHAKE128_48 98 96 228 101 174 116))) 115 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 116 | ) 117 | (TypeCon (AbsRef (SHAKE128_48 48 111 25 129 180 28))) 118 | , TypeApp 119 | (TypeApp 120 | (TypeApp (TypeCon (AbsRef (SHAKE128_48 58 94 167 13 35 164))) 121 | (TypeCon (AbsRef (SHAKE128_48 116 153 36 195 148 43))) 122 | ) 123 | (TypeCon (AbsRef (SHAKE128_48 121 74 239 110 33 170))) 124 | ) 125 | (TypeCon (AbsRef (SHAKE128_48 182 24 14 79 250 138))) 126 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 241 57 212 117 31 218))) 127 | (TypeCon (AbsRef (SHAKE128_48 15 68 139 232 5 128))) 128 | , TypeApp (TypeCon (AbsRef (SHAKE128_48 241 57 212 117 31 218))) 129 | (TypeCon (AbsRef (SHAKE128_48 193 183 198 207 63 81))) 130 | ] 131 | -------------------------------------------------------------------------------- /test/InfoSHA.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} 2 | module Info where 3 | 4 | import Data.Int 5 | import ZM 6 | import Data.Word 7 | import Test.Data hiding (Unit) 8 | import Test.Data.Flat hiding (Unit) 9 | import Test.Data.Model 10 | import qualified Test.Data2 as Data2 11 | import qualified Test.Data3 as Data3 12 | import qualified Data.Sequence as S 13 | 14 | models = [ 15 | typ (Proxy :: Proxy AbsADT) 16 | ,typ (Proxy :: Proxy Bool) 17 | ,typ (Proxy :: Proxy (List Bool)) 18 | ,typ (Proxy :: Proxy (Data2.List Bool)) 19 | ,typ (Proxy :: Proxy (Data3.List Bool)) 20 | ,typ (Proxy :: Proxy (List (Data2.List (Data3.List Bool)))) 21 | ,typ (Proxy :: Proxy (Forest2 Bool)) 22 | ,typ (Proxy :: Proxy Char) 23 | ,typ (Proxy :: Proxy String) 24 | ,typ (Proxy :: Proxy Word) 25 | ,typ (Proxy :: Proxy Word8) 26 | ,typ (Proxy :: Proxy Word16) 27 | ,typ (Proxy :: Proxy Word32) 28 | ,typ (Proxy :: Proxy Word64) 29 | ,typ (Proxy :: Proxy Int) 30 | ,typ (Proxy :: Proxy Int8) 31 | ,typ (Proxy :: Proxy Int16) 32 | ,typ (Proxy :: Proxy Int32) 33 | ,typ (Proxy :: Proxy Int64) 34 | ,typ (Proxy :: Proxy Integer) 35 | ,typ (Proxy :: Proxy (S.Seq Bool)) 36 | ,typ (Proxy :: Proxy (List Bool)) 37 | ,typ (Proxy:: Proxy D2) 38 | ,typ (Proxy :: Proxy D4) 39 | ,typ (Proxy :: Proxy (Phantom ())) 40 | ,typ (Proxy :: Proxy (Either Bool ())) 41 | ,typ (Proxy :: Proxy (Either Bool Bool)) 42 | ,typ (Proxy :: Proxy (RR Un () N)) 43 | ] 44 | where typ = absTypeModel 45 | 46 | codes = [TypeApp (TypeApp (TypeApp (TypeCon (AbsRef (SHA3_256_6 168 121 233 97 61 136))) (TypeCon (AbsRef (SHA3_256_6 10 197 162 77 118 54)))) (TypeCon (AbsRef (SHA3_256_6 10 197 162 77 118 54)))) (TypeApp (TypeCon (AbsRef (SHA3_256_6 122 206 49 124 168 130))) (TypeCon (AbsRef (SHA3_256_6 123 110 193 184 1 78)))) 47 | ,TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29)) 48 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 101 57 81 27 13 167))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29))) 49 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 102 100 14 127 233 210))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29))) 50 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 101 57 81 27 13 167))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29))) 51 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 101 57 81 27 13 167))) (TypeApp (TypeCon (AbsRef (SHA3_256_6 102 100 14 127 233 210))) (TypeApp (TypeCon (AbsRef (SHA3_256_6 101 57 81 27 13 167))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29))))) 52 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 53 50 106 30 119 81))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29))) 53 | ,TypeCon (AbsRef (SHA3_256_6 7 117 93 14 24 29)) 54 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 104 188 123 93 245 148))) (TypeCon (AbsRef (SHA3_256_6 7 117 93 14 24 29))) 55 | ,TypeCon (AbsRef (SHA3_256_6 166 79 5 101 124 185)) 56 | ,TypeCon (AbsRef (SHA3_256_6 9 220 228 4 7 148)) 57 | ,TypeCon (AbsRef (SHA3_256_6 157 196 6 176 134 110)) 58 | ,TypeCon (AbsRef (SHA3_256_6 55 196 92 68 135 146)) 59 | ,TypeCon (AbsRef (SHA3_256_6 166 79 5 101 124 185)) 60 | ,TypeCon (AbsRef (SHA3_256_6 8 245 185 37 4 152)) 61 | ,TypeCon (AbsRef (SHA3_256_6 119 192 116 209 194 141)) 62 | ,TypeCon (AbsRef (SHA3_256_6 177 142 103 96 187 181)) 63 | ,TypeCon (AbsRef (SHA3_256_6 45 3 206 152 7 34)) 64 | ,TypeCon (AbsRef (SHA3_256_6 8 245 185 37 4 152)) 65 | ,TypeCon (AbsRef (SHA3_256_6 168 236 150 6 16 84)) 66 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 46 45 234 102 228 168))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29))) 67 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 101 57 81 27 13 167))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29))) 68 | ,TypeCon (AbsRef (SHA3_256_6 217 161 185 121 114 16)) 69 | ,TypeCon (AbsRef (SHA3_256_6 143 138 35 109 231 29)) 70 | ,TypeApp (TypeCon (AbsRef (SHA3_256_6 97 93 162 205 14 216))) (TypeCon (AbsRef (SHA3_256_6 121 90 213 206 19 234))) 71 | ,TypeApp (TypeApp (TypeCon (AbsRef (SHA3_256_6 173 144 137 143 179 59))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29)))) (TypeCon (AbsRef (SHA3_256_6 121 90 213 206 19 234))) 72 | ,Typ[![Stackage Nightly](http://stackage.org/package/model/badge/nightly)](http://stackage.org/nightly/package/model) 73 | [![Stackage LTS](http://stackage.org/package/model/badge/lts)](http://stackage.org/lts/package/model) 74 | eApp (TypeApp (TypeCon (AbsRef (SHA3_256_6 173 144 137 143 179 59))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29)))) (TypeCon (AbsRef (SHA3_256_6 129 212 40 48 111 29))) 75 | ,TypeApp (TypeApp (TypeApp (TypeCon (AbsRef (SHA3_256_6 4 57 85 199 173 43))) (TypeCon (AbsRef (SHA3_256_6 162 203 228 37 70 146)))) (TypeCon (AbsRef (SHA3_256_6 121 90 213 206 19 234)))) (TypeCon (AbsRef (SHA3_256_6 33 235 4 113 180 240)))] 76 | 77 | -------------------------------------------------------------------------------- /test/Test/Data/Arbitrary.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP , ScopedTypeVariables #-} 2 | 3 | module Test.Data.Arbitrary where 4 | import qualified Data.ByteString as BS 5 | import qualified Data.ByteString.Lazy as BL 6 | import qualified Data.ByteString.Short as SBS 7 | import qualified Data.Text as TS 8 | import qualified Data.Text.Lazy as TL 9 | import Test.Tasty.QuickCheck 10 | import Test.Data 11 | -- import Data.DeriveTH 12 | 13 | #if MIN_VERSION_base(4,9,0) 14 | import qualified Data.List.NonEmpty as BI 15 | #endif 16 | 17 | import Numeric.Natural (Natural) 18 | 19 | #if MIN_VERSION_base(4,9,0) 20 | instance Arbitrary a => Arbitrary (BI.NonEmpty a) where 21 | arbitrary = BI.fromList . getNonEmpty <$> (arbitrary :: Gen (NonEmptyList a)) 22 | shrink xs = BI.fromList <$> shrink (BI.toList xs) 23 | #endif 24 | 25 | instance Arbitrary Natural where 26 | arbitrary = arbitrarySizedNatural 27 | shrink = shrinkIntegral 28 | 29 | -- Copied from quickcheck-instances (not used directly as it requires old-time that is incompatible with ghcjs) 30 | 31 | instance Arbitrary BS.ByteString where 32 | arbitrary = BS.pack <$> arbitrary 33 | shrink xs = BS.pack <$> shrink (BS.unpack xs) 34 | 35 | instance Arbitrary BL.ByteString where 36 | arbitrary = BL.pack <$> arbitrary 37 | shrink xs = BL.pack <$> shrink (BL.unpack xs) 38 | 39 | instance Arbitrary SBS.ShortByteString where 40 | arbitrary = SBS.pack <$> arbitrary 41 | shrink xs = SBS.pack <$> shrink (SBS.unpack xs) 42 | 43 | -- instance Arbitrary TS.Text where 44 | -- arbitrary = TS.pack <$> arbitrary 45 | -- shrink xs = TS.pack <$> shrink (TS.unpack xs) 46 | 47 | -- instance Arbitrary TL.Text where 48 | -- arbitrary = TL.pack <$> arbitrary 49 | -- shrink xs = TL.pack <$> shrink (TL.unpack xs) 50 | 51 | -- xxx = generate (arbitrary :: Gen (Large (Int))) 52 | 53 | {- 54 | -- derive makeArbitrary ''N 55 | derive makeArbitrary ''Tree 56 | 57 | derive makeArbitrary ''List 58 | 59 | derive makeArbitrary ''Unit 60 | 61 | derive makeArbitrary ''Un 62 | 63 | derive makeArbitrary ''A 64 | 65 | derive makeArbitrary ''B 66 | -} 67 | -- instance Arbitrary Word7 where arbitrary = toEnum <$> choose (0, 127) 68 | -- derive makeArbitrary ''ASCII 69 | -- To generate Arbitrary instances while avoiding a direct dependency on 'derive' (that is not supported by Eta) 70 | 71 | -- , run in the project directory: derive -a test/Test/Data.hs --derive=Arbitrary 72 | {-! 73 | deriving instance Arbitrary N 74 | deriving instance Arbitrary Tree 75 | deriving instance Arbitrary List 76 | deriving instance Arbitrary Unit 77 | deriving instance Arbitrary Un 78 | deriving instance Arbitrary A 79 | deriving instance Arbitrary B 80 | !-} 81 | -- GENERATED START 82 | instance () => Arbitrary N where 83 | arbitrary = do 84 | x <- choose (0 :: Int, 4) 85 | case x of 86 | 0 -> return One 87 | 1 -> return Two 88 | 2 -> return Three 89 | 3 -> return Four 90 | 4 -> return Five 91 | _ -> error "FATAL ERROR: Arbitrary instance, logic bug" 92 | 93 | instance (Arbitrary a) => Arbitrary (Tree a) where 94 | arbitrary = do 95 | x <- choose (0 :: Int, 1) 96 | case x of 97 | 0 -> do 98 | x1 <- arbitrary 99 | x2 <- arbitrary 100 | return (Node x1 x2) 101 | 1 -> Leaf <$> arbitrary 102 | _ -> error "FATAL ERROR: Arbitrary instance, logic bug" 103 | 104 | instance (Arbitrary a) => Arbitrary (List a) where 105 | arbitrary = do 106 | x <- choose (0 :: Int, 1) 107 | case x of 108 | 0 -> do 109 | x1 <- arbitrary 110 | x2 <- arbitrary 111 | return (C x1 x2) 112 | 1 -> return N 113 | _ -> error "FATAL ERROR: Arbitrary instance, logic bug" 114 | 115 | instance () => Arbitrary Unit where 116 | arbitrary = return Unit 117 | 118 | instance () => Arbitrary Un where 119 | arbitrary = Un <$> arbitrary 120 | 121 | instance () => Arbitrary A where 122 | arbitrary = do 123 | x <- choose (0 :: Int, 1) 124 | case x of 125 | 0 -> A <$> arbitrary 126 | 1 -> AA <$> arbitrary 127 | _ -> error "FATAL ERROR: Arbitrary instance, logic bug" 128 | 129 | instance () => Arbitrary B where 130 | arbitrary = do 131 | x <- choose (0 :: Int, 1) 132 | case x of 133 | 0 -> B <$> arbitrary 134 | 1 -> BB <$> arbitrary 135 | _ -> error "FATAL ERROR: Arbitrary instance, logic bug" 136 | -- GENERATED STOP 137 | -------------------------------------------------------------------------------- /test/Test/Data/Flat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE StandaloneDeriving #-} 5 | {-# LANGUAGE UndecidableInstances #-} 6 | 7 | module Test.Data.Flat ( 8 | module Test.Data, 9 | ) where 10 | 11 | import Data.Foldable 12 | import Data.Int 13 | import Data.Word 14 | import Flat 15 | import Flat.Decoder 16 | import Flat.Encoder 17 | import GHC.Generics 18 | import Test.Data 19 | import Test.Data2.Flat () 20 | 21 | {- 22 | Compilation times: 23 | encoderS specials cases | 24 | \| 7.10.3 | NO | 0:44 | 25 | \| 7.10.3 | YES | 0:39 | 26 | \| 8.0.1 | NO | 1:30 | 27 | \| 8.0.1 | YES | 1:30 | 28 | \| 8.0.2 | NO | 4:18 | 29 | \| 8.0.2 | YES | 4:18 | 30 | -} 31 | 32 | -- GHC 8.0.2 chokes on this 33 | -- instance Flat A0 34 | -- instance Flat B0 35 | -- instance Flat C0 36 | -- instance Flat D0 37 | -- instance Flat E0 38 | 39 | -- deriving instance Generic (a,b,c,d,e,f,g,h) 40 | -- deriving instance Generic (a,b,c,d,e,f,g,h,i) 41 | instance {-# OVERLAPPABLE #-} (Flat a, Flat b, Flat c, Flat d, Flat e, Flat f, Flat g, Flat h) => Flat (a, b, c, d, e, f, g, h) 42 | 43 | instance {-# OVERLAPPABLE #-} (Flat a, Flat b, Flat c, Flat d, Flat e, Flat f, Flat g, Flat h, Flat i) => Flat (a, b, c, d, e, f, g, h, i) 44 | 45 | instance Flat N 46 | 47 | instance Flat Unit 48 | 49 | instance (Flat a) => Flat (List a) 50 | 51 | instance (Flat a) => Flat (Tree a) 52 | 53 | instance Flat Direction 54 | 55 | instance Flat Words 56 | 57 | instance Flat Ints 58 | 59 | instance Flat Void 60 | 61 | instance Flat N3 62 | 63 | instance Flat Un 64 | 65 | instance (Flat a) => Flat (ListS a) 66 | 67 | instance Flat A 68 | 69 | instance Flat B 70 | 71 | instance Flat D2 72 | 73 | instance Flat D4 74 | 75 | instance (Flat a) => Flat (Phantom a) 76 | 77 | -- Slow to compile 78 | instance Flat Various 79 | 80 | -- Custom instances 81 | -- instance {-# OVERLAPPING #-} Flat (Tree (N,N,N)) --where 82 | -- size (Node t1 t2) = 1 + size t1 + size t2 83 | -- size (Leaf a) = 1 + size a 84 | 85 | -- -57% 86 | -- instance {-# OVERLAPPING #-} Flat [N] -- where size = foldl' (\s n -> s + 1 + size n) 1 87 | 88 | -- instance {-# OVERLAPPING #-} Flat (N,N,N) -- where 89 | -- {-# INLINE size #-} 90 | -- size (n1,n2,n3) = size n1 + size n2 + size n3 91 | 92 | -- -50% 93 | -- instance {-# OVERLAPPING #-} Flat (N,N,N) where 94 | -- {-# INLINE encode #-} 95 | -- encode (n1,n2,n3) = wprim $ (Step 9) (encodeN n1 >=> encodeN n2 >=> encodeN n3) 96 | -- {-# INLINE encodeN #-} 97 | -- encodeN = \case 98 | -- One -> eBitsF 2 0 99 | -- Two -> eBitsF 2 1 100 | -- Three -> eBitsF 2 2 101 | -- Four -> eBitsF 3 6 102 | -- Five -> eBitsF 3 7 103 | 104 | -- instance (Flat a, Flat b, Flat c) => Flat (RR a b c) 105 | -- instance Flat a => Flat (Perfect a) 106 | -- instance Flat a => Flat (Fork a) 107 | -- instance Flat a => Flat (Nest a) 108 | -- instance Flat a => Flat (Stream a) where decode = Stream <$> decode <*> decode 109 | -- instance Flat Expr 110 | 111 | -- instance (Flat a,Flat (f a),Flat (f (f a))) => Flat (PerfectF f a) 112 | 113 | -- instance Flat a => Flat (Stream a) 114 | 115 | {- 116 | | 117 | | 118 | One Two | 119 | Three | 120 | Four Five 121 | -} 122 | -- instance {-# OVERLAPPABLE #-} Flat a => Flat (Tree a) where 123 | -- encode (Node t1 t2) = eFalse <> encode t1 <> encode t2 124 | -- encode (Leaf a) = eTrue <> encode a 125 | 126 | -- instance {-# OVERLAPPING #-} Flat (Tree N) where 127 | -- encode (Node t1 t2) = eFalse <> encode t1 <> encode t2 128 | -- encode (Leaf a) = eTrue <> encode a 129 | 130 | -- -- -34% (why?) 131 | -- instance Flat N where 132 | -- {-# INLINE encode #-} 133 | -- encode = \case 134 | -- One -> eBits 2 0 135 | -- Two -> eBits 2 1 136 | -- Three -> eBits 2 2 137 | -- Four -> eBits 3 6 138 | -- Five -> eBits 3 7 139 | 140 | -- instance {-# OVERLAPPING #-} Flat (Tree N) 141 | -- where 142 | -- {-# INLINE decode #-} 143 | -- decode = do 144 | -- tag <- dBool 145 | -- if tag 146 | -- then Leaf <$> decode 147 | -- else Node <$> decode <*> decode 148 | 149 | -- instance Flat N 150 | -- where 151 | -- {-# INLINE decode #-} 152 | -- decode = do 153 | -- tag <- dBool 154 | -- if tag 155 | -- then do 156 | -- tag <- dBool 157 | -- if tag 158 | -- then do 159 | -- tag <- dBool 160 | -- if tag 161 | -- then return Five 162 | -- else return Four 163 | -- else return Three 164 | -- else do 165 | -- tag <- dBool 166 | -- if tag 167 | -- then return Two 168 | -- else return One 169 | 170 | -- {-# INLINE size #-} 171 | -- size n s = s + case n of 172 | -- One -> 2 173 | -- Two -> 2 174 | -- Three -> 2 175 | -- Four -> 3 176 | -- Five -> 3 177 | 178 | -- instance Flat N where 179 | -- instance {-# OVERLAPPING #-} Flat (Tree N) -- where 180 | 181 | -- -- {-# INLINE encode #-} 182 | -- encode (Node t1 t2) = Writer $ \s -> do 183 | -- !s1 <- runWriter eFalse s 184 | -- !s2 <- runWriter (encode t1) s1 185 | -- s3 <- runWriter (encode t2) s2 186 | -- return s3 187 | 188 | -- encode (Leaf a) = Writer $ \s -> do 189 | -- s1 <- runWriter eTrue s 190 | -- runWriter (encode a) s1 191 | 192 | -- size (Node t1 t2) = 1 + size t1 + size t2 193 | -- size (Leaf a) = 1 + size a 194 | 195 | -- instance Flat N 196 | -------------------------------------------------------------------------------- /test/Test/Data/Model.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} 2 | module Test.Data.Model where 3 | 4 | import Data.Model 5 | import Test.Data 6 | import qualified Test.Data2 as Data2 7 | import qualified Test.Data3 as Data3 8 | --import Data.Word() 9 | --import GHC.Generics() 10 | --import Data.Proxy 11 | --import Data.Typeable 12 | 13 | -- instance Model Word8 14 | -- instance Model Words 15 | -- instance Model Ints 16 | 17 | -- instance Model ADT 18 | -- instance Model MM0 19 | -- instance Model MM1 20 | -- instance Model MM2 21 | -- instance Model MM3 22 | -- instance Model MM4 23 | -- instance Model MM5 24 | -- instance Model MM6 25 | 26 | instance Model Void 27 | instance Model Unit 28 | 29 | instance Model N3 30 | instance Model N 31 | instance Model Un 32 | instance Model D2 33 | instance Model D4 34 | instance Model A0 35 | instance Model B0 36 | instance Model C0 37 | instance Model D0 38 | instance Model E0 39 | 40 | --instance Model Various 41 | instance Model a => Model (Phantom a) 42 | instance Model a => Model (Data2.List a) 43 | instance Model a => Model (Data3.List a) 44 | instance Model a => Model (List a) 45 | instance Model a => Model (ListS a) 46 | instance Model a => Model (Tree a) 47 | instance (Model a, Model b, Model c) => Model (RR a b c) 48 | instance Model Expr 49 | instance Model a => Model (Perfect a) 50 | instance Model a => Model (Fork a) 51 | instance Model a => Model (Forest a) 52 | instance Model a => Model (Tr a) 53 | instance Model t => Model (ForestD t) 54 | instance (Model f,Model a) => Model (TrD f a) 55 | instance Model a => Model (Forest2 a) 56 | instance Model a => Model (Tr2 a) 57 | 58 | -- Higher kind 59 | -- instance (Model a,Model f) => Model (Higher f a) 60 | -- instance (Model (f a),Typeable f,Model a) => Model (PerfectF f a) 61 | -- instance (Model v,Model (f v),Model a) => Model (Free f a) 62 | 63 | -- instance Model a => Model (E a) 64 | -------------------------------------------------------------------------------- /test/Test/Data2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses ,DeriveGeneric ,DeriveDataTypeable ,ScopedTypeVariables ,GADTs ,NoMonomorphismRestriction ,DeriveGeneric ,DefaultSignatures ,TemplateHaskell ,TypeFamilies ,FlexibleContexts ,FlexibleInstances ,EmptyDataDecls #-} 2 | module Test.Data2 where 3 | 4 | import Data.Typeable 5 | import Data.Data 6 | import GHC.Generics 7 | 8 | -- A definition with the same name of a definition in Test.Data, used to test for name clashes.a 9 | data List a = Cons2 a (List a) 10 | | Nil2 11 | deriving (Eq, Ord, Read, Show, Typeable, Data, Generic ,Generic1) 12 | 13 | -------------------------------------------------------------------------------- /test/Test/Data2/Flat.hs: -------------------------------------------------------------------------------- 1 | module Test.Data2.Flat 2 | ( module Test.Data2 3 | ) 4 | where 5 | import Flat 6 | import Test.Data2 7 | 8 | instance Flat a => Flat (List a) 9 | -------------------------------------------------------------------------------- /test/Test/Data3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses ,DeriveGeneric ,DeriveDataTypeable ,ScopedTypeVariables ,GADTs ,NoMonomorphismRestriction ,DeriveGeneric ,DefaultSignatures ,TemplateHaskell ,TypeFamilies ,FlexibleContexts ,FlexibleInstances ,EmptyDataDecls #-} 2 | module Test.Data3 where 3 | 4 | import Data.Typeable 5 | import Data.Data 6 | import GHC.Generics 7 | 8 | -- A definition identical to the one in Test.Data, used to test for name clashes. 9 | data List a = C a (List a) 10 | | N 11 | deriving (Eq, Ord, Read, Show, Typeable, Data, Generic ,Generic1) 12 | 13 | -------------------------------------------------------------------------------- /test/Test/Data3/Flat.hs: -------------------------------------------------------------------------------- 1 | module Test.Data3.Flat 2 | ( module Test.Data3 3 | ) 4 | where 5 | import Flat 6 | import Test.Data3 7 | 8 | instance Flat a => Flat (List a) 9 | -------------------------------------------------------------------------------- /test/Test/E/Binary.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE StandaloneDeriving ,DeriveAnyClass #-} 2 | module Test.E.Binary where 3 | 4 | import Test.E 5 | import Data.Binary 6 | 7 | deriving instance Binary E2 8 | deriving instance Binary E4 9 | deriving instance Binary E8 10 | deriving instance Binary E16 11 | deriving instance Binary E32 12 | deriving instance Binary E256 13 | deriving instance Binary E258 14 | 15 | -- fs = 16 | -- [ Binary E2_1 17 | -- , Binary E32_1 18 | -- , Binary E256_255 19 | -- , Binary E256_254 20 | -- , Binary E256_253 21 | -- , Binary E256_256 22 | -- ] 23 | 24 | 25 | -------------------------------------------------------------------------------- /test/Test/E/Flat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE StandaloneDeriving #-} 4 | module Test.E.Flat() where 5 | 6 | import Flat 7 | import Flat.Decoder() 8 | import Flat.Encoder() 9 | import Test.E 10 | 11 | t = putStrLn $ gen 4 12 | 13 | -- Test only, incorrect instances 14 | -- Not faster than generated ones (at least up to E16) 15 | gen :: Int -> String 16 | gen numBits = 17 | let dt = "E"++show n 18 | n = 2 ^ numBits 19 | cs = zip [1..] $ map ((\n -> dt ++ "_" ++ n) . show) [1 .. n] 20 | dec n c = unwords [" ",n,"-> return",c] 21 | in unlines [ 22 | unwords ["instance Flat",dt,"where"] 23 | ," size _ n = n+"++ show numBits 24 | ," encode a = case a of" 25 | ,unlines $ map (\(n,c) -> unwords [" ",c,"-> eBits16",show numBits,show n]) cs 26 | ," decode = do" 27 | ," tag <- dBEBits8 " ++ show numBits 28 | ," case tag of" 29 | ,unlines $ map (\(n,c) -> dec (show n) c) cs 30 | ,dec "_" (snd $ last cs) 31 | ] 32 | 33 | 34 | deriving instance Flat S3 35 | deriving instance Flat E2 36 | deriving instance Flat E3 37 | deriving instance Flat E4 38 | deriving instance Flat E8 39 | deriving instance Flat E16 40 | deriving instance Flat E17 41 | deriving instance Flat E32 42 | 43 | #ifdef ENUM_LARGE 44 | deriving instance Flat E256 45 | deriving instance Flat E258 46 | #endif 47 | 48 | -- fs = 49 | -- [ flat E2_1,flat E3_1 50 | -- , flat E4_1 51 | -- , flat E8_1 52 | -- , flat E16_1 53 | -- , flat E32_1 54 | -- , flat E256_255 55 | -- , flat E256_254 56 | -- , flat E256_253 57 | -- , flat E256_256 58 | -- ] 59 | 60 | 61 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/ADT/K3e8257255cbf.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.ADT.K3e8257255cbf (ADT(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word8.Kb1f46a49c8f8 9 | import qualified Test.ZM.ADT.Maybe.Kda6836778fd4 10 | import qualified Test.ZM.ADT.ConTree.K86653e040025 11 | 12 | data ADT a b c = ADT {declName :: a, 13 | declNumParameters :: Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8, 14 | declCons :: Test.ZM.ADT.Maybe.Kda6836778fd4.Maybe (Test.ZM.ADT.ConTree.K86653e040025.ConTree b 15 | c)} 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance ( Data.Model.Model a,Data.Model.Model b,Data.Model.Model c ) => Data.Model.Model ( ADT a b c ) 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/ADTRef/K07b1b045ac3c.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.ADTRef.K07b1b045ac3c (ADTRef(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word8.Kb1f46a49c8f8 9 | 10 | data ADTRef a = Var Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 11 | | Rec 12 | | Ext a 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance ( Data.Model.Model a ) => Data.Model.Model ( ADTRef a ) 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/AbsRef/K4bbd38587b9e.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.AbsRef.K4bbd38587b9e (AbsRef(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.SHAKE128_48.K9f214799149b 9 | import qualified Test.ZM.ADT.ADT.K3e8257255cbf 10 | import qualified Test.ZM.ADT.Identifier.Kdc26e9d90047 11 | import qualified Test.ZM.ADT.ADTRef.K07b1b045ac3c 12 | 13 | newtype AbsRef = AbsRef (Test.ZM.ADT.SHAKE128_48.K9f214799149b.SHAKE128_48 (Test.ZM.ADT.ADT.K3e8257255cbf.ADT Test.ZM.ADT.Identifier.Kdc26e9d90047.Identifier 14 | Test.ZM.ADT.Identifier.Kdc26e9d90047.Identifier 15 | (Test.ZM.ADT.ADTRef.K07b1b045ac3c.ADTRef Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef))) 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance Data.Model.Model AbsRef 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/All.hs: -------------------------------------------------------------------------------- 1 | module Test.ZM.ADT.All where 2 | import Test.ZM.ADT.ZigZag.K03226796ede4 () 3 | import Test.ZM.ADT.RepoProtocol.K05c7d893e9d5 () 4 | import Test.ZM.ADT.Char.K066db52af145 () 5 | import Test.ZM.ADT.ADTRef.K07b1b045ac3c () 6 | import Test.ZM.ADT.HostPort.K0ab5ac6303b9 () 7 | import Test.ZM.ADT.User.K0e1df25dc480 () 8 | import Test.ZM.ADT.UTF8Encoding.K0f448be80580 () 9 | import Test.ZM.ADT.Int.K102a3bb904e3 () 10 | import Test.ZM.ADT.Content.K1ba230d92eb8 () 11 | import Test.ZM.ADT.SHA3_256_6.K2008e8e3f4a4 () 12 | import Test.ZM.ADT.LeastSignificantFirst.K20ffacc8f8c9 () 13 | import Test.ZM.ADT.Word32.K2412799c99f1 () 14 | import Test.ZM.ADT.Word16.K295e24d62fac () 15 | import Test.ZM.ADT.Array.K2e8b4519aeaa () 16 | import Test.ZM.ADT.Bool.K306f1981b41c () 17 | import Test.ZM.ADT.UnicodeLetterOrNumberOrLine.K33445520c45a () 18 | import Test.ZM.ADT.Bits23.K338888222364 () 19 | import Test.ZM.ADT.UnicodeLetter.K3878b3580fc5 () 20 | import Test.ZM.ADT.Int16.K3dac6bd4fa9c () 21 | import Test.ZM.ADT.ADT.K3e8257255cbf () 22 | import Test.ZM.ADT.AbsRef.K4bbd38587b9e () 23 | import Test.ZM.ADT.III.K4cf5dd973ae4 () 24 | import Test.ZM.ADT.Word64.K50d018f7593a () 25 | import Test.ZM.ADT.Sign.K549f91f3b0ec () 26 | import Test.ZM.ADT.Message.K551d9f2adb72 () 27 | import Test.ZM.ADT.TypedBLOB.K614edd84c8bd () 28 | import Test.ZM.ADT.Either.K6260e465ae74 () 29 | import Test.ZM.ADT.HostAddress.K64f93d94a73d () 30 | import Test.ZM.ADT.Bit.K65149ce3b366 () 31 | import Test.ZM.ADT.IP4Address.K6cb2ee3ac409 () 32 | import Test.ZM.ADT.Type.K7028aa556ebc () 33 | import Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941 () 34 | import Test.ZM.ADT.Unit.K794aef6e21aa () 35 | import Test.ZM.ADT.UnicodeSymbol.K801030ef543c () 36 | import Test.ZM.ADT.ConTree.K86653e040025 () 37 | import Test.ZM.ADT.ByType.K87f090a54ea3 () 38 | import Test.ZM.ADT.Bits11.K8ae75e67a616 () 39 | import Test.ZM.ADT.Content.K957357183935 () 40 | import Test.ZM.ADT.FlatEncoding.K982148c09ddb () 41 | import Test.ZM.ADT.Bits8.K9e3b8c835fe9 () 42 | import Test.ZM.ADT.SHAKE128_48.K9f214799149b () 43 | import Test.ZM.ADT.ByAny.Ka4d0bf8f6fb5 () 44 | import Test.ZM.ADT.Tuple2.Ka5583bf3ad34 () 45 | import Test.ZM.ADT.Celsius.Ka5782c1002a5 () 46 | import Test.ZM.ADT.Filler.Kae1dfeece189 () 47 | import Test.ZM.ADT.Word8.Kb1f46a49c8f8 () 48 | import Test.ZM.ADT.PreAligned.Kb2f28cf37d12 () 49 | import Test.ZM.ADT.Int8.Kb3a2642b4a84 () 50 | import Test.ZM.ADT.IEEE_754_binary32.Kb53bec846608 () 51 | import Test.ZM.ADT.List.Kb8cd13187198 () 52 | import Test.ZM.ADT.NonEmptyList.Kbf2d1c86eb20 () 53 | import Test.ZM.ADT.Match.Kc23b20389114 () 54 | import Test.ZM.ADT.ChannelSelectionResult.Kc6627a317dbc () 55 | import Test.ZM.ADT.WebSocketAddress.Kc802c6aae1af () 56 | import Test.ZM.ADT.IEEE_754_binary64.Kcba9596b4657 () 57 | import Test.ZM.ADT.ByPattern.Kcf6c76b3f808 () 58 | import Test.ZM.ADT.Maybe.Kda6836778fd4 () 59 | import Test.ZM.ADT.Identifier.Kdc26e9d90047 () 60 | import Test.ZM.ADT.SensorReading.Ke45682c11f7b () 61 | import Test.ZM.ADT.SocketAddress.Ke5d02571ce7b () 62 | import Test.ZM.ADT.StoreProtocol.Ke83859e52e9a () 63 | import Test.ZM.ADT.BLOB.Kf139d4751fda () 64 | import Test.ZM.ADT.Time.Kf3f0f3c453f7 () 65 | import Test.ZM.ADT.Word7.Kf4c946334a7e () 66 | import Test.ZM.ADT.Bits52.Kf727da8aa8ad () 67 | import Test.ZM.ADT.Bytes.Kf8844385a443 () 68 | import Test.ZM.ADT.Word.Kf92e8339908a () 69 | import Test.ZM.ADT.Msg.Kfb89a57cdc09 () 70 | import Test.ZM.ADT.Int64.Kfb94cb4d4ede () 71 | import Test.ZM.ADT.Subject.Kfced5b0f3c1f () 72 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Array/K2e8b4519aeaa.hs: -------------------------------------------------------------------------------- 1 | module Test.ZM.ADT.Array.K2e8b4519aeaa (module ZM.Prim) where 2 | import ZM.Prim(Array) 3 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/BLOB/Kf139d4751fda.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.BLOB.Kf139d4751fda (BLOB(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Bytes.Kf8844385a443 9 | 10 | data BLOB a = BLOB {encoding :: a, 11 | content :: Test.ZM.ADT.Bytes.Kf8844385a443.Bytes} 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance ( Data.Model.Model a ) => Data.Model.Model ( BLOB a ) 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Bit/K65149ce3b366.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Bit.K65149ce3b366 (Bit(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Bit = V0 10 | | V1 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Bit 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Bits11/K8ae75e67a616.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Bits11.K8ae75e67a616 (Bits11(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Bit.K65149ce3b366 9 | 10 | data Bits11 = Bits11 {bit0 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 11 | bit1 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 12 | bit2 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 13 | bit3 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 14 | bit4 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 15 | bit5 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 16 | bit6 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 17 | bit7 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 18 | bit8 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 19 | bit9 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 20 | bit10 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit} 21 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 22 | instance Data.Model.Model Bits11 23 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Bits23/K338888222364.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Bits23.K338888222364 (Bits23(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Bit.K65149ce3b366 9 | 10 | data Bits23 = Bits23 {bit0 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 11 | bit1 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 12 | bit2 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 13 | bit3 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 14 | bit4 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 15 | bit5 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 16 | bit6 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 17 | bit7 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 18 | bit8 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 19 | bit9 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 20 | bit10 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 21 | bit11 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 22 | bit12 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 23 | bit13 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 24 | bit14 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 25 | bit15 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 26 | bit16 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 27 | bit17 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 28 | bit18 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 29 | bit19 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 30 | bit20 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 31 | bit21 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 32 | bit22 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit} 33 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 34 | instance Data.Model.Model Bits23 35 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Bits52/Kf727da8aa8ad.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Bits52.Kf727da8aa8ad (Bits52(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Bit.K65149ce3b366 9 | 10 | data Bits52 = Bits52 {bit0 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 11 | bit1 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 12 | bit2 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 13 | bit3 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 14 | bit4 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 15 | bit5 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 16 | bit6 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 17 | bit7 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 18 | bit8 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 19 | bit9 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 20 | bit10 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 21 | bit11 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 22 | bit12 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 23 | bit13 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 24 | bit14 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 25 | bit15 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 26 | bit16 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 27 | bit17 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 28 | bit18 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 29 | bit19 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 30 | bit20 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 31 | bit21 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 32 | bit22 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 33 | bit23 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 34 | bit24 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 35 | bit25 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 36 | bit26 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 37 | bit27 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 38 | bit28 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 39 | bit29 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 40 | bit30 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 41 | bit31 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 42 | bit32 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 43 | bit33 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 44 | bit34 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 45 | bit35 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 46 | bit36 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 47 | bit37 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 48 | bit38 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 49 | bit39 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 50 | bit40 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 51 | bit41 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 52 | bit42 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 53 | bit43 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 54 | bit44 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 55 | bit45 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 56 | bit46 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 57 | bit47 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 58 | bit48 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 59 | bit49 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 60 | bit50 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 61 | bit51 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit} 62 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 63 | instance Data.Model.Model Bits52 64 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Bits8/K9e3b8c835fe9.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Bits8.K9e3b8c835fe9 (Bits8(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Bit.K65149ce3b366 9 | 10 | data Bits8 = Bits8 {bit0 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 11 | bit1 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 12 | bit2 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 13 | bit3 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 14 | bit4 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 15 | bit5 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 16 | bit6 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit, 17 | bit7 :: Test.ZM.ADT.Bit.K65149ce3b366.Bit} 18 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 19 | instance Data.Model.Model Bits8 20 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Bool/K306f1981b41c.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Bool.K306f1981b41c (Bool(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Bool = False 10 | | True 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Bool 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/ByAny/Ka4d0bf8f6fb5.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.ByAny.Ka4d0bf8f6fb5 (ByAny(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data ByAny a = ByAny 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance ( Data.Model.Model a ) => Data.Model.Model ( ByAny a ) 12 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/ByPattern/Kcf6c76b3f808.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.ByPattern.Kcf6c76b3f808 (ByPattern(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.List.Kb8cd13187198 9 | import qualified Test.ZM.ADT.Match.Kc23b20389114 10 | import qualified Test.ZM.ADT.Bit.K65149ce3b366 11 | 12 | newtype ByPattern a = ByPattern (Test.ZM.ADT.List.Kb8cd13187198.List (Test.ZM.ADT.Match.Kc23b20389114.Match (Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Bit.K65149ce3b366.Bit))) 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance ( Data.Model.Model a ) => Data.Model.Model ( ByPattern a ) 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/ByType/K87f090a54ea3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.ByType.K87f090a54ea3 (ByType(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data ByType a = ByType 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance ( Data.Model.Model a ) => Data.Model.Model ( ByType a ) 12 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Bytes/Kf8844385a443.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Bytes.Kf8844385a443 (Bytes(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.PreAligned.Kb2f28cf37d12 9 | import qualified Test.ZM.ADT.Array.K2e8b4519aeaa 10 | import qualified Test.ZM.ADT.Word8.Kb1f46a49c8f8 11 | 12 | newtype Bytes = Bytes (Test.ZM.ADT.PreAligned.Kb2f28cf37d12.PreAligned (Test.ZM.ADT.Array.K2e8b4519aeaa.Array Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8)) 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance Data.Model.Model Bytes 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Celsius/Ka5782c1002a5.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Celsius.Ka5782c1002a5 (Celsius(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.IEEE_754_binary32.Kb53bec846608 9 | 10 | newtype Celsius = Celsius Test.ZM.ADT.IEEE_754_binary32.Kb53bec846608.IEEE_754_binary32 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Celsius 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/ChannelSelectionResult/Kc6627a317dbc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.ChannelSelectionResult.Kc6627a317dbc (ChannelSelectionResult(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.List.Kb8cd13187198 9 | import qualified Test.ZM.ADT.Char.K066db52af145 10 | 11 | data ChannelSelectionResult a = Success 12 | | Failure {reason :: Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Char.K066db52af145.Char} 13 | | RetryAt a 14 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 15 | instance ( Data.Model.Model a ) => Data.Model.Model ( ChannelSelectionResult a ) 16 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Char/K066db52af145.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Char.K066db52af145 (Char(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word32.K2412799c99f1 9 | 10 | newtype Char = Char Test.ZM.ADT.Word32.K2412799c99f1.Word32 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Char 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/ConTree/K86653e040025.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.ConTree.K86653e040025 (ConTree(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Either.K6260e465ae74 9 | import qualified Test.ZM.ADT.List.Kb8cd13187198 10 | import qualified Test.ZM.ADT.Type.K7028aa556ebc 11 | import qualified Test.ZM.ADT.Tuple2.Ka5583bf3ad34 12 | 13 | data ConTree a b = Con {constrName :: a, 14 | constrFields :: Test.ZM.ADT.Either.K6260e465ae74.Either (Test.ZM.ADT.List.Kb8cd13187198.List (Test.ZM.ADT.Type.K7028aa556ebc.Type b)) 15 | (Test.ZM.ADT.List.Kb8cd13187198.List (Test.ZM.ADT.Tuple2.Ka5583bf3ad34.Tuple2 a 16 | (Test.ZM.ADT.Type.K7028aa556ebc.Type b)))} 17 | | ConTree (Test.ZM.ADT.ConTree.K86653e040025.ConTree a b) 18 | (Test.ZM.ADT.ConTree.K86653e040025.ConTree a b) 19 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 20 | instance ( Data.Model.Model a,Data.Model.Model b ) => Data.Model.Model ( ConTree a b ) 21 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Content/K1ba230d92eb8.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Content.K1ba230d92eb8 (Content(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.List.Kb8cd13187198 9 | import qualified Test.ZM.ADT.Char.K066db52af145 10 | 11 | data Content = TextMsg (Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Char.K066db52af145.Char) 12 | | Join 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance Data.Model.Model Content 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Content/K957357183935.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Content.K957357183935 (Content(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.List.Kb8cd13187198 9 | import qualified Test.ZM.ADT.Char.K066db52af145 10 | 11 | data Content a 12 | b = TextMessage (Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Char.K066db52af145.Char) 13 | | AskSubSubjects 14 | | Join 15 | | Leave 16 | | Ping 17 | | AskUsers 18 | | Users (Test.ZM.ADT.List.Kb8cd13187198.List a) 19 | | AskHistory 20 | | History (Test.ZM.ADT.List.Kb8cd13187198.List b) 21 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 22 | instance ( Data.Model.Model a,Data.Model.Model b ) => Data.Model.Model ( Content a b ) 23 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Either/K6260e465ae74.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Either.K6260e465ae74 (Either(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Either a b = Left a 10 | | Right b 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance ( Data.Model.Model a,Data.Model.Model b ) => Data.Model.Model ( Either a b ) 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Filler/Kae1dfeece189.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Filler.Kae1dfeece189 (Filler(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Filler = FillerBit Test.ZM.ADT.Filler.Kae1dfeece189.Filler 10 | | FillerEnd 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Filler 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/FlatEncoding/K982148c09ddb.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.FlatEncoding.K982148c09ddb (FlatEncoding(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data FlatEncoding = FlatEncoding 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance Data.Model.Model FlatEncoding 12 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/HostAddress/K64f93d94a73d.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.HostAddress.K64f93d94a73d (HostAddress(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.List.Kb8cd13187198 9 | import qualified Test.ZM.ADT.Char.K066db52af145 10 | 11 | data HostAddress a = IPAddress a 12 | | DNSAddress (Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Char.K066db52af145.Char) 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance ( Data.Model.Model a ) => Data.Model.Model ( HostAddress a ) 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/HostPort/K0ab5ac6303b9.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.HostPort.K0ab5ac6303b9 (HostPort(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word16.K295e24d62fac 9 | 10 | newtype HostPort = HostPort {port :: Test.ZM.ADT.Word16.K295e24d62fac.Word16} 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model HostPort 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/IEEE_754_binary32/Kb53bec846608.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.IEEE_754_binary32.Kb53bec846608 (IEEE_754_binary32(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Sign.K549f91f3b0ec 9 | import qualified Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941 10 | import qualified Test.ZM.ADT.Bits8.K9e3b8c835fe9 11 | import qualified Test.ZM.ADT.Bits23.K338888222364 12 | 13 | data IEEE_754_binary32 = IEEE_754_binary32 {sign :: Test.ZM.ADT.Sign.K549f91f3b0ec.Sign, 14 | exponent :: Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941.MostSignificantFirst Test.ZM.ADT.Bits8.K9e3b8c835fe9.Bits8, 15 | fraction :: Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941.MostSignificantFirst Test.ZM.ADT.Bits23.K338888222364.Bits23} 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance Data.Model.Model IEEE_754_binary32 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/IEEE_754_binary64/Kcba9596b4657.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.IEEE_754_binary64.Kcba9596b4657 (IEEE_754_binary64(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Sign.K549f91f3b0ec 9 | import qualified Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941 10 | import qualified Test.ZM.ADT.Bits11.K8ae75e67a616 11 | import qualified Test.ZM.ADT.Bits52.Kf727da8aa8ad 12 | 13 | data IEEE_754_binary64 = IEEE_754_binary64 {sign :: Test.ZM.ADT.Sign.K549f91f3b0ec.Sign, 14 | exponent :: Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941.MostSignificantFirst Test.ZM.ADT.Bits11.K8ae75e67a616.Bits11, 15 | fraction :: Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941.MostSignificantFirst Test.ZM.ADT.Bits52.Kf727da8aa8ad.Bits52} 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance Data.Model.Model IEEE_754_binary64 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/III/K4cf5dd973ae4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.III.K4cf5dd973ae4 (III(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Int8.Kb3a2642b4a84 9 | import qualified Test.ZM.ADT.Int16.K3dac6bd4fa9c 10 | import qualified Test.ZM.ADT.Int64.Kfb94cb4d4ede 11 | import qualified Test.ZM.ADT.IEEE_754_binary32.Kb53bec846608 12 | import qualified Test.ZM.ADT.IEEE_754_binary64.Kcba9596b4657 13 | import qualified Test.ZM.ADT.Int.K102a3bb904e3 14 | 15 | data III = III {w8 :: Test.ZM.ADT.Int8.Kb3a2642b4a84.Int8, 16 | w16 :: Test.ZM.ADT.Int16.K3dac6bd4fa9c.Int16, 17 | w :: Test.ZM.ADT.Int64.Kfb94cb4d4ede.Int64, 18 | i8 :: Test.ZM.ADT.Int8.Kb3a2642b4a84.Int8, 19 | i :: Test.ZM.ADT.Int64.Kfb94cb4d4ede.Int64, 20 | f :: Test.ZM.ADT.IEEE_754_binary32.Kb53bec846608.IEEE_754_binary32, 21 | d :: Test.ZM.ADT.IEEE_754_binary64.Kcba9596b4657.IEEE_754_binary64, 22 | ii :: Test.ZM.ADT.Int.K102a3bb904e3.Int} 23 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 24 | instance Data.Model.Model III 25 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/IP4Address/K6cb2ee3ac409.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.IP4Address.K6cb2ee3ac409 (IP4Address(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word8.Kb1f46a49c8f8 9 | 10 | data IP4Address = IP4Address Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 11 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 12 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 13 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 14 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 15 | instance Data.Model.Model IP4Address 16 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Identifier/Kdc26e9d90047.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Identifier.Kdc26e9d90047 (Identifier(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.UnicodeLetter.K3878b3580fc5 9 | import qualified Test.ZM.ADT.List.Kb8cd13187198 10 | import qualified Test.ZM.ADT.UnicodeLetterOrNumberOrLine.K33445520c45a 11 | import qualified Test.ZM.ADT.NonEmptyList.Kbf2d1c86eb20 12 | import qualified Test.ZM.ADT.UnicodeSymbol.K801030ef543c 13 | 14 | data Identifier = Name Test.ZM.ADT.UnicodeLetter.K3878b3580fc5.UnicodeLetter 15 | (Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.UnicodeLetterOrNumberOrLine.K33445520c45a.UnicodeLetterOrNumberOrLine) 16 | | Symbol (Test.ZM.ADT.NonEmptyList.Kbf2d1c86eb20.NonEmptyList Test.ZM.ADT.UnicodeSymbol.K801030ef543c.UnicodeSymbol) 17 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 18 | instance Data.Model.Model Identifier 19 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Int/K102a3bb904e3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Int.K102a3bb904e3 (Int(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.ZigZag.K03226796ede4 9 | import qualified Test.ZM.ADT.Word.Kf92e8339908a 10 | 11 | newtype Int = Int (Test.ZM.ADT.ZigZag.K03226796ede4.ZigZag Test.ZM.ADT.Word.Kf92e8339908a.Word) 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance Data.Model.Model Int 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Int16/K3dac6bd4fa9c.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Int16.K3dac6bd4fa9c (Int16(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.ZigZag.K03226796ede4 9 | import qualified Test.ZM.ADT.Word16.K295e24d62fac 10 | 11 | newtype Int16 = Int16 (Test.ZM.ADT.ZigZag.K03226796ede4.ZigZag Test.ZM.ADT.Word16.K295e24d62fac.Word16) 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance Data.Model.Model Int16 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Int64/Kfb94cb4d4ede.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Int64.Kfb94cb4d4ede (Int64(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.ZigZag.K03226796ede4 9 | import qualified Test.ZM.ADT.Word64.K50d018f7593a 10 | 11 | newtype Int64 = Int64 (Test.ZM.ADT.ZigZag.K03226796ede4.ZigZag Test.ZM.ADT.Word64.K50d018f7593a.Word64) 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance Data.Model.Model Int64 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Int8/Kb3a2642b4a84.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Int8.Kb3a2642b4a84 (Int8(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.ZigZag.K03226796ede4 9 | import qualified Test.ZM.ADT.Word8.Kb1f46a49c8f8 10 | 11 | newtype Int8 = Int8 (Test.ZM.ADT.ZigZag.K03226796ede4.ZigZag Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8) 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance Data.Model.Model Int8 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/LeastSignificantFirst/K20ffacc8f8c9.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.LeastSignificantFirst.K20ffacc8f8c9 (LeastSignificantFirst(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | newtype LeastSignificantFirst a = LeastSignificantFirst a 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance ( Data.Model.Model a ) => Data.Model.Model ( LeastSignificantFirst a ) 12 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/List/Kb8cd13187198.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.List.Kb8cd13187198 (List(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data List a = Nil 10 | | Cons a (Test.ZM.ADT.List.Kb8cd13187198.List a) 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance ( Data.Model.Model a ) => Data.Model.Model ( List a ) 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Match/Kc23b20389114.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Match.Kc23b20389114 (Match(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Type.K7028aa556ebc 9 | import qualified Test.ZM.ADT.AbsRef.K4bbd38587b9e 10 | 11 | data Match a = MatchValue a 12 | | MatchAny (Test.ZM.ADT.Type.K7028aa556ebc.Type Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef) 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance ( Data.Model.Model a ) => Data.Model.Model ( Match a ) 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Maybe/Kda6836778fd4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Maybe.Kda6836778fd4 (Maybe(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Maybe a = Nothing 10 | | Just a 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance ( Data.Model.Model a ) => Data.Model.Model ( Maybe a ) 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Message/K551d9f2adb72.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Message.K551d9f2adb72 (Message(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.User.K0e1df25dc480 9 | import qualified Test.ZM.ADT.Subject.Kfced5b0f3c1f 10 | import qualified Test.ZM.ADT.Content.K957357183935 11 | 12 | data Message = Message {fromUser :: Test.ZM.ADT.User.K0e1df25dc480.User, 13 | subject :: Test.ZM.ADT.Subject.Kfced5b0f3c1f.Subject, 14 | content :: Test.ZM.ADT.Content.K957357183935.Content Test.ZM.ADT.User.K0e1df25dc480.User 15 | Test.ZM.ADT.Message.K551d9f2adb72.Message} 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance Data.Model.Model Message 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/MostSignificantFirst/K74e2b3b89941.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941 (MostSignificantFirst(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | newtype MostSignificantFirst a = MostSignificantFirst a 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance ( Data.Model.Model a ) => Data.Model.Model ( MostSignificantFirst a ) 12 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Msg/Kfb89a57cdc09.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Msg.Kfb89a57cdc09 (Msg(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.List.Kb8cd13187198 9 | import qualified Test.ZM.ADT.Char.K066db52af145 10 | import qualified Test.ZM.ADT.Subject.Kfced5b0f3c1f 11 | import qualified Test.ZM.ADT.Content.K1ba230d92eb8 12 | 13 | data Msg = Msg {fromUser :: Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Char.K066db52af145.Char, 14 | subject :: Test.ZM.ADT.Subject.Kfced5b0f3c1f.Subject, 15 | content :: Test.ZM.ADT.Content.K1ba230d92eb8.Content} 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance Data.Model.Model Msg 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/NonEmptyList/Kbf2d1c86eb20.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.NonEmptyList.Kbf2d1c86eb20 (NonEmptyList(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data NonEmptyList a = Elem a 10 | | Cons a (Test.ZM.ADT.NonEmptyList.Kbf2d1c86eb20.NonEmptyList a) 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance ( Data.Model.Model a ) => Data.Model.Model ( NonEmptyList a ) 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/PreAligned/Kb2f28cf37d12.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.PreAligned.Kb2f28cf37d12 (PreAligned(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Filler.Kae1dfeece189 9 | 10 | data PreAligned a = PreAligned {preFiller :: Test.ZM.ADT.Filler.Kae1dfeece189.Filler, 11 | preValue :: a} 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance ( Data.Model.Model a ) => Data.Model.Model ( PreAligned a ) 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/RepoProtocol/K05c7d893e9d5.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.RepoProtocol.K05c7d893e9d5 (RepoProtocol(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.ADT.K3e8257255cbf 9 | import qualified Test.ZM.ADT.Identifier.Kdc26e9d90047 10 | import qualified Test.ZM.ADT.ADTRef.K07b1b045ac3c 11 | import qualified Test.ZM.ADT.AbsRef.K4bbd38587b9e 12 | import qualified Test.ZM.ADT.List.Kb8cd13187198 13 | import qualified Test.ZM.ADT.Tuple2.Ka5583bf3ad34 14 | 15 | data RepoProtocol = Record (Test.ZM.ADT.ADT.K3e8257255cbf.ADT Test.ZM.ADT.Identifier.Kdc26e9d90047.Identifier 16 | Test.ZM.ADT.Identifier.Kdc26e9d90047.Identifier 17 | (Test.ZM.ADT.ADTRef.K07b1b045ac3c.ADTRef Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef)) 18 | | Solve Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef 19 | | Solved Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef 20 | (Test.ZM.ADT.ADT.K3e8257255cbf.ADT Test.ZM.ADT.Identifier.Kdc26e9d90047.Identifier 21 | Test.ZM.ADT.Identifier.Kdc26e9d90047.Identifier 22 | (Test.ZM.ADT.ADTRef.K07b1b045ac3c.ADTRef Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef)) 23 | | AskDataTypes 24 | | KnownDataTypes (Test.ZM.ADT.List.Kb8cd13187198.List (Test.ZM.ADT.Tuple2.Ka5583bf3ad34.Tuple2 Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef 25 | (Test.ZM.ADT.ADT.K3e8257255cbf.ADT Test.ZM.ADT.Identifier.Kdc26e9d90047.Identifier 26 | Test.ZM.ADT.Identifier.Kdc26e9d90047.Identifier 27 | (Test.ZM.ADT.ADTRef.K07b1b045ac3c.ADTRef Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef)))) 28 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 29 | instance Data.Model.Model RepoProtocol 30 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/SHA3_256_6/K2008e8e3f4a4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.SHA3_256_6.K2008e8e3f4a4 (SHA3_256_6(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word8.Kb1f46a49c8f8 9 | 10 | data SHA3_256_6 a = SHA3_256_6 Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 11 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 12 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 13 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 14 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 15 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance ( Data.Model.Model a ) => Data.Model.Model ( SHA3_256_6 a ) 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/SHAKE128_48/K9f214799149b.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.SHAKE128_48.K9f214799149b (SHAKE128_48(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word8.Kb1f46a49c8f8 9 | 10 | data SHAKE128_48 a = SHAKE128_48 Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 11 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 12 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 13 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 14 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 15 | Test.ZM.ADT.Word8.Kb1f46a49c8f8.Word8 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance ( Data.Model.Model a ) => Data.Model.Model ( SHAKE128_48 a ) 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/SensorReading/Ke45682c11f7b.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.SensorReading.Ke45682c11f7b (SensorReading(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data SensorReading a b = SensorReading {reading :: a, 10 | location :: b} 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance ( Data.Model.Model a,Data.Model.Model b ) => Data.Model.Model ( SensorReading a b ) 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Sign/K549f91f3b0ec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Sign.K549f91f3b0ec (Sign(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Sign = Positive 10 | | Negative 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Sign 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/SocketAddress/Ke5d02571ce7b.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.SocketAddress.Ke5d02571ce7b (SocketAddress(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.HostAddress.K64f93d94a73d 9 | import qualified Test.ZM.ADT.HostPort.K0ab5ac6303b9 10 | 11 | data SocketAddress a = SocketAddress {socketAddress :: Test.ZM.ADT.HostAddress.K64f93d94a73d.HostAddress a, 12 | socketPort :: Test.ZM.ADT.HostPort.K0ab5ac6303b9.HostPort} 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance ( Data.Model.Model a ) => Data.Model.Model ( SocketAddress a ) 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/StoreProtocol/Ke83859e52e9a.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.StoreProtocol.Ke83859e52e9a (StoreProtocol(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.SHAKE128_48.K9f214799149b 9 | 10 | data StoreProtocol a = Save a 11 | | Solve (Test.ZM.ADT.SHAKE128_48.K9f214799149b.SHAKE128_48 a) 12 | | Solved (Test.ZM.ADT.SHAKE128_48.K9f214799149b.SHAKE128_48 a) a 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance ( Data.Model.Model a ) => Data.Model.Model ( StoreProtocol a ) 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Subject/Kfced5b0f3c1f.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Subject.Kfced5b0f3c1f (Subject(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.List.Kb8cd13187198 9 | import qualified Test.ZM.ADT.Char.K066db52af145 10 | 11 | newtype Subject = Subject (Test.ZM.ADT.List.Kb8cd13187198.List (Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Char.K066db52af145.Char)) 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance Data.Model.Model Subject 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Time/Kf3f0f3c453f7.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Time.Kf3f0f3c453f7 (Time(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Int.K102a3bb904e3 9 | import qualified Test.ZM.ADT.Word32.K2412799c99f1 10 | 11 | data Time = Time {utcDay :: Test.ZM.ADT.Int.K102a3bb904e3.Int, 12 | utcSecs :: Test.ZM.ADT.Word32.K2412799c99f1.Word32} 13 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 14 | instance Data.Model.Model Time 15 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Tuple2/Ka5583bf3ad34.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Tuple2.Ka5583bf3ad34 (Tuple2(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Tuple2 a b = Tuple2 a b 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance ( Data.Model.Model a,Data.Model.Model b ) => Data.Model.Model ( Tuple2 a b ) 12 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Type/K7028aa556ebc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Type.K7028aa556ebc (Type(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Type a = TypeCon a 10 | | TypeApp (Test.ZM.ADT.Type.K7028aa556ebc.Type a) 11 | (Test.ZM.ADT.Type.K7028aa556ebc.Type a) 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance ( Data.Model.Model a ) => Data.Model.Model ( Type a ) 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/TypedBLOB/K614edd84c8bd.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.TypedBLOB.K614edd84c8bd (TypedBLOB(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Type.K7028aa556ebc 9 | import qualified Test.ZM.ADT.AbsRef.K4bbd38587b9e 10 | import qualified Test.ZM.ADT.BLOB.Kf139d4751fda 11 | import qualified Test.ZM.ADT.FlatEncoding.K982148c09ddb 12 | 13 | data TypedBLOB = TypedBLOB (Test.ZM.ADT.Type.K7028aa556ebc.Type Test.ZM.ADT.AbsRef.K4bbd38587b9e.AbsRef) 14 | (Test.ZM.ADT.BLOB.Kf139d4751fda.BLOB Test.ZM.ADT.FlatEncoding.K982148c09ddb.FlatEncoding) 15 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 16 | instance Data.Model.Model TypedBLOB 17 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/UTF8Encoding/K0f448be80580.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.UTF8Encoding.K0f448be80580 (UTF8Encoding(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data UTF8Encoding = UTF8Encoding 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance Data.Model.Model UTF8Encoding 12 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/UnicodeLetter/K3878b3580fc5.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.UnicodeLetter.K3878b3580fc5 (UnicodeLetter(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Char.K066db52af145 9 | 10 | newtype UnicodeLetter = UnicodeLetter Test.ZM.ADT.Char.K066db52af145.Char 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model UnicodeLetter 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/UnicodeLetterOrNumberOrLine/K33445520c45a.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.UnicodeLetterOrNumberOrLine.K33445520c45a (UnicodeLetterOrNumberOrLine(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Char.K066db52af145 9 | 10 | newtype UnicodeLetterOrNumberOrLine = UnicodeLetterOrNumberOrLine Test.ZM.ADT.Char.K066db52af145.Char 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model UnicodeLetterOrNumberOrLine 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/UnicodeSymbol/K801030ef543c.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.UnicodeSymbol.K801030ef543c (UnicodeSymbol(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Char.K066db52af145 9 | 10 | newtype UnicodeSymbol = UnicodeSymbol Test.ZM.ADT.Char.K066db52af145.Char 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model UnicodeSymbol 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Unit/K794aef6e21aa.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Unit.K794aef6e21aa (Unit(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | data Unit = Unit 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance Data.Model.Model Unit 12 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/User/K0e1df25dc480.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.User.K0e1df25dc480 (User(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.List.Kb8cd13187198 9 | import qualified Test.ZM.ADT.Char.K066db52af145 10 | 11 | newtype User = User {userName :: Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Char.K066db52af145.Char} 12 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 13 | instance Data.Model.Model User 14 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/WebSocketAddress/Kc802c6aae1af.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.WebSocketAddress.Kc802c6aae1af (WebSocketAddress(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Bool.K306f1981b41c 9 | import qualified Test.ZM.ADT.SocketAddress.Ke5d02571ce7b 10 | import qualified Test.ZM.ADT.List.Kb8cd13187198 11 | import qualified Test.ZM.ADT.Char.K066db52af145 12 | 13 | data WebSocketAddress a = WebSocketAddress {secure :: Test.ZM.ADT.Bool.K306f1981b41c.Bool, 14 | host :: Test.ZM.ADT.SocketAddress.Ke5d02571ce7b.SocketAddress a, 15 | path :: Test.ZM.ADT.List.Kb8cd13187198.List Test.ZM.ADT.Char.K066db52af145.Char} 16 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 17 | instance ( Data.Model.Model a ) => Data.Model.Model ( WebSocketAddress a ) 18 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Word/Kf92e8339908a.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Word.Kf92e8339908a (Word(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.LeastSignificantFirst.K20ffacc8f8c9 9 | import qualified Test.ZM.ADT.NonEmptyList.Kbf2d1c86eb20 10 | import qualified Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941 11 | import qualified Test.ZM.ADT.Word7.Kf4c946334a7e 12 | 13 | newtype Word = Word (Test.ZM.ADT.LeastSignificantFirst.K20ffacc8f8c9.LeastSignificantFirst (Test.ZM.ADT.NonEmptyList.Kbf2d1c86eb20.NonEmptyList (Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941.MostSignificantFirst Test.ZM.ADT.Word7.Kf4c946334a7e.Word7))) 14 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 15 | instance Data.Model.Model Word 16 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Word16/K295e24d62fac.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Word16.K295e24d62fac (Word16(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word.Kf92e8339908a 9 | 10 | newtype Word16 = Word16 Test.ZM.ADT.Word.Kf92e8339908a.Word 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Word16 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Word32/K2412799c99f1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Word32.K2412799c99f1 (Word32(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word.Kf92e8339908a 9 | 10 | newtype Word32 = Word32 Test.ZM.ADT.Word.Kf92e8339908a.Word 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Word32 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Word64/K50d018f7593a.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.Word64.K50d018f7593a (Word64(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | import qualified Test.ZM.ADT.Word.Kf92e8339908a 9 | 10 | newtype Word64 = Word64 Test.ZM.ADT.Word.Kf92e8339908a.Word 11 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 12 | instance Data.Model.Model Word64 13 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Word7/Kf4c946334a7e.hs: -------------------------------------------------------------------------------- 1 | module Test.ZM.ADT.Word7.Kf4c946334a7e (module ZM.Prim) where 2 | import ZM.Prim(Word7) 3 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/Word8/Kb1f46a49c8f8.hs: -------------------------------------------------------------------------------- 1 | module Test.ZM.ADT.Word8.Kb1f46a49c8f8 (module ZM.Prim) where 2 | import ZM.Prim(Word8) 3 | -------------------------------------------------------------------------------- /test/Test/ZM/ADT/ZigZag/K03226796ede4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Test.ZM.ADT.ZigZag.K03226796ede4 (ZigZag(..)) where 4 | import qualified Prelude(Eq,Ord,Show) 5 | import qualified GHC.Generics 6 | import qualified Flat 7 | import qualified Data.Model 8 | 9 | newtype ZigZag a = ZigZag a 10 | deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, GHC.Generics.Generic, Flat.Flat) 11 | instance ( Data.Model.Model a ) => Data.Model.Model ( ZigZag a ) 12 | -------------------------------------------------------------------------------- /test/ZM/Prim.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric ,CPP #-} 3 | 4 | module ZM.Prim(Z.Word7,H.Word8,Z.Array(..)) where 5 | import Flat 6 | import Flat.Decoder 7 | import Flat.Encoder 8 | -- import Data.Model 9 | import qualified Data.Word as H 10 | -- import ZM.Type.Generate 11 | import qualified ZM.Type.Array as Z 12 | import qualified ZM.Type.Words as Z 13 | import ZM.Model() 14 | 15 | -- type Word7 = H.Word8 16 | 17 | 18 | -- -- |A 7 bits unsigned integer 19 | -- -- data Word7 = V0 .. V127 20 | -- data Word7 = Word7 H.Word8 deriving (Eq, Ord, Show, Generic) 21 | -- instance Model Word7 where envType = useCT word7CT 22 | 23 | 24 | 25 | -- TO BE CHECKED 26 | instance Flat Z.Word7 where 27 | encode (Z.Word7 w) = eBits 7 w 28 | decode = Z.Word7 <$> dBEBits8 7 29 | size _ n = n+7 30 | 31 | -- -- |An 8 bits unsigned integer 32 | -- -- data Word8 = V0 | V1 .. | V255 33 | -- data Word8 = Word8 H.Word8 deriving (Eq, Ord, Show, Generic) 34 | -- instance Model Word8 where envType = useCT word8CT 35 | 36 | -- instance Model H.Word8 where envType = useCT word8CT 37 | 38 | 39 | -- instance Flat Word8 where 40 | -- encode (Word8 w) = encode w 41 | -- decode = Word8 <$> decode 42 | -- size _ n = n+8 43 | 44 | -------------------------------------------------------------------------------- /zm.cabal: -------------------------------------------------------------------------------- 1 | name: zm 2 | version: 0.3.11 3 | synopsis: Language independent, reproducible, absolute types 4 | description: See the . 5 | homepage: http://github.com/Quid2/zm 6 | category: Data,Reflection 7 | license: BSD3 8 | license-file: LICENSE 9 | author: Pasqualino `Titto` Assini 10 | maintainer: tittoassini@gmail.com 11 | copyright: Copyright: (c) 2016-2023 Pasqualino `Titto` Assini 12 | cabal-version: >=1.10 13 | build-type: Simple 14 | tested-with: GHC ==8.10.7 || ==9.2.5 || ==9.4.8 15 | extra-source-files: README.md 16 | 17 | -- stack.yaml 18 | source-repository head 19 | type: git 20 | location: https://github.com/Quid2/zm 21 | 22 | library 23 | exposed-modules: 24 | Data.Annotate 25 | Data.Digest.Keccak 26 | Data.List.Extra 27 | Data.These.Extra 28 | ZM 29 | ZM.Abs 30 | ZM.AsValue 31 | ZM.BLOB 32 | ZM.BLOB.BLOBList 33 | ZM.Model 34 | ZM.Parser 35 | ZM.Parser.ADT 36 | ZM.Parser.Bracket 37 | ZM.Parser.Doc 38 | ZM.Parser.Env 39 | ZM.Parser.Exp 40 | ZM.Parser.Lexer 41 | ZM.Parser.Literal 42 | ZM.Parser.Op 43 | ZM.Parser.Pretty 44 | ZM.Parser.Types 45 | ZM.Parser.Util 46 | ZM.Parser.Val 47 | ZM.Parser.Value 48 | ZM.Pretty 49 | ZM.Pretty.Base 50 | ZM.To.Decoder 51 | ZM.To.Encoder 52 | ZM.Transform 53 | ZM.Type.Array 54 | ZM.Type.Bit 55 | ZM.Type.Bits11 56 | ZM.Type.Bits23 57 | ZM.Type.Bits52 58 | ZM.Type.Bits8 59 | ZM.Type.BLOB 60 | ZM.Type.Char 61 | ZM.Type.Float32 62 | ZM.Type.Float64 63 | ZM.Type.Function 64 | ZM.Type.Generate 65 | ZM.Type.List 66 | ZM.Type.Map 67 | ZM.Type.NonEmptyList 68 | ZM.Type.Prims 69 | ZM.Type.Repo 70 | ZM.Type.Repo0 71 | ZM.Type.String 72 | ZM.Type.Tuples 73 | ZM.Type.Unit 74 | ZM.Type.Words 75 | ZM.Types 76 | ZM.Util 77 | 78 | -- ZM.Parser.Constr 79 | -- ZM.Dynamic 80 | -- ZM.Pretty.Value 81 | -- ZM.Pretty.Value 82 | 83 | -- ZM.Coerce 84 | if impl(ghcjs) 85 | build-depends: ghcjs-base >=0.2 && <0.3 86 | 87 | else 88 | build-depends: 89 | cryptonite >=0.22 && <1 90 | , memory 91 | 92 | build-depends: 93 | aeson 94 | , base >=4.8 95 | , bytestring >=0.10.6.0 96 | , containers 97 | , data-fix 98 | , deepseq >=1.4 99 | , deriving-compat 100 | , directory 101 | , either >=4.3.2.0 && <6 102 | , extra 103 | , flat >=0.6 && <0.7 104 | , megaparsec >=9 && <10 105 | , model >=0.5 && <0.6 106 | , parser-combinators 107 | , pretty >=1.1.2 108 | , prettyprinter 109 | , prettyprinter-ansi-terminal 110 | , QuickCheck 111 | , quickcheck-instances 112 | , scientific 113 | , text 114 | , these-skinny 115 | , transformers >=0.4.2.0 116 | 117 | -- TODO: REMOVE QuickCheck 118 | js-sources: jsbits/sha3.js 119 | default-language: Haskell2010 120 | hs-source-dirs: src 121 | 122 | -- ghc-options: -O2 -funbox-strict-fields -Wall -fno-warn-orphans -fno-warn-name-shadowing 123 | -- if impl(ghc >8) 124 | ghc-options: 125 | -Wall -funbox-strict-fields -fno-warn-orphans 126 | -Wincomplete-record-updates -Wincomplete-uni-patterns 127 | -Wredundant-constraints 128 | 129 | -- -Werror 130 | 131 | -- -fno-warn-name-shadowing 132 | 133 | test-suite spec 134 | type: exitcode-stdio-1.0 135 | main-is: Spec.hs 136 | build-depends: 137 | base 138 | , bytestring 139 | , containers 140 | , flat 141 | , model 142 | , pretty 143 | , tasty 144 | , tasty-hunit 145 | , tasty-quickcheck 146 | , text 147 | , timeit >=1 148 | , zm 149 | 150 | default-language: Haskell2010 151 | hs-source-dirs: test 152 | other-modules: 153 | Info 154 | Test.Data 155 | Test.Data.Flat 156 | Test.Data.Model 157 | Test.Data2 158 | Test.Data2.Flat 159 | Test.Data3 160 | Test.Data3.Flat 161 | Test.ZM.ADT.AbsRef.K4bbd38587b9e 162 | Test.ZM.ADT.ADT.K3e8257255cbf 163 | Test.ZM.ADT.ADTRef.K07b1b045ac3c 164 | Test.ZM.ADT.Array.K2e8b4519aeaa 165 | Test.ZM.ADT.BLOB.Kf139d4751fda 166 | Test.ZM.ADT.Bool.K306f1981b41c 167 | Test.ZM.ADT.Bytes.Kf8844385a443 168 | Test.ZM.ADT.Char.K066db52af145 169 | Test.ZM.ADT.ConTree.K86653e040025 170 | Test.ZM.ADT.Either.K6260e465ae74 171 | Test.ZM.ADT.Filler.Kae1dfeece189 172 | Test.ZM.ADT.FlatEncoding.K982148c09ddb 173 | Test.ZM.ADT.Identifier.Kdc26e9d90047 174 | Test.ZM.ADT.LeastSignificantFirst.K20ffacc8f8c9 175 | Test.ZM.ADT.List.Kb8cd13187198 176 | Test.ZM.ADT.Maybe.Kda6836778fd4 177 | Test.ZM.ADT.MostSignificantFirst.K74e2b3b89941 178 | Test.ZM.ADT.NonEmptyList.Kbf2d1c86eb20 179 | Test.ZM.ADT.PreAligned.Kb2f28cf37d12 180 | Test.ZM.ADT.SHAKE128_48.K9f214799149b 181 | Test.ZM.ADT.Tuple2.Ka5583bf3ad34 182 | Test.ZM.ADT.Type.K7028aa556ebc 183 | Test.ZM.ADT.TypedBLOB.K614edd84c8bd 184 | Test.ZM.ADT.UnicodeLetter.K3878b3580fc5 185 | Test.ZM.ADT.UnicodeLetterOrNumberOrLine.K33445520c45a 186 | Test.ZM.ADT.UnicodeSymbol.K801030ef543c 187 | Test.ZM.ADT.Word.Kf92e8339908a 188 | Test.ZM.ADT.Word32.K2412799c99f1 189 | Test.ZM.ADT.Word7.Kf4c946334a7e 190 | Test.ZM.ADT.Word8.Kb1f46a49c8f8 191 | ZM.Prim 192 | 193 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 194 | 195 | -- test-suite doc 196 | -- default-language: Haskell2010 197 | -- type: exitcode-stdio-1.0 198 | -- ghc-options: -threaded 199 | -- main-is: DocSpec.hs 200 | -- hs-source-dirs: test 201 | -- build-depends: 202 | -- base 203 | -- , directory 204 | -- , doctest ==0.16.3.1 205 | -- , filemanip >=0.3.6.3 206 | -- , QuickCheck >=2.14.2 207 | -- , quickcheck-instances >0.3.27 208 | -- , text 209 | 210 | --------------------------------------------------------------------------------