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