1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE NoMonomorphismRestriction #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE TypeOperators #-}
7 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
9 module Expr.Foldable.Test where
12 import Test.Tasty.HUnit
14 import qualified Control.Arrow as Arrow
15 import qualified Control.Monad as Monad
16 import qualified Data.Functor as Functor
17 import Data.Functor.Identity
18 import Data.Proxy (Proxy(..))
19 import Data.Text (Text)
20 import Data.Type.Equality ((:~:)(Refl))
21 import Prelude hiding ((&&), not, (||), (==), (<$>), (+), Foldable(..))
23 import Language.Symantic.Type
24 import Language.Symantic.Expr as Expr
25 import Language.Symantic.Repr
33 (val $ \x -> list [x, x])
34 (list $ int Functor.<$> [1..3])
37 type Ex lam = Expr_Root
39 .|. Expr_Lambda_Val lam
45 .|. Expr_Applicative lam
48 ex_from = root_expr_from (Proxy::Proxy (Ex lam)) (Proxy::Proxy lam)
53 Left err -> Left err @?= snd `Arrow.left` expected
54 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
56 Left (_, err) -> Right ("…"::String) @?= Left err
57 Right (ty_expected::Type_Root_of_Expr (Ex Identity) h, _::h, _::Text) ->
58 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
59 case ty `eq_type` ty_expected of
60 Nothing -> Monad.return $ Left $
61 error_expr (Proxy::Proxy (Ex Identity)) $
62 Error_Expr_Type_mismatch ast
64 (Exists_Type ty_expected)
66 let h = runIdentity $ host_from_expr r
72 -- , (text_from_expr :: Repr_Text Identity h -> Text) r
76 tests = testGroup "Foldable"
79 [ AST "x" [], AST "Int" []
82 , AST "var" [ AST "x" [] ]
83 , AST "var" [ AST "x" [] ]
88 , AST "int" [AST "1" []]
89 , AST "int" [AST "2" []]
90 , AST "int" [AST "3" []]
95 , "foldMap (\\x0 -> [x0, x0]) [1, 2, 3]" )