test/Golden/Parser.hs

   1 {-# LANGUAGE DataKinds #-} -- For using P.viewGrammar
   2 {-# LANGUAGE FlexibleContexts #-} -- For using P.Grammar Char
   3 {-# LANGUAGE Rank2Types #-}
   4 {-# LANGUAGE TypeApplications #-}
   5 -- For TH splices
   6 {-# LANGUAGE TemplateHaskell #-}
   7 {-# LANGUAGE Rank2Types #-}
   8 {-# LANGUAGE ScopedTypeVariables #-}
   9 {-# LANGUAGE UnboxedTuples #-}
  10 {-# OPTIONS_GHC -Wno-missing-signatures #-}
  11 {-# OPTIONS_GHC -Wno-unused-local-binds #-}
  12 {-# OPTIONS_GHC -Wno-unused-matches #-}
  13 module Golden.Parser where
  14
  15 import Control.Monad (Monad(..))
  16 import Data.Either (Either(..))
  17 import Data.Function (($))
  18 import Data.Functor ((<$>))
  19 import Data.Int (Int)
  20 import Data.Semigroup (Semigroup(..))
  21 import Data.String (String, IsString(..))
  22 import Data.Text (Text)
  23 import Data.Text.IO (readFile)
  24 import System.FilePath ((<.>), (</>), dropExtensions, takeBaseName)
  25 import System.IO.Unsafe (unsafePerformIO)
  26 import Test.Tasty
  27 import Test.Tasty.Golden
  28 import Text.Show (Show(..))
  29 import qualified Control.Exception as IO
  30 import qualified Data.List as List
  31 import qualified System.Directory as IO
  32 import qualified System.IO.Error as IO
  33 import qualified Language.Haskell.TH as TH
  34
  35 import qualified Symantic.Parser as P
  36 import Golden.Utils
  37 import Golden.Splice
  38
  39 goldens :: TestTree
  40 goldens = testGroup "Parser" $
  41   (\f -> List.zipWith f parsers [1::Int ..]) $ \p g ->
  42   -- Collect the existing files: test/Golden/Parser/G*.input.txt
  43   let parserDir = getGoldenDir $ "Parser/G"<>show g in
  44   let inputs =
  45         ((parserDir </>) <$>) $
  46         List.sort $
  47         List.filter (List.isSuffixOf ".input.txt") $
  48         unsafePerformIO $
  49           IO.catchIOError
  50             (IO.listDirectory parserDir)
  51             (\exn ->
  52               if IO.isDoesNotExistError exn
  53               then return []
  54               else IO.throwIO exn
  55             ) in
  56   testGroup ("G"<>show g) $ (<$> inputs) $ \inp ->
  57     goldenVsStringDiff (takeBaseName (dropExtensions inp)) goldenDiff
  58       (dropExtensions inp<.>"expected.txt") $ do
  59       input <- readFile inp
  60       return $ fromString $
  61         case p input of
  62           Left err -> show err
  63           Right a -> a
  64
  65 parsers :: [Text -> Either (P.ParsingError Text) String]
  66 parsers =
  67   [ p1, p2, p3, p4, p5, p6, p7, p8, p9
  68   , p10, p11, p12, p13, p14, p15, p16
  69   ]
  70
  71 p1 = $$(TH.Code $ TH.runIO s1)
  72 p2 = $$(TH.Code $ TH.runIO s2)
  73 p3 = $$(TH.Code $ TH.runIO s3)
  74 p4 = $$(TH.Code $ TH.runIO s4)
  75 p5 = $$(TH.Code $ TH.runIO s5)
  76 p6 = $$(TH.Code $ TH.runIO s6)
  77 p7 = $$(TH.Code $ TH.runIO s7)
  78 p8 = $$(TH.Code $ TH.runIO s8)
  79 p9 = $$(TH.Code $ TH.runIO s9)
  80 p10 = $$(TH.Code $ TH.runIO s10)
  81 p11 = $$(TH.Code $ TH.runIO s11)
  82 p12 = $$(TH.Code $ TH.runIO s12)
  83 p13 = $$(TH.Code $ TH.runIO s13)
  84 p14 = $$(TH.Code $ TH.runIO s14)
  85 p15 = $$(TH.Code $ TH.runIO s15)
  86 p16 = $$(TH.Code $ TH.runIO s16)