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