Language/Symantic/Compiling/MonoFunctor/Test.hs

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