Skip to content
Snippets Groups Projects
Spec.hs 2.19 KiB
Newer Older
{-# LANGUAGE OverloadedStrings #-}
module Main ( main ) where

import           Data.ByteString           (fromStrict)
import           Data.Text.Encoding        (encodeUtf8)
import           Dhall                     (auto, embed, inject, input)
import           Dhall.Pretty              (layout, prettyExpr)
Daniel Firth's avatar
Daniel Firth committed
import           Horizon.Spec              (Overlay, PackageSet)
import           Prettyprinter.Render.Text (renderStrict)
import           Test.Tasty                (TestTree, defaultMain, testGroup)
import           Test.Tasty.Golden         (goldenVsString)

main :: IO ()
main = defaultMain tests

tests :: TestTree
Daniel Firth's avatar
Daniel Firth committed
tests = testGroup "Tests"
          [ samplePackageSet
          , modifiedPackageSet
          , sampleOverlay
          , modifiedOverlay
          ]

samplePackageSet :: TestTree
samplePackageSet = goldenVsString "sample package set" "./test/data/sample-package-set/output.golden" $ do
Daniel Firth's avatar
Daniel Firth committed
                    (x :: PackageSet) <- input auto "./test/data/sample-package-set/input.dhall"
                    let doc = prettyExpr $ embed inject x
                    pure $ fromStrict $ encodeUtf8 $ renderStrict (layout doc)

modifiedPackageSet :: TestTree
modifiedPackageSet = goldenVsString "modified package set" "./test/data/modified-package-set/output.golden" $ do
                    (x :: PackageSet) <- input auto "./test/data/modified-package-set/input.dhall"
                    let doc = prettyExpr $ embed inject x
                    pure $ fromStrict $ encodeUtf8 $ renderStrict (layout doc)
Daniel Firth's avatar
Daniel Firth committed

sampleOverlay :: TestTree
sampleOverlay = goldenVsString "sample overlay" "./test/data/sample-overlay/output.golden" $ do
                    (x :: Overlay) <- input auto "./test/data/sample-overlay/input.dhall"
                    let doc = prettyExpr $ embed inject x
                    pure $ fromStrict $ encodeUtf8 $ renderStrict (layout doc)

modifiedOverlay :: TestTree
modifiedOverlay = goldenVsString "modified overlay" "./test/data/modified-overlay/output.golden" $ do
                    (x :: Overlay) <- input auto "./test/data/modified-overlay/input.dhall"
                    let doc = prettyExpr $ embed inject x
                    pure $ fromStrict $ encodeUtf8 $ renderStrict (layout doc)