Parser.hs

{-# LANGUAGE DataKinds #-} -- For using P.viewGrammar
{-# LANGUAGE FlexibleContexts #-} -- For using P.Grammar Char
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeApplications #-}
-- For TH splices
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-unused-local-binds #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
module Golden.Parser where

import Control.Monad (Monad(..))
import Data.Either (Either(..))
import Data.Function (($))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
import Data.Text.IO (readFile)
import System.FilePath ((<.>), (</>), dropExtensions, takeBaseName)
import System.IO.Unsafe (unsafePerformIO)
import Test.Tasty
import Test.Tasty.Golden
import Text.Show (Show(..))
import qualified Control.Exception as IO
import qualified Data.List as List
import qualified System.Directory as IO
import qualified System.IO.Error as IO
import qualified Language.Haskell.TH as TH

import qualified Symantic.Parser as P
import Golden.Utils
import Golden.Splice

goldens :: TestTree
goldens = testGroup "Parser" $
  (\f -> List.zipWith f parsers [1::Int ..]) $ \p g ->
  -- Collect the existing files: test/Golden/Parser/G*.input.txt
  let parserDir = getGoldenDir $ "Parser/G"<>show g in
  let inputs =
        ((parserDir </>) <$>) $
        List.sort $
        List.filter (List.isSuffixOf ".input.txt") $
        unsafePerformIO $
          IO.catchIOError
            (IO.listDirectory parserDir)
            (\exn ->
              if IO.isDoesNotExistError exn
              then return []
              else IO.throwIO exn
            ) in
  testGroup ("G"<>show g) $ (<$> inputs) $ \inp ->
    goldenVsStringDiff (takeBaseName (dropExtensions inp)) goldenDiff
      (dropExtensions inp<.>"expected.txt") $ do
      input <- readFile inp
      return $ fromString $
        case p input of
          Left err -> show err
          Right a -> a

parsers :: [Text -> Either (P.ParsingError Text) String]
parsers =
  [ p1, p2, p3, p4, p5, p6, p7, p8, p9
  , p10, p11, p12, p13, p14, p15, p16
  ]

p1 = $$(TH.Code $ TH.runIO s1)
p2 = $$(TH.Code $ TH.runIO s2)
p3 = $$(TH.Code $ TH.runIO s3)
p4 = $$(TH.Code $ TH.runIO s4)
p5 = $$(TH.Code $ TH.runIO s5)
p6 = $$(TH.Code $ TH.runIO s6)
p7 = $$(TH.Code $ TH.runIO s7)
p8 = $$(TH.Code $ TH.runIO s8)
p9 = $$(TH.Code $ TH.runIO s9)
p10 = $$(TH.Code $ TH.runIO s10)
p11 = $$(TH.Code $ TH.runIO s11)
p12 = $$(TH.Code $ TH.runIO s12)
p13 = $$(TH.Code $ TH.runIO s13)
p14 = $$(TH.Code $ TH.runIO s14)
p15 = $$(TH.Code $ TH.runIO s15)
p16 = $$(TH.Code $ TH.runIO s16)