SemanticHash.hs

{-# LANGUAGE OverloadedStrings #-}

module Dhall.Test.SemanticHash where

import Data.Text  (Text)
import Prelude    hiding (FilePath)
import Test.Tasty (TestTree)
import Turtle     (FilePath)

import qualified Data.Text        as Text
import qualified Data.Text.IO     as Text.IO
import qualified Dhall.Core       as Core
import qualified Dhall.Import     as Import
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

hashDirectory :: FilePath
hashDirectory = "./dhall-lang/tests/semantic-hash"

getTests :: IO TestTree
getTests = do
    hashTests <- Test.Util.discover (Turtle.chars <* "A.dhall") hashTest (Turtle.lstree hashDirectory)

    return (Tasty.testGroup "semantic-hash tests" [ hashTests ])

hashTest :: Text -> TestTree
hashTest prefix =
    Tasty.HUnit.testCase (Text.unpack prefix) $ do
        let codeFile = Test.Util.toDhallPath (prefix <> "A.dhall")
        let hashFile = Test.Util.toDhallPath (prefix <> "B.hash")

        expr <- Core.throws (Parser.exprFromText mempty codeFile)

        resolved <- Import.load expr

        let normalized = Core.alphaNormalize (Core.normalize resolved)

        let actualHash = Import.hashExpressionToCode normalized

        expectedHash <- Text.stripEnd <$> Text.IO.readFile (Text.unpack hashFile)

        let message = "The hash did not match the expected hash."

        Tasty.HUnit.assertEqual message expectedHash actualHash