test/Golden/Splice.hs

   1 {-# LANGUAGE ExistentialQuantification #-}
   2 {-# LANGUAGE TypeApplications #-}
   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.Text (Text)
  10 import Data.Semigroup (Semigroup(..))
  11 import System.FilePath ((</>), (<.>))
  12 import System.IO (IO)
  13 import Test.Tasty
  14 import Text.Show (Show(..))
  15 import qualified Data.List as List
  16 import qualified Language.Haskell.TH as TH
  17 import qualified Language.Haskell.TH.Syntax as TH
  18 import Symantic.Parser (ParsingError, optimizeMachine, generateCode)
  19
  20 --import Build_symantic_parser
  21 import Golden.Splice.Utils
  22 import qualified Grammar
  23
  24 goldens :: TestTree
  25 goldens = testGroup "Splice" $
  26   {-[
  27     let spliceFile = "test/Golden/Splice/"</>"G"<>show g<.>"hs" in
  28     withResource
  29       (writeFile (rootDir</>spliceFile) $ List.unlines
  30         [ "module Golden.Splice.G"<>show g<>" where"
  31         , "import Data.Text (Text)"
  32         , "import qualified Symantic.Parser as P"
  33         , "import qualified Data.IORef as IORef"
  34         , "import qualified Language.Haskell.TH.Syntax as TH"
  35         , "import qualified Grammar"
  36         , ""
  37         , "splice = $$(TH.Code (do"
  38             -- This is for 'TH.Name's to match with the ones in
  39             -- 'viewGrammar' and 'viewMachine', which ease debugging.
  40         , "  TH.qRunIO (IORef.writeIORef TH.counter 0)"
  41         , "  TH.examineCode (P.runParser @Text Grammar.g"<>show g<>")"
  42         , "  ))"
  43         ])
  44       (\() -> do
  45         rmFile (rootDir</>spliceFile)
  46         rmFile (rootDir</>spliceFile-<.>"hi")
  47         rmFile (rootDir</>spliceFile-<.>"o")
  48         rmFile (rootDir</>spliceFile-<.>"p_hi")
  49         rmFile (rootDir</>spliceFile-<.>"p_o"))
  50       (\_io -> testSplice spliceFile)
  51   | g <- [1::Int .. List.length Grammar.grammars]
  52   ]-}
  53   [ coverSplice splice $ "test/Golden/Splice/"</>"G"<>show g<.>"expected"<.>"txt"
  54   | (g, S splice) <- List.zip [1::Int ..] splices
  55   ]
  56
  57 data S inp = forall a. S (IO (TH.TExp (inp -> Either (ParsingError inp) a)))
  58 splices :: [S Text]
  59 splices = (<$> Grammar.grammars) $ \(Grammar.G g) -> S $ TH.runQ $ do
  60   mach <- TH.qRunIO $ optimizeMachine g
  61   TH.examineCode $ generateCode mach