]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/Repr/Tree/Read/Test.hs
Rewrite hcompta-lcc to use new symantic.
[comptalang.git] / cli / Hcompta / Repr / Tree / Read / Test.hs
1 {-# LANGUAGE ConstraintKinds #-}
2 {-# LANGUAGE ExistentialQuantification #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE InstanceSigs #-}
6 {-# LANGUAGE KindSignatures #-}
7 {-# LANGUAGE MultiParamTypeClasses #-}
8 {-# LANGUAGE NoMonomorphismRestriction #-}
9 {-# LANGUAGE NoPolyKinds #-}
10 {-# LANGUAGE OverloadedStrings #-}
11 {-# LANGUAGE Rank2Types #-}
12 {-# LANGUAGE ScopedTypeVariables #-}
13 {-# LANGUAGE TupleSections #-}
14
15 module Repr.Tree.Read.Test where
16
17 import Test.Tasty
18 import Test.Tasty.HUnit
19 import Control.Monad (Monad(..))
20 import Control.Monad.IO.Class (MonadIO(..))
21 import Control.Applicative (Applicative(..), Const(..))
22 import Data.Bool (Bool(..))
23 import Data.Either (Either(..))
24 import Data.Eq (Eq(..))
25 import Data.Function (($), (.), id)
26 import Data.Functor (Functor(..), (<$>))
27 import Data.Monoid ((<>))
28 import Data.String (String)
29 import Data.Int (Int)
30 import Data.Text (Text)
31 import qualified Data.Text as Text
32 import Data.Text.Buildable (Buildable(..))
33 import Data.Text.Lazy.Builder as Build
34 import Text.Read (Read, reads)
35 import Text.Show (Show(..))
36 import Prelude (error, print, IO, undefined, succ)
37 import GHC.Prim (Constraint)
38 import Data.Proxy (Proxy(..))
39
40 import Hcompta.Expr.Lit
41 import Hcompta.Expr.Bool
42 import Hcompta.Expr.Fun
43 import Hcompta.Expr.Dup
44 import qualified Expr.Dup.Test as Dup
45 import Hcompta.Repr
46 import Hcompta.Type
47
48 tests :: TestTree
49 tests = testGroup "Read" $
50 {-let (==>) (tree::Tree) expected@(text::Text) =
51 fun_lit_bool_from (Proxy::Proxy (Type_Fun_Lit_Bool_End repr)) tree $ \ty repr ->
52 case ty of
53 Type_Fun_Next (Type_Litkkk)
54 case of
55 Left err -> testCase (show expected) $ "" @?= "Error: " <> err
56 Right (expr_write {-`Dup` expr_meta-}) ->
57 testGroup (show expected)
58 [ testCase "Text" $ Build.toLazyText (repr_text_write expr_write) @?= text
59 -- , testCase "Meta" $ repr_meta expr_meta >>= (@?= meta)
60 ] in
61 [ Tree "And" [Tree "Bool" [Tree "True"], Tree "Bool" [Tree "False"]]
62 ==> "True & False"
63 ]-}
64 []
65 {-
66 let (==>) tree expected@(text, meta) =
67 case fromTree tree of
68 Left err -> testCase (show expected) $ "" @?= "Error: " <> err
69 Right (expr_write `Dup` expr_meta) ->
70 testGroup (show expected)
71 [ testCase "text" $ Build.toLazyText (repr_text_write expr_write) @?= text
72 , testCase "meta" $ repr_meta expr_meta >>= (@?= meta)
73 ] in
74 [ testGroup "Dup"
75 [ Dup.e1 ==> ("True & !(True & True)", False)
76 -- , Dup.e2 ==> ("", False)
77 ]
78 ]
79 -}
80