2017-07-22 13:53:24 +02:00
|
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
2017-05-22 19:40:07 +02:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
|
|
|
module Tutorial where
|
|
|
|
|
2017-07-22 13:53:24 +02:00
|
|
|
import qualified Data.Vector
|
|
|
|
import qualified Dhall
|
2017-05-22 19:40:07 +02:00
|
|
|
import qualified Test.Tasty
|
|
|
|
import qualified Test.Tasty.HUnit
|
|
|
|
import qualified Util
|
|
|
|
|
2018-01-03 17:24:08 +01:00
|
|
|
import Data.Monoid ((<>))
|
|
|
|
import Data.Text (Text)
|
2017-07-22 13:53:24 +02:00
|
|
|
import Dhall (Inject)
|
|
|
|
import GHC.Generics (Generic)
|
2018-01-03 17:24:08 +01:00
|
|
|
import Numeric.Natural (Natural)
|
2017-05-22 19:40:07 +02:00
|
|
|
import Test.Tasty (TestTree)
|
2017-07-22 13:53:24 +02:00
|
|
|
import Test.Tasty.HUnit ((@?=))
|
2017-05-22 19:40:07 +02:00
|
|
|
|
|
|
|
tutorialTests :: TestTree
|
|
|
|
tutorialTests =
|
|
|
|
Test.Tasty.testGroup "tutorial"
|
|
|
|
[ Test.Tasty.testGroup "Interpolation"
|
|
|
|
[ _Interpolation_0
|
|
|
|
, _Interpolation_1
|
|
|
|
]
|
2017-07-22 13:53:24 +02:00
|
|
|
, Test.Tasty.testGroup "Functions"
|
|
|
|
[ _Functions_0
|
|
|
|
, _Functions_1
|
|
|
|
, _Functions_2
|
|
|
|
]
|
2018-01-03 17:24:08 +01:00
|
|
|
, Test.Tasty.testGroup "Unions"
|
|
|
|
[ example 0 "./tests/tutorial/unions0A.dhall" "./tests/tutorial/unions0B.dhall"
|
|
|
|
, example 1 "./tests/tutorial/unions1A.dhall" "./tests/tutorial/unions1B.dhall"
|
|
|
|
, example 2 "./tests/tutorial/unions2A.dhall" "./tests/tutorial/unions2B.dhall"
|
|
|
|
, example 3 "./tests/tutorial/unions3A.dhall" "./tests/tutorial/unions3B.dhall"
|
|
|
|
, example 4 "./tests/tutorial/unions4A.dhall" "./tests/tutorial/unions4B.dhall"
|
|
|
|
]
|
2017-05-22 19:40:07 +02:00
|
|
|
]
|
|
|
|
|
|
|
|
_Interpolation_0 :: TestTree
|
|
|
|
_Interpolation_0 = Test.Tasty.HUnit.testCase "Example #0" (do
|
2017-07-26 04:51:40 +02:00
|
|
|
e <- Util.code
|
|
|
|
" let name = \"John Doe\" \n\
|
|
|
|
\in let age = 21 \n\
|
|
|
|
\in \"My name is ${name} and my age is ${Integer/show age}\"\n"
|
2017-05-22 19:40:07 +02:00
|
|
|
Util.assertNormalizesTo e "\"My name is John Doe and my age is 21\"" )
|
|
|
|
|
|
|
|
_Interpolation_1 :: TestTree
|
2017-07-22 13:53:24 +02:00
|
|
|
_Interpolation_1 = Test.Tasty.HUnit.testCase "Example #1" (do
|
2017-07-26 04:51:40 +02:00
|
|
|
e <- Util.code
|
|
|
|
"'' \n\
|
|
|
|
\ for file in *; do \n\
|
|
|
|
\ echo \"Found ''${file}\"\n\
|
|
|
|
\ done \n\
|
|
|
|
\'' \n"
|
2017-05-22 19:40:07 +02:00
|
|
|
Util.assertNormalized e )
|
2017-07-22 13:53:24 +02:00
|
|
|
|
|
|
|
_Functions_0 :: TestTree
|
|
|
|
_Functions_0 = Test.Tasty.HUnit.testCase "Example #0" (do
|
2017-07-26 04:51:40 +02:00
|
|
|
let text = "\\(n : Bool) -> [ n && True, n && False, n || True, n || False ]"
|
2017-07-22 13:53:24 +02:00
|
|
|
makeBools <- Dhall.input Dhall.auto text
|
|
|
|
makeBools True @?= Data.Vector.fromList [True,False,True,True] )
|
|
|
|
|
|
|
|
_Functions_1 :: TestTree
|
|
|
|
_Functions_1 = Test.Tasty.HUnit.testCase "Example #1" (do
|
2017-07-26 04:51:40 +02:00
|
|
|
let text = "λ(x : Bool) → λ(y : Bool) → x && y"
|
2017-07-22 13:53:24 +02:00
|
|
|
makeBools <- Dhall.input Dhall.auto text
|
|
|
|
makeBools True False @?= False )
|
|
|
|
|
|
|
|
data Example0 = Example0 { foo :: Bool, bar :: Bool }
|
|
|
|
deriving (Generic, Inject)
|
|
|
|
|
|
|
|
_Functions_2 :: TestTree
|
|
|
|
_Functions_2 = Test.Tasty.HUnit.testCase "Example #2" (do
|
|
|
|
f <- Dhall.input Dhall.auto "λ(r : { foo : Bool, bar : Bool }) → r.foo && r.bar"
|
|
|
|
f (Example0 { foo = True, bar = False }) @?= False
|
|
|
|
f (Example0 { foo = True, bar = True }) @?= True )
|
2018-01-03 17:24:08 +01:00
|
|
|
|
|
|
|
example :: Natural -> Text -> Text -> TestTree
|
|
|
|
example n text0 text1 =
|
|
|
|
Test.Tasty.HUnit.testCase
|
|
|
|
("Example #" <> show n)
|
|
|
|
(Util.equivalent text0 text1)
|