Language/Symantic/Compiling/Foldable/Test.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   4 {-# OPTIONS_GHC -O0 #-} -- speedup compile-time…
   5 module Compiling.Foldable.Test where
   6
   7 import Test.Tasty
   8
   9 import Data.Proxy (Proxy(..))
  10 import Data.Text (Text)
  11
  12 import Language.Symantic.Parsing
  13 import Language.Symantic.Typing
  14 import Language.Symantic.Compiling
  15 import Compiling.Term.Test
  16 import Parsing.Test
  17
  18 -- * Tests
  19 type Ifaces =
  20  [ Proxy (->)
  21  , Proxy []
  22  , Proxy Int
  23  , Proxy Foldable
  24  ]
  25 (==>) = test_term_from (Proxy::Proxy Ifaces)
  26
  27 instance
  28  ( Inj_Token (Syntax Text) ts Foldable
  29  , Tokenize (Syntax Text) (Syntax Text) ts ) =>
  30  TokenizeT (Syntax Text) (Syntax Text) ts (Proxy Foldable) where
  31         tokenizeT _t (Syntax "foldMap" (ast_f : ast_m : as)) = Just $ do
  32                 f <- tokenize ast_f
  33                 m <- tokenize ast_m
  34                 Right $ (as,) $ EToken $ inj_token (Syntax "foldMap" [ast_f, ast_m]) $
  35                         Token_Term_Foldable_foldMap f m
  36         tokenizeT _t _sy = Nothing
  37
  38 tests :: TestTree
  39 tests = testGroup "Foldable"
  40  [ Syntax "foldMap"
  41          [ syLam "x" (sy @Int) $
  42                         Syntax "list"
  43                          [ sy @Int
  44                          , syVar "x"
  45                          , syVar "x"
  46                          ]
  47          , Syntax "list"
  48                  [ sy @Int
  49                  , syLit (1::Int)
  50                  , syLit (2::Int)
  51                  , syLit (3::Int)
  52                  ]
  53          ] ==> Right
  54          ( ty @[] :$ ty @Int
  55          , [1, 1, 2, 2, 3, 3]
  56          , "foldMap (\\x0 -> [x0, x0]) [1, 2, 3]" )
  57  ]