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