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

goldens :: TestTree
goldens = testGroup "Splice"
  [ let spliceFile = getGoldenDir $ "Splice/"</>"G"++show g<.>"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))))
  | (g, splice) <- List.zip [1::Int ..] splices
  ]

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

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