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_Text
  48  .|. Expr_Monoid
  49  .|. Expr_Num
  50  )
  51 ex_from = root_expr_from (Proxy::Proxy Ex)
  52
  53 (==>) ast expected =
  54         testCase (show ast) $
  55         case ex_from ast of
  56          Left err -> Left err @?= Prelude.snd `Arrow.left` expected
  57          Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
  58                 case expected of
  59                  Left (_, err) -> Right ("…"::String) @?= Left err
  60                  Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
  61                         (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
  62                         case ty `eq_type` ty_expected of
  63                          Nothing -> Monad.return $ Left $
  64                                 error_expr (Proxy::Proxy Ex) $
  65                                 Error_Expr_Type_mismatch ast
  66                                  (Exists_Type ty)
  67                                  (Exists_Type ty_expected)
  68                          Just Refl -> do
  69                                 let h = host_from_expr r
  70                                 Monad.return $
  71                                         Right
  72                                          ( ty
  73                                          , h
  74                                          , text_from_expr r
  75                                          -- , (text_from_expr :: Repr_Text h -> Text) r
  76                                          )
  77
  78 tests :: TestTree
  79 tests = testGroup "Map"
  80  [ AST "map_from_list"
  81          [ AST "list_zipWith"
  82                  [ AST "\\"
  83                          [ AST "x" []
  84                          , AST "Int" []
  85                          , AST "\\"
  86                                  [ AST "y" []
  87                                  , AST "Text" []
  88                                  , AST "(,)"
  89                                          [ AST "var" [AST "x" []]
  90                                          , AST "var" [AST "y" []]
  91                                          ]
  92                                  ]
  93                          ]
  94                  , AST "list"
  95                          [ AST "Int" []
  96                          , AST "int" [AST "1" []]
  97                          , AST "int" [AST "2" []]
  98                          , AST "int" [AST "3" []]
  99                          ]
 100                  , AST "list"
 101                          [ AST "Text" []
 102                          , AST "text" [AST "a" []]
 103                          , AST "text" [AST "b" []]
 104                          , AST "text" [AST "c" []]
 105                          ]
 106                  ]
 107          ] ==> Right
 108          ( type_map type_int type_text
 109          , Map.fromList [(1, "a"), (2, "b"), (3, "c")]
 110          , "map_from_list (list_zipWith (\\x0 -> (\\x1 -> (x0, x1))) [1, 2, 3] [\"a\", \"b\", \"c\"])" )
 111  , AST "map_foldrWithKey"
 112          [ AST "\\"
 113                  [ AST "k" []
 114                  , AST "Int" []
 115                  , AST "\\"
 116                          [ AST "v" []
 117                          , AST "Text" []
 118                          , AST "\\"
 119                                  [ AST "a" []
 120                                  , AST "(,)" [AST "Int" [], AST "Text" []]
 121                                  , AST "(,)"
 122                                          [ AST "+"
 123                                                  [ AST "var" [AST "k" []]
 124                                                  , AST "fst" [ AST "var" [AST "a" []] ]
 125                                                  ]
 126                                          , AST "mappend"
 127                                                  [ AST "var" [AST "v" []]
 128                                                  , AST "snd" [ AST "var" [AST "a" []] ]
 129                                                  ]
 130                                          ]
 131                                  ]
 132                          ]
 133                  ]
 134          , AST "(,)"
 135                  [ AST "int" [AST "0" []]
 136                  , AST "text" [AST "" []]
 137                  ]
 138          , AST "map_from_list"
 139                  [ AST "list_zipWith"
 140                          [ AST "\\"
 141                                  [ AST "x" []
 142                                  , AST "Int" []
 143                                  , AST "\\"
 144                                          [ AST "y" []
 145                                          , AST "Text" []
 146                                          , AST "(,)"
 147                                                  [ AST "var" [AST "x" []]
 148                                                  , AST "var" [AST "y" []]
 149                                                  ]
 150                                          ]
 151                                  ]
 152                          , AST "list"
 153                                  [ AST "Int" []
 154                                  , AST "int" [AST "1" []]
 155                                  , AST "int" [AST "2" []]
 156                                  , AST "int" [AST "3" []]
 157                                  ]
 158                          , AST "list"
 159                                  [ AST "Text" []
 160                                  , AST "text" [AST "a" []]
 161                                  , AST "text" [AST "b" []]
 162                                  , AST "text" [AST "c" []]
 163                                  ]
 164                          ]
 165                  ]
 166          ] ==> Right
 167          ( type_tuple2 type_int type_text
 168          , (6, "abc")
 169          , "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\"]))" )
 170  ]