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 module Golden.Parser where
   6
   7 import Control.Monad (Monad(..))
   8 import Data.Either (Either(..))
   9 import Data.Function (($))
  10 import Data.Functor ((<$>))
  11 import Data.Int (Int)
  12 import Data.Semigroup (Semigroup(..))
  13 import Data.String (IsString(..))
  14 import Data.Text.IO (readFile)
  15 import Test.Tasty
  16 import Test.Tasty.Golden
  17 import Text.Show (Show(..))
  18 import System.IO.Unsafe (unsafePerformIO)
  19 import System.FilePath ((<.>), (</>), dropExtensions)
  20 import qualified Data.List as List
  21 import qualified System.IO.Error as IO
  22 import qualified System.Directory as IO
  23 import qualified Control.Exception as IO
  24
  25 import Golden.Utils
  26 import Parser
  27
  28 goldens :: TestTree
  29 goldens = testGroup "Parser" $
  30   (\f -> List.zipWith f parsers [1::Int ..]) $ \(P p) g ->
  31   let parserDir = "test/Golden/Parser/G"<>show g in
  32   let inputs =
  33         ((parserDir </>) <$>) $
  34         List.sort $
  35         List.filter (List.isSuffixOf ".input.txt") $
  36         unsafePerformIO $
  37           IO.catchIOError
  38             (IO.listDirectory parserDir)
  39             (\exn ->
  40               if IO.isDoesNotExistError exn
  41               then return []
  42               else IO.throwIO exn
  43             ) in
  44   testGroup ("G"<>show g) $ (<$> inputs) $ \inp ->
  45     goldenVsStringDiff inp goldenDiff
  46       (dropExtensions inp<.>"expected.txt") $ do
  47       input <- readFile inp
  48       return $ fromString $
  49         case p input of
  50           Left err -> show err
  51           Right a -> show a