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