test/Golden/Splice.hs

   1 {-# OPTIONS_GHC -Wno-missing-signatures #-}
   2 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
   3 module Golden.Splice where
   4
   5 import Data.Either (Either(..))
   6 import Data.Function (($))
   7 import Data.Functor ((<$>))
   8 import Data.Int (Int)
   9 import Data.List ((++))
  10 import Data.String (String, IsString(..))
  11 import Data.Text (Text)
  12 import Symantic.Parser (ParsingError, optimizeMachine, generateCode)
  13 import System.FilePath (dropExtensions, takeBaseName, (</>), (<.>))
  14 import System.IO (IO)
  15 import Test.Tasty
  16 import Test.Tasty.Golden (goldenVsStringDiff)
  17 import Text.Show (Show(..))
  18 import qualified Data.List as List
  19 import qualified Language.Haskell.TH as TH
  20 import qualified Language.Haskell.TH.HideName as TH
  21 import qualified System.Process as Process
  22
  23 import Golden.Utils
  24 import qualified Grammar
  25 import Symantic.Parser.Grammar (optimizeGrammar)
  26
  27 goldens :: TestTree
  28 goldens = testGroup "Splice"
  29   [ let spliceFile = getGoldenDir $ "Splice/"</>"G"++show gNum<.>"expected"<.>"txt" in
  30     goldenVsStringDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff spliceFile $ do
  31       tExp <- splice
  32       fromString <$> Process.readProcess "ormolu"
  33         [ "-o", "-XBangPatterns"
  34         , "-o", "-XMagicHash"
  35         , "-o", "-XTypeApplications"
  36         , "-o", "-XUnboxedTuples"
  37         ]
  38         (show (TH.ppr ({-TH.hideName-} (TH.unType tExp))))
  39   | (gNum, splice) <- List.zip [1::Int ..] splices
  40   ]
  41
  42 splices :: [IO (TH.TExp (Text -> Either (ParsingError Text) String))]
  43 splices = (<$> Grammar.grammars) $ \g -> TH.runQ $ do
  44   mach <- TH.runIO $ do
  45     resetTHNameCounter
  46     optimizeMachine $ optimizeGrammar g
  47   TH.examineCode $ generateCode mach
  48
  49 [ s1,s2,s3,s4,s5,s6,s7,s8,s9
  50  ,s10,s11,s12,s13,s14,s15,s16,s17,s18,s19
  51  ,s20
  52  ] = splices