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