packages feed

super-user-spark-0.4.0.0: test/SuperUserSpark/Check/TestUtils.hs

{-# LANGUAGE TemplateHaskell #-}

module SuperUserSpark.Check.TestUtils where

import TestImport

import SuperUserSpark.Bake.Gen ()
import SuperUserSpark.Bake.Types
import SuperUserSpark.Check.Gen ()
import SuperUserSpark.Check.Internal
import SuperUserSpark.Check.Types
import SuperUserSpark.CoreTypes
import SuperUserSpark.Diagnose.Types

-- * Test utils for checkDeployment
shouldBeImpossible' :: DiagnosedDeployment -> Expectation
shouldBeImpossible' dd = checkDeployment dd `shouldSatisfy` impossibleDeployment

shouldBeImpossibleDeployment :: [CheckResult] -> Expectation
shouldBeImpossibleDeployment dd =
    bestResult dd `shouldSatisfy` impossibleDeployment

-- * Test utils for checkSingle
isDirty :: CheckResult -> Bool
isDirty (Dirty _ _ _) = True
isDirty _ = False

isReady :: CheckResult -> Bool
isReady (Ready _) = True
isReady _ = False

isDone :: CheckResult -> Bool
isDone AlreadyDone = True
isDone _ = False

isImpossible :: CheckResult -> Bool
isImpossible (Impossible _) = True
isImpossible _ = False

shouldBeDirty
    :: DiagnosedFp
    -> DiagnosedFp
    -> DeploymentKind
    -> CleanupInstruction
    -> Expectation
shouldBeDirty src dst kind eci =
    case checkSingle src dst kind of
        Dirty _ ins ci -> do
            ci `shouldBe` eci
            let tp = dropTrailingPathSeparator . toFilePath
            case ins of
                CopyFile isrc idst -> do
                    tp isrc `shouldBe` toPath (diagnosedFilePath src)
                    tp idst `shouldBe` toPath (diagnosedFilePath dst)
                    CopyDeployment `shouldBe` kind
                CopyDir isrc idst -> do
                    tp isrc `shouldBe` toPath (diagnosedFilePath src)
                    tp idst `shouldBe` toPath (diagnosedFilePath dst)
                    CopyDeployment `shouldBe` kind
                LinkFile isrc idst -> do
                    tp isrc `shouldBe` toPath (diagnosedFilePath src)
                    tp idst `shouldBe` toPath (diagnosedFilePath dst)
                    LinkDeployment `shouldBe` kind
                LinkDir isrc idst -> do
                    tp isrc `shouldBe` toPath (diagnosedFilePath src)
                    tp idst `shouldBe` toPath (diagnosedFilePath dst)
                    LinkDeployment `shouldBe` kind
        t ->
            expectationFailure $
            unlines
                [ "checkSingle"
                , show src
                , show dst
                , show kind
                , "should be dirty but is"
                , show t
                ]

shouldBeReady :: DiagnosedFp -> DiagnosedFp -> DeploymentKind -> Expectation
shouldBeReady src dst kind = checkSingle src dst kind `shouldSatisfy` isReady

shouldBeDone :: DiagnosedFp -> DiagnosedFp -> DeploymentKind -> Expectation
shouldBeDone src dst kind = checkSingle src dst kind `shouldSatisfy` isDone

shouldBeImpossible :: DiagnosedFp
                   -> DiagnosedFp
                   -> DeploymentKind
                   -> Expectation
shouldBeImpossible src dst kind =
    checkSingle src dst kind `shouldSatisfy` isImpossible

validWith :: Diagnostics -> Gen DiagnosedFp
validWith d = D <$> genValid <*> pure d <*> genValid