]> Git — Sourcephile - haskell/symantic-parser.git/blob - tests/Golden/Splice.hs
tests: fix Nandlang
[haskell/symantic-parser.git] / 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 qualified Symantic.Parser as SP
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 [ "--no-cabal"
32 -- , "--no-dot-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 -> SP.Parsed Text String))]
43 splices = (<$> Grammar.grammars) $ \g -> TH.runQ $ do
44 mach <- TH.runIO $ do
45 resetTHNameCounter
46 SP.optimizeMachine $ SP.optimizeGrammar g
47 TH.examineCode $ SP.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