Splice.hs

{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Golden.Splice where

import Data.Either (Either(..))
import Data.Function (($))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.List ((++))
import Data.String (String, IsString(..))
import Data.Text (Text)
import Symantic.Parser (ParsingError, optimizeMachine, generateCode)
import System.FilePath (dropExtensions, takeBaseName, (</>), (<.>))
import System.IO (IO)
import Test.Tasty
import Test.Tasty.Golden (goldenVsStringDiff)
import Text.Show (Show(..))
import qualified Data.List as List
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.HideName as TH
import qualified System.Process as Process

import Golden.Utils
import qualified Grammar
import Symantic.Parser.Grammar (optimizeGrammar)

goldens :: TestTree
goldens = testGroup "Splice"
  [ let spliceFile = getGoldenDir $ "Splice/"</>"G"++show gNum<.>"expected"<.>"txt" in
    goldenVsStringDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff spliceFile $ do
      tExp <- splice
      fromString <$> Process.readProcess "ormolu"
        [ "-o", "-XBangPatterns"
        , "-o", "-XMagicHash"
        , "-o", "-XTypeApplications"
        , "-o", "-XUnboxedTuples"
        ]
        (show (TH.ppr (TH.hideName (TH.unType tExp))))
  | (gNum, splice) <- List.zip [1::Int ..] splices
  ]

splices :: [IO (TH.TExp (Text -> Either (ParsingError Text) String))]
splices = (<$> Grammar.grammars) $ \g -> TH.runQ $ do
  mach <- TH.runIO $ do
    resetTHNameCounter
    optimizeMachine $ optimizeGrammar g
  TH.examineCode $ generateCode mach

[ s1,s2,s3,s4,s5,s6,s7,s8,s9
 ,s10,s11,s12,s13,s14,s15,s16,s17,s18,s19
 ,s20
 ] = splices