Language/Symantic/Expr/List/Test.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE GADTs #-}
   3 {-# LANGUAGE NoMonomorphismRestriction #-}
   4 {-# LANGUAGE Rank2Types #-}
   5 {-# LANGUAGE ScopedTypeVariables #-}
   6 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   7 module Expr.List.Test where
   8
   9 import Test.Tasty
  10 {-
  11 import Test.Tasty.HUnit
  12
  13 import Control.Arrow (left)
  14 import Data.Proxy (Proxy(..))
  15 import Data.Text (Text)
  16 import Data.Type.Equality ((:~:)(Refl))
  17 -}
  18 import Prelude hiding (mod, (==))
  19
  20 import Language.Symantic.Repr
  21 import Language.Symantic.Expr
  22 import Language.Symantic.Type
  23
  24 import AST.Test
  25
  26 -- * Expressions
  27 t = bool True
  28 f = bool False
  29 e1 = list_filter (inline $ \x -> if_ (x `mod` int 2 == int 0) t f)
  30                  (list $ int <$> [1..5])
  31
  32 {-
  33 -- * Tests
  34 (==>) ast expected =
  35         testCase (show ast) $
  36         case ex_from (Proxy::Proxy IO) ast of
  37          Left err -> Left err @?= snd `left` expected
  38          Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
  39                 case expected of
  40                  Left (_, err) -> Right ("…"::String) @?= Left err
  41                  Right (ty_expected::Type_Root_of_Expr (Ex IO) h, _::h, _::Text) ->
  42                         (>>= (@?= (\(_::Proxy h, err) -> err) `left` expected)) $
  43                         case ty `eq_type` ty_expected of
  44                          Nothing -> return $ Left $
  45                                 error_expr (Proxy::Proxy (Ex IO)) $
  46                                 Error_Expr_Type_mismatch ast
  47                                  (Exists_Type ty)
  48                                  (Exists_Type ty_expected)
  49                          Just Refl -> do
  50                                 h <- host_from_expr r
  51                                 return $
  52                                         Right
  53                                          ( ty
  54                                          , h
  55                                          , text_from_expr r
  56                                          -- , (text_from_expr :: Repr_String IO h -> Text) r
  57                                          )
  58 -}
  59 tests :: TestTree
  60 tests = testGroup "List"
  61  [{- AST "just" [AST "bool" [AST "True" []]] ==> Right
  62          ( type_maybe type_bool
  63          , Just True
  64          , "just True" )
  65  , AST "just"
  66          [ AST "let_val"
  67                  [ AST "x" []
  68                  , AST "bool" [AST "True" []]
  69                  , AST "var" [AST "x" []]
  70                  ]
  71          ] ==> Right
  72          ( type_maybe type_bool
  73          , Just True
  74          , "just (let x0 = True in x0)" )
  75  , AST "maybe"
  76          [ AST "bool" [AST "True" []]
  77          , AST "val"
  78                  [ AST "x" []
  79                  , AST "Bool" []
  80                  , AST "not" [AST "var" [AST "x" []]]
  81                  ]
  82          , AST "nothing"
  83                  [ AST "Bool" []
  84                  ]
  85          ] ==> Right
  86          ( type_bool
  87          , True
  88          , "maybe True (\\x0 -> !x0) nothing" )
  89  , AST "maybe"
  90          [ AST "bool" [AST "False" []]
  91          , AST "val"
  92                  [ AST "x" []
  93                  , AST "Bool" []
  94                  , AST "not" [AST "var" [AST "x" []]]
  95                  ]
  96          , AST "just"
  97                  [ AST "bool" [AST "True" []]
  98                  ]
  99          ] ==> Right
 100          ( type_bool
 101          , False
 102          , "maybe False (\\x0 -> !x0) (just True)" )
 103  -}]