]> Git — Sourcephile - haskell/symantic-parser.git/blob - test/Golden/Splice.hs
machine: fix mayRaise analysis of catch
[haskell/symantic-parser.git] / 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
26 goldens :: TestTree
27 goldens = testGroup "Splice"
28 [ let spliceFile = "test/Golden/Splice/"</>"G"++show g<.>"expected"<.>"txt" in
29 goldenVsStringDiff (takeBaseName (dropExtensions spliceFile)) goldenDiff spliceFile $ do
30 tExp <- splice
31 fromString <$> Process.readProcess "ormolu"
32 [ "-o", "-XMagicHash"
33 , "-o", "-XUnboxedTuples"
34 , "-o", "-XBangPatterns"
35 , "-o", "-XTypeApplications" ]
36 (show (TH.ppr (TH.hideName (TH.unType tExp))))
37 | (g, splice) <- List.zip [1::Int ..] splices
38 ]
39
40 splices :: [IO (TH.TExp (Text -> Either (ParsingError Text) String))]
41 splices = (<$> Grammar.grammars) $ \g -> TH.runQ $ do
42 TH.runIO resetTHNameCounter
43 mach <- TH.runIO $ optimizeMachine g
44 TH.examineCode $ generateCode mach
45
46 [ s1,s2,s3,s4,s5,s6,s7,s8,s9
47 ,s10,s11,s12,s13,s14,s15,s16
48 ] = splices