test/Golden.hs

   1 {-# LANGUAGE DataKinds #-}
   2 {-# LANGUAGE TypeApplications #-}
   3 module Golden where
   4
   5 import Control.Arrow (left)
   6 import Control.Monad (Monad(..))
   7 import Data.Either (Either(..))
   8 import Data.Function (($), (.))
   9 import Data.Functor ((<$>))
  10 import Data.Locale
  11 import Data.Semigroup (Semigroup(..))
  12 import Data.String (String)
  13 import System.FilePath (FilePath)
  14 import System.IO (IO)
  15 import Text.Show (Show(..))
  16 import qualified Data.ByteString.Lazy as BSL
  17 import qualified Data.List as List
  18 import qualified Data.Map.Strict as Map
  19 import qualified Data.Text as Text
  20 import qualified Data.Text.Lazy          as TL
  21 import qualified Data.Text.Lazy.Encoding as TL
  22 import qualified Data.TreeSeq.Strict as TreeSeq
  23 import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
  24 import qualified Text.Megaparsec as P
  25
  26 import Test.Tasty
  27 import Test.Tasty.Golden
  28
  29 -- * Golden testing utilities
  30 testGolden :: TestName -> TestName -> IO (Either String BSL.ByteString) -> TestTree
  31 testGolden inputFile expectedExt =
  32         goldenVsStringDiff inputFile diffGolden (inputFile <> expectedExt)
  33          . (>>= unLeft)
  34
  35 diffGolden :: FilePath -> FilePath -> [String]
  36 diffGolden ref new = ["diff", "-u", ref, new]
  37
  38 unLeft :: Either String BSL.ByteString -> IO BSL.ByteString
  39 unLeft = \case
  40  Left err -> return $ TL.encodeUtf8 $ TL.pack err
  41  Right a  -> return a
  42
  43 -- * All golden tests
  44 goldensIO :: IO TestTree
  45 goldensIO = do
  46         inputFiles <- List.sort <$> findByExtension [".args"] "test/Golden"
  47         return $
  48                 testGroup "Args"
  49                  [ goldensRead inputFiles
  50                  ]
  51
  52 -- * Tests
  53 readArgs :: FilePath -> IO (Either String [String])
  54 readArgs inputFile =
  55         Right .
  56         List.lines .
  57         TL.unpack .
  58         TL.decodeUtf8 <$>
  59         BSL.readFile inputFile
  60
  61 goldensRead :: [FilePath] -> TestTree
  62 goldensRead inputFiles =
  63         testGroup "Read"
  64          [ testGolden inputFile ".args.read" $
  65                 readArgs inputFile >>= \args ->
  66                         return $
  67                                 TL.encodeUtf8
  68                                  . TL.pack
  69                                  . TCT.runPretty 0
  70                                  <$> args
  71          | inputFile <- inputFiles
  72          ]