Parse.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Prosidy.Test.Parse (tests) where

import qualified Prosidy

import Test.Tasty
import Test.Tasty.Golden.Advanced (goldenTest)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified System.Directory as Dir
import System.FilePath ((</>))
import Control.Exception (handle, displayException)

import qualified Paths_prosidy as Paths
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Diff as Aeson.Diff
import qualified Data.Aeson.Encode.Pretty as Aeson.Pretty

import qualified Data.Text.Lazy as Text.Lazy
import Data.Text.Lazy.Encoding (decodeUtf8With)

tests :: IO TestTree
tests = do
    goldenDir   <- (</> "golden") <$> Paths.getDataDir
    goldenTests <- Dir.listDirectory goldenDir
    pure . testGroup "parse" $ makeTest goldenDir <$> goldenTests

makeTest :: FilePath -> String -> TestTree
makeTest goldenDir name =
    goldenTest name 
        (catchErrors getJSON) 
        (catchErrors parsePro)
        compareDocs
        writeGolden
  where
    getJSON :: IO Aeson.Value
    getJSON = do
        bytes <- BS.readFile $ goldenDir </> name </> "output.json"
        case Aeson.eitherDecode' . BS.Lazy.fromStrict $ bytes of
            Left e   -> fail $ "Failed to parse JSON: " <> e
            Right ok -> pure ok

    parsePro :: IO Aeson.Value
    parsePro = Aeson.toJSON <$>
        Prosidy.readDocument (goldenDir </> name </> "input.pro") 

    compareDocs :: Aeson.Value -> Aeson.Value -> IO (Maybe String)
    compareDocs gold test | gold == test = pure Nothing
    compareDocs gold test = 
      let
        diff   = Aeson.Diff.diff (Aeson.toJSON gold) (Aeson.toJSON test)
        pretty = Aeson.Pretty.encodePretty diff
      in
        pure . Just . Text.Lazy.unpack $ 
            "Golden test failed. The diff is included below:\n" <>
            decodeUtf8With (\_ _ -> Just '\65533') pretty

    writeGolden :: Aeson.Value -> IO ()
    writeGolden doc = BS.Lazy.writeFile (goldenDir </> name </> "output.json") $
        Aeson.Pretty.encodePretty doc

catchErrors :: IO a -> IO a
catchErrors = handle $ \(e :: Prosidy.Failure) -> fail $ displayException e