tests/Goldens.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 -- For Golden
   3 {-# LANGUAGE ExistentialQuantification #-}
   4 {-# LANGUAGE ImportQualifiedPost #-}
   5 {-# LANGUAGE PartialTypeSignatures #-}
   6 -- For Golden
   7 {-# LANGUAGE RankNTypes #-}
   8 {-# OPTIONS_GHC -Wno-orphans #-}
   9
  10 module Goldens where
  11
  12 import Control.Monad.Trans.Reader as MT
  13 import Relude
  14 import System.FilePath qualified as Sys
  15 import System.IO.Unsafe (unsafePerformIO)
  16 import Test.Tasty
  17 import Test.Tasty.Golden
  18 import Text.Printf (printf)
  19
  20 import Examples.Ex01 qualified as Ex01
  21 import Examples.Ex02 qualified as Ex02
  22 import Examples.Ex03 qualified as Ex03
  23 import Examples.Ex04 qualified as Ex04
  24 import Examples.Ex05 qualified as Ex05
  25 import Literate.Web
  26 import Paths_literate_web
  27 import Utils
  28
  29 test :: TestTree
  30 test =
  31   testGroup
  32     "Goldens"
  33     [ testGroup
  34         "Compiler"
  35         [ testGroup
  36           (printf "Site%03d" siteNum)
  37           [ withResource
  38             (goldenCompiler CompilerEnv{..})
  39             (\_ -> return ())
  40             $ \compilerIO ->
  41               testGroup
  42                 (printf "Model%02d" modelNum)
  43                 [ goldenVsFileDiff
  44                   (printf "/%s" destPath)
  45                   goldenDiff
  46                   (getGoldenDir (printf "Compiler/Site%03d/Model%02d/Expected/%s" siteNum modelNum destPath))
  47                   (compilerEnvDest Sys.</> destPath)
  48                   compilerIO
  49                 | destPath <- goldenManifest
  50                 ]
  51           | (modelNum, Golden{..}) <- ol goldenModels
  52           , let compilerEnvDest = getGoldenDir (printf "Compiler/Site%03d/Model%02d/Got/" siteNum modelNum)
  53           , let compilerEnvIndex :: FilePath = "index.html"
  54           -- , let compilerEnvSource = getGoldenDir (printf "Compiler/Site%03d/Model%02d/Source/" siteNum modelNum)
  55           ]
  56         | (siteNum, goldenModels) <- ol goldens
  57         ]
  58     ]
  59
  60 getGoldenDir :: FilePath -> FilePath
  61 getGoldenDir p = unsafePerformIO $ getDataFileName $ "tests/Goldens/" <> p
  62
  63 goldenDiff :: FilePath -> FilePath -> [String]
  64 goldenDiff ref new = ["diff", "-u", "-w", "-B", ref, new]
  65
  66 data Golden = Golden
  67   { goldenCompiler :: CompilerEnv -> IO ()
  68   , goldenManifest :: [Sys.FilePath]
  69   }
  70 goldens :: [[Golden]]
  71 goldens =
  72   {- [ Golden @() index [()]
  73     , Golden @()
  74         ("foo" </> index)
  75         [()]
  76     , Golden @(Either () ())
  77         ("root" </> ("foo" </> index <+> "bar" </> index))
  78         [()]
  79     , Golden @(Either () (), Either () ())
  80         ( "root"
  81             </> ("a" </> literalSlug "b" <+> "c" </> literalSlug "d")
  82             <.> ("A" </> literalSlug "B" <+> "C" </> literalSlug "D")
  83             <. index
  84         )
  85         [()]
  86   -}
  87   [
  88     [ Golden
  89         { goldenCompiler = \env -> compile env Ex01.router Ex01.content
  90         , goldenManifest = runIdentity $ manifest Ex01.router
  91         }
  92     ]
  93   ,
  94     [ Golden
  95         { goldenCompiler = \env -> compile env Ex02.router Ex02.content
  96         , goldenManifest = runIdentity $ manifest Ex02.router
  97         }
  98     ]
  99   , [ Golden
 100       { goldenCompiler = \env -> MT.runReaderT (compile env Ex03.router Ex03.content) model
 101       , goldenManifest = runReader (manifest Ex03.router) model
 102       }
 103     | model <- [Ex03.model1, Ex03.model2]
 104     ]
 105   , [ Golden
 106       { goldenCompiler = \env -> MT.runReaderT (compile env Ex04.router Ex04.content) model
 107       , goldenManifest = runReader (manifest Ex04.router) model
 108       }
 109     | model <- [Ex04.model1]
 110     ]
 111   , [ Golden
 112       { goldenCompiler = \env -> MT.runReaderT (MT.runReaderT (compile env Ex05.router Ex05.content) model03) model04
 113       , goldenManifest = MT.runReader (MT.runReaderT (manifest Ex05.router) model03) model04
 114       }
 115     | model03 <- [Ex03.model1, Ex03.model2]
 116     , model04 <- [Ex04.model1]
 117     ]
 118   ]