Parser.hs

{-# LANGUAGE OverloadedStrings #-}

module Dhall.Test.Parser where

import Data.Text (Text)
import Prelude hiding (FilePath)
import Test.Tasty (TestTree)
import Turtle (FilePath, (</>))

import qualified Codec.Serialise      as Serialise
import qualified Control.Monad        as Monad
import qualified Data.ByteString.Lazy as ByteString.Lazy
import qualified Data.Text            as Text
import qualified Data.Text.IO         as Text.IO
import qualified Dhall.Binary         as Binary
import qualified Dhall.Core           as Core
import qualified Dhall.Parser         as Parser
import qualified Dhall.Test.Util      as Test.Util
import qualified Test.Tasty           as Tasty
import qualified Test.Tasty.HUnit     as Tasty.HUnit
import qualified Turtle

parseDirectory :: FilePath
parseDirectory = "./dhall-lang/tests/parser"

getTests :: IO TestTree
getTests = do
    successTests <- do
        Test.Util.discover (Turtle.chars <* "A.dhall") shouldParse (Turtle.lstree (parseDirectory </> "success"))

    let failureFiles = do
            path <- Turtle.lstree (parseDirectory </> "failure")

            let skip =
                    [ parseDirectory </> "failure/annotation.dhall"
                    , parseDirectory </> "failure/missingSpace.dhall"
                    ]

            Monad.guard (path `notElem` skip)

            return path

    failureTests <- do
        Test.Util.discover (Turtle.chars <> ".dhall") shouldNotParse failureFiles

    let testTree =
            Tasty.testGroup "parser tests"
                [ successTests
                , failureTests
                ]

    return testTree

shouldParse :: Text -> TestTree
shouldParse path = do
    let pathString = Text.unpack path

    Tasty.HUnit.testCase pathString $ do
        text <- Text.IO.readFile (pathString <> "A.dhall")

        encoded <- ByteString.Lazy.readFile (pathString <> "B.dhallb")

        expression <- Core.throws (Parser.exprFromText mempty text)

        let term = Binary.encode expression

        let bytes = Serialise.serialise term

        let message = "The expected CBOR representation doesn't match the actual one"
        Tasty.HUnit.assertEqual message encoded bytes

shouldNotParse :: Text -> TestTree
shouldNotParse path = do
    let pathString = Text.unpack path

    Tasty.HUnit.testCase pathString (do
        text <- Text.IO.readFile pathString

        case Parser.exprFromText mempty text of
            Left  _ -> return ()
            Right _ -> fail "Unexpected successful parser" )