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 = getGoldenDir $ "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", "-XBangPatterns"
  33         , "-o", "-XMagicHash"
  34         , "-o", "-XTypeApplications"
  35         , "-o", "-XUnboxedTuples"
  36         ]
  37         (show (TH.ppr (TH.hideName (TH.unType tExp))))
  38   | (g, splice) <- List.zip [1::Int ..] splices
  39   ]
  40
  41 splices :: [IO (TH.TExp (Text -> Either (ParsingError Text) String))]
  42 splices = (<$> Grammar.grammars) $ \g -> TH.runQ $ do
  43   TH.runIO resetTHNameCounter
  44   mach <- TH.runIO $ optimizeMachine 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
  49  ] = splices