Language/Symantic/Expr/Map/Test.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE GADTs #-}
   3 {-# LANGUAGE NoMonomorphismRestriction #-}
   4 {-# LANGUAGE Rank2Types #-}
   5 {-# LANGUAGE ScopedTypeVariables #-}
   6 {-# LANGUAGE TypeOperators #-}
   7 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   8 module Expr.Map.Test where
   9
  10 import Test.Tasty
  11 import Test.Tasty.HUnit
  12
  13 import qualified Control.Arrow as Arrow
  14 import qualified Control.Monad as Monad
  15 -- import qualified Data.List as List
  16 import qualified Data.Map.Strict as Map
  17 import Data.Proxy (Proxy(..))
  18 import Data.Text (Text)
  19 import qualified Data.Text as Text
  20 import Data.Type.Equality ((:~:)(Refl))
  21 import Prelude hiding (maybe, not)
  22
  23 import Language.Symantic.Repr
  24 import Language.Symantic.Expr
  25 import Language.Symantic.Type
  26
  27 import AST.Test
  28
  29 -- * Expressions
  30 t = bool True
  31 f = bool False
  32 e1 = map_from_list $ list_zipWith (lam (lam . tuple2))
  33  (list $ int Prelude.<$> [1..5])
  34  (list $ (text . Text.singleton) Prelude.<$> ['a'..'e'])
  35
  36 -- * Tests
  37 type Ex = Expr_Root
  38  (   Expr_Lambda
  39  .|. Expr_Map
  40  .|. Expr_Bool
  41  .|. Expr_Maybe
  42  .|. Expr_List
  43  .|. Expr_Eq
  44  .|. Expr_Ord
  45  .|. Expr_Tuple2
  46  .|. Expr_Int
  47  .|. Expr_Integer
  48  .|. Expr_Text
  49  .|. Expr_Monoid
  50  .|. Expr_Num
  51  )
  52 ex_from = root_expr_from (Proxy::Proxy Ex)
  53
  54 (==>) ast expected =
  55         testCase (show ast) $
  56         case ex_from ast of
  57          Left err -> Left err @?= Prelude.snd `Arrow.left` expected
  58          Right (Exists_Type0_and_Repr ty (Forall_Repr r)) ->
  59                 case expected of
  60                  Left (_, err) -> Right ("…"::String) @?= Left err
  61                  Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
  62                         (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
  63                         case ty `type0_eq` ty_expected of
  64                          Nothing -> Monad.return $ Left $
  65                                 error_expr (Proxy::Proxy Ex) $
  66                                 Error_Expr_Type_mismatch ast
  67                                  (Exists_Type0 ty)
  68                                  (Exists_Type0 ty_expected)
  69                          Just Refl -> do
  70                                 let h = host_from_expr r
  71                                 Monad.return $
  72                                         Right
  73                                          ( ty
  74                                          , h
  75                                          , text_from_expr r
  76                                          -- , (text_from_expr :: Repr_Text h -> Text) r
  77                                          )
  78
  79 tests :: TestTree
  80 tests = testGroup "Map"
  81  [ AST "map_from_list"
  82          [ AST "list_zipWith"
  83                  [ AST "\\"
  84                          [ AST "x" []
  85                          , AST "Int" []
  86                          , AST "\\"
  87                                  [ AST "y" []
  88                                  , AST "Text" []
  89                                  , AST "(,)"
  90                                          [ AST "var" [AST "x" []]
  91                                          , AST "var" [AST "y" []]
  92                                          ]
  93                                  ]
  94                          ]
  95                  , AST "list"
  96                          [ AST "Int" []
  97                          , AST "int" [AST "1" []]
  98                          , AST "int" [AST "2" []]
  99                          , AST "int" [AST "3" []]
 100                          ]
 101                  , AST "list"
 102                          [ AST "Text" []
 103                          , AST "text" [AST "a" []]
 104                          , AST "text" [AST "b" []]
 105                          , AST "text" [AST "c" []]
 106                          ]
 107                  ]
 108          ] ==> Right
 109          ( type_map type_int type_text
 110          , Map.fromList [(1, "a"), (2, "b"), (3, "c")]
 111          , "map_from_list (list_zipWith (\\x0 -> (\\x1 -> (x0, x1))) [1, 2, 3] [\"a\", \"b\", \"c\"])" )
 112  , AST "map_foldrWithKey"
 113          [ AST "\\"
 114                  [ AST "k" []
 115                  , AST "Int" []
 116                  , AST "\\"
 117                          [ AST "v" []
 118                          , AST "Text" []
 119                          , AST "\\"
 120                                  [ AST "a" []
 121                                  , AST "(,)" [AST "Int" [], AST "Text" []]
 122                                  , AST "(,)"
 123                                          [ AST "+"
 124                                                  [ AST "var" [AST "k" []]
 125                                                  , AST "fst" [ AST "var" [AST "a" []] ]
 126                                                  ]
 127                                          , AST "mappend"
 128                                                  [ AST "var" [AST "v" []]
 129                                                  , AST "snd" [ AST "var" [AST "a" []] ]
 130                                                  ]
 131                                          ]
 132                                  ]
 133                          ]
 134                  ]
 135          , AST "(,)"
 136                  [ AST "int" [AST "0" []]
 137                  , AST "text" [AST "" []]
 138                  ]
 139          , AST "map_from_list"
 140                  [ AST "list_zipWith"
 141                          [ AST "\\"
 142                                  [ AST "x" []
 143                                  , AST "Int" []
 144                                  , AST "\\"
 145                                          [ AST "y" []
 146                                          , AST "Text" []
 147                                          , AST "(,)"
 148                                                  [ AST "var" [AST "x" []]
 149                                                  , AST "var" [AST "y" []]
 150                                                  ]
 151                                          ]
 152                                  ]
 153                          , AST "list"
 154                                  [ AST "Int" []
 155                                  , AST "int" [AST "1" []]
 156                                  , AST "int" [AST "2" []]
 157                                  , AST "int" [AST "3" []]
 158                                  ]
 159                          , AST "list"
 160                                  [ AST "Text" []
 161                                  , AST "text" [AST "a" []]
 162                                  , AST "text" [AST "b" []]
 163                                  , AST "text" [AST "c" []]
 164                                  ]
 165                          ]
 166                  ]
 167          ] ==> Right
 168          ( type_tuple2 type_int type_text
 169          , (6, "abc")
 170          , "map_foldrWithKey (\\x0 -> (\\x1 -> (\\x2 -> (x0 + fst x2, mappend x1 (snd x2))))) (0, \"\") (map_from_list (list_zipWith (\\x0 -> (\\x1 -> (x0, x1))) [1, 2, 3] [\"a\", \"b\", \"c\"]))" )
 171  ]