]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/Foldable/Test.hs
fix (->) by removing inline/val/lazy
[haskell/symantic.git] / Language / Symantic / Expr / Foldable / Test.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE GADTs #-}
4 {-# LANGUAGE NoMonomorphismRestriction #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE TypeOperators #-}
7 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
8
9 module Expr.Foldable.Test where
10
11 import Test.Tasty
12 import Test.Tasty.HUnit
13
14 import qualified Control.Arrow as Arrow
15 import qualified Control.Monad as Monad
16 import qualified Data.Functor as Functor
17 import Data.Proxy (Proxy(..))
18 import Data.Text (Text)
19 import Data.Type.Equality ((:~:)(Refl))
20 import Prelude hiding ((&&), not, (||), (==), (<$>), (+), Foldable(..))
21
22 import Language.Symantic.Type
23 import Language.Symantic.Expr as Expr
24 import Language.Symantic.Repr
25
26 import AST.Test
27
28 -- * Expressions
29 t = bool True
30 f = bool False
31 e1 = foldMap
32 (lam $ \x -> list [x, x])
33 (list $ int Functor.<$> [1..3])
34
35 -- * Tests
36 type Ex = Expr_Root
37 ( Expr_Lambda
38 .|. Expr_List
39 .|. Expr_Maybe
40 .|. Expr_Int
41 .|. Expr_Bool
42 .|. Expr_Functor
43 .|. Expr_Applicative
44 .|. Expr_Foldable
45 )
46 ex_from = root_expr_from (Proxy::Proxy Ex)
47
48 (==>) ast expected =
49 testCase (show ast) $
50 case ex_from ast of
51 Left err -> Left err @?= snd `Arrow.left` expected
52 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
53 case expected of
54 Left (_, err) -> Right ("…"::String) @?= Left err
55 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
56 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
57 case ty `eq_type` ty_expected of
58 Nothing -> Monad.return $ Left $
59 error_expr (Proxy::Proxy Ex) $
60 Error_Expr_Type_mismatch ast
61 (Exists_Type ty)
62 (Exists_Type ty_expected)
63 Just Refl -> do
64 let h = host_from_expr r
65 Monad.return $
66 Right
67 ( ty
68 , h
69 , text_from_expr r
70 -- , (text_from_expr :: Repr_Text h -> Text) r
71 )
72
73 tests :: TestTree
74 tests = testGroup "Foldable"
75 [ AST "foldMap"
76 [ AST "\\"
77 [ AST "x" [], AST "Int" []
78 , AST "list"
79 [ AST "Int" []
80 , AST "var" [ AST "x" [] ]
81 , AST "var" [ AST "x" [] ]
82 ]
83 ]
84 , AST "list"
85 [ AST "Int" []
86 , AST "int" [AST "1" []]
87 , AST "int" [AST "2" []]
88 , AST "int" [AST "3" []]
89 ]
90 ] ==> Right
91 ( type_list type_int
92 , [1, 1, 2, 2, 3, 3]
93 , "foldMap (\\x0 -> [x0, x0]) [1, 2, 3]" )
94 ]