filepather-0.7.0.0: test/FilePatherTests.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

{- HLINT ignore "Functor law" -}
{- HLINT ignore "Monad law, left identity" -}
{- HLINT ignore "Monad law, right identity" -}
{- HLINT ignore "Use <$>" -}
{- HLINT ignore "Alternative law, left identity" -}
{- HLINT ignore "Alternative law, right identity" -}
{- HLINT ignore "Monoid law, left identity" -}
{- HLINT ignore "Monoid law, right identity" -}
{- HLINT ignore "Use asks" -}

{- | Laws of the instances of 'FilePather', and of the combinators.

A 'FilePather' is a function, so it is observed by applying it to a generated
file path. Functions are generated with hedgehog-fn.
-}
module FilePatherTests (
  filePatherTests,
) where

import Control.Applicative (Alternative (..), Const (..))
import Control.Lens (view, _Wrapped)
import Control.Monad ((>=>))
import Control.Monad.Fix (fix, mfix)
import Control.Monad.Reader (ask, asks, local)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Zip (munzip, mzip)
import Control.Selective ((<*?))
import Data.Functor.Alt ((<!>))
import Data.Functor.Apply ((<.>))
import Data.Functor.Bind ((>>-))
import Data.Functor.Contravariant (Contravariant (..), Predicate (..))
import Data.Functor.Contravariant.Divisible (choose, conquer, divide, lose)
import Data.Functor.Identity (Identity (..))
import Data.Functor.Plus (zero)
import Data.Functor.Rep (index, tabulate)
import Data.Void (absurd)
import Gens
import Hedgehog
import Hedgehog.Function (Fn, apply, fn)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Laws (Laws)
import System.FilePather
import Witherable (mapMaybe)

-- | Apply a 'FilePather' to a file path.
at :: FilePather f a -> FilePath -> f a
at =
  view _Wrapped

-- | A Kleisli arrow from 'Int' to 'FilePather' @[]@.
genKleisli :: Gen (Fn (Int, Int) [Int])
genKleisli =
  fn genIntList

kleisli :: Fn (Int, Int) [Int] -> Int -> FilePather [] Int
kleisli g a =
  FilePather (\p -> apply g (a, pathKey p))

-- | A 'FilePather' that produces file paths.
genPaths :: Gen (Fn Int [FilePath])
genPaths =
  fn (Gen.list (Range.linear 0 2) genPath)

filePatherTests :: Laws
filePatherTests =
  [ ("Functor identity", prop_functorIdentity)
  , ("Functor composition", prop_functorComposition)
  , ("Applicative identity", prop_applicativeIdentity)
  , ("Applicative composition", prop_applicativeComposition)
  , ("Applicative homomorphism", prop_applicativeHomomorphism)
  , ("Applicative interchange", prop_applicativeInterchange)
  , ("Apply agrees with Applicative", prop_applyAgrees)
  , ("Monad left identity", prop_monadLeftIdentity)
  , ("Monad right identity", prop_monadRightIdentity)
  , ("Monad associativity", prop_monadAssociativity)
  , ("Bind agrees with Monad", prop_bindAgrees)
  , ("Alternative left identity", prop_alternativeLeftIdentity)
  , ("Alternative right identity", prop_alternativeRightIdentity)
  , ("Alternative associativity", prop_alternativeAssociativity)
  , ("Alt and Plus agree with Alternative", prop_altAgrees)
  , ("Semigroup associativity", prop_semigroupAssociativity)
  , ("Monoid identity", prop_monoidIdentity)
  , ("Filterable identity", prop_filterableIdentity)
  , ("Filterable composition", prop_filterableComposition)
  , ("Selective identity", prop_selectiveIdentity)
  , ("MonadFix purity", prop_monadFixPurity)
  , ("MonadZip information preservation", prop_monadZip)
  , ("MonadReader ask", prop_ask)
  , ("MonadReader local", prop_local)
  , ("MonadTrans lift . pure", prop_liftPure)
  , ("MonadTrans lift bind", prop_liftBind)
  , ("Representable index . tabulate", prop_indexTabulate)
  , ("Representable tabulate . index", prop_tabulateIndex)
  , ("Contravariant identity", prop_contravariantIdentity)
  , ("Contravariant composition", prop_contravariantComposition)
  , ("Divisible identity", prop_divisibleIdentity)
  , ("Decidable identity", prop_decidableIdentity)
  , ("~> left identity", prop_pipeLeftIdentity)
  , ("~> right identity", prop_pipeRightIdentity)
  , ("~> associativity", prop_pipeAssociativity)
  , ("onFile", prop_onFile)
  , ("whenFile const True", prop_whenFileTrue)
  , ("whenFile const False", prop_whenFileFalse)
  , ("hoistFilePather id", prop_hoistIdentity)
  , ("everyFile applies to every file", prop_everyFileAll)
  , ("everyFile skips every file", prop_everyFileNone)
  , ("isWithin parent", prop_isWithin)
  ]

prop_functorIdentity :: Property
prop_functorIdentity =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (fmap id (toFilePather x)) p === at (toFilePather x) p

prop_functorComposition :: Property
prop_functorComposition =
  property $
    do
      x <- forAll genFilePatherList
      f <- forAll genFnInt
      g <- forAll genFnInt
      p <- forAll genPath
      at (fmap (apply f . apply g) (toFilePather x)) p === at (fmap (apply f) (fmap (apply g) (toFilePather x))) p

prop_applicativeIdentity :: Property
prop_applicativeIdentity =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (pure id <*> toFilePather x) p === at (toFilePather x) p

prop_applicativeComposition :: Property
prop_applicativeComposition =
  property $
    do
      u <- forAll genFilePatherListFn
      v <- forAll genFilePatherListFn
      w <- forAll genFilePatherList
      p <- forAll genPath
      let (u', v', w') = (toFilePatherFn u, toFilePatherFn v, toFilePather w)
      at (pure (.) <*> u' <*> v' <*> w') p === at (u' <*> (v' <*> w')) p

prop_applicativeHomomorphism :: Property
prop_applicativeHomomorphism =
  property $
    do
      f <- forAll genFnInt
      x <- forAll genInt
      p <- forAll genPath
      at (pure (apply f) <*> pure x :: FilePather [] Int) p === at (pure (apply f x)) p

prop_applicativeInterchange :: Property
prop_applicativeInterchange =
  property $
    do
      u <- forAll genFilePatherListFn
      y <- forAll genInt
      p <- forAll genPath
      at (toFilePatherFn u <*> pure y) p === at (pure ($ y) <*> toFilePatherFn u) p

prop_applyAgrees :: Property
prop_applyAgrees =
  property $
    do
      u <- forAll genFilePatherListFn
      w <- forAll genFilePatherList
      p <- forAll genPath
      at (toFilePatherFn u <.> toFilePather w) p === at (toFilePatherFn u <*> toFilePather w) p

prop_monadLeftIdentity :: Property
prop_monadLeftIdentity =
  property $
    do
      a <- forAll genInt
      k <- forAll genKleisli
      p <- forAll genPath
      at (pure a >>= kleisli k) p === at (kleisli k a) p

prop_monadRightIdentity :: Property
prop_monadRightIdentity =
  property $
    do
      m <- forAll genFilePatherList
      p <- forAll genPath
      at (toFilePather m >>= pure) p === at (toFilePather m) p

prop_monadAssociativity :: Property
prop_monadAssociativity =
  property $
    do
      m <- forAll genFilePatherList
      k <- forAll genKleisli
      h <- forAll genKleisli
      p <- forAll genPath
      at ((toFilePather m >>= kleisli k) >>= kleisli h) p === at (toFilePather m >>= (kleisli k >=> kleisli h)) p

prop_bindAgrees :: Property
prop_bindAgrees =
  property $
    do
      m <- forAll genFilePatherList
      k <- forAll genKleisli
      p <- forAll genPath
      at (toFilePather m >>- kleisli k) p === at (toFilePather m >>= kleisli k) p

prop_alternativeLeftIdentity :: Property
prop_alternativeLeftIdentity =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (empty <|> toFilePather x) p === at (toFilePather x) p

prop_alternativeRightIdentity :: Property
prop_alternativeRightIdentity =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (toFilePather x <|> empty) p === at (toFilePather x) p

prop_alternativeAssociativity :: Property
prop_alternativeAssociativity =
  property $
    do
      x <- forAll genFilePatherMaybe
      y <- forAll genFilePatherMaybe
      z <- forAll genFilePatherMaybe
      p <- forAll genPath
      let (x', y', z') = (toFilePather x, toFilePather y, toFilePather z)
      at ((x' <|> y') <|> z') p === at (x' <|> (y' <|> z')) p

prop_altAgrees :: Property
prop_altAgrees =
  property $
    do
      x <- forAll genFilePatherList
      y <- forAll genFilePatherList
      p <- forAll genPath
      at (toFilePather x <!> toFilePather y) p === at (toFilePather x <|> toFilePather y) p
      at (zero :: FilePather [] Int) p === at empty p

prop_semigroupAssociativity :: Property
prop_semigroupAssociativity =
  property $
    do
      x <- forAll genFilePatherList
      y <- forAll genFilePatherList
      z <- forAll genFilePatherList
      p <- forAll genPath
      let (x', y', z') = (toFilePather x, toFilePather y, toFilePather z)
      at ((x' <> y') <> z') p === at (x' <> (y' <> z')) p

prop_monoidIdentity :: Property
prop_monoidIdentity =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (mempty <> toFilePather x) p === at (toFilePather x) p
      at (toFilePather x <> mempty) p === at (toFilePather x) p

prop_filterableIdentity :: Property
prop_filterableIdentity =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (mapMaybe Just (toFilePather x)) p === at (toFilePather x) p

prop_filterableComposition :: Property
prop_filterableComposition =
  property $
    do
      x <- forAll genFilePatherList
      f <- forAll (fn (Gen.maybe genInt) :: Gen (Fn Int (Maybe Int)))
      g <- forAll (fn (Gen.maybe genInt) :: Gen (Fn Int (Maybe Int)))
      p <- forAll genPath
      at (mapMaybe (apply f) (mapMaybe (apply g) (toFilePather x))) p === at (mapMaybe (apply g >=> apply f) (toFilePather x)) p

prop_selectiveIdentity :: Property
prop_selectiveIdentity =
  property $
    do
      x <- forAll (fn (Gen.list (Range.linear 0 3) (Gen.either genInt genInt)) :: Gen (Fn Int [Either Int Int]))
      p <- forAll genPath
      at (toFilePather x <*? pure id) p === at (either id id <$> toFilePather x) p

prop_monadFixPurity :: Property
prop_monadFixPurity =
  property $
    do
      n <- forAll genInt
      p <- forAll genPath
      at (mfix (pure . const n) :: FilePather Maybe Int) p === at (pure (fix (const n))) p

prop_monadZip :: Property
prop_monadZip =
  property $
    do
      a <- forAll (fn genInt :: Gen (Fn Int Int))
      b <- forAll (fn genInt :: Gen (Fn Int Int))
      p <- forAll genPath
      let (ma, mb) = (FilePather (Identity . apply a . pathKey), FilePather (Identity . apply b . pathKey))
          (x, y) = munzip (mzip ma mb)
      (at x p, at y p) === (at ma p, at mb p)

prop_ask :: Property
prop_ask =
  property $
    do
      p <- forAll genPath
      at (ask :: FilePather Identity FilePath) p === Identity p

prop_local :: Property
prop_local =
  property $
    do
      f <- forAll (fn genPath :: Gen (Fn Int String))
      p <- forAll genPath
      let g = apply f . pathKey
      at (local g ask :: FilePather Identity FilePath) p === at (asks g) p

prop_liftPure :: Property
prop_liftPure =
  property $
    do
      a <- forAll genInt
      p <- forAll genPath
      at (lift (pure a) :: FilePather [] Int) p === at (pure a) p

prop_liftBind :: Property
prop_liftBind =
  property $
    do
      m <- forAll genIntList
      f <- forAll (fn genIntList :: Gen (Fn Int [Int]))
      p <- forAll genPath
      at (lift (m >>= apply f)) p === at (lift m >>= (lift . apply f)) p

prop_indexTabulate :: Property
prop_indexTabulate =
  property $
    do
      h <- forAll (fn genInt :: Gen (Fn Int Int))
      p <- forAll genPath
      index (tabulate (\(q, ()) -> apply h (pathKey q)) :: FilePather Identity Int) (p, ()) === apply h (pathKey p)

prop_tabulateIndex :: Property
prop_tabulateIndex =
  property $
    do
      h <- forAll (fn genInt :: Gen (Fn Int Int))
      p <- forAll genPath
      let x = FilePather (Identity . apply h . pathKey)
      at (tabulate (index x)) p === at x p

prop_contravariantIdentity :: Property
prop_contravariantIdentity =
  property $
    do
      h <- forAll (fn genIntList :: Gen (Fn Int [Int]))
      p <- forAll genPath
      let x = FilePather (Const . apply h . pathKey) :: FilePather (Const [Int]) Int
      at (contramap id x) p === at x p

prop_contravariantComposition :: Property
prop_contravariantComposition =
  property $
    do
      h <- forAll (fn genIntList :: Gen (Fn Int [Int]))
      f <- forAll genFnInt
      g <- forAll genFnInt
      p <- forAll genPath
      let x = FilePather (Const . apply h . pathKey) :: FilePather (Const [Int]) Int
      at (contramap (apply f) (contramap (apply g) x)) p === at (contramap (apply g . apply f) x) p

prop_divisibleIdentity :: Property
prop_divisibleIdentity =
  property $
    do
      h <- forAll (fn genIntList :: Gen (Fn Int [Int]))
      p <- forAll genPath
      let x = FilePather (Const . apply h . pathKey) :: FilePather (Const [Int]) Int
      at (divide (\a -> (a, a)) x conquer) p === at x p
      at (divide (\a -> (a, a)) conquer x) p === at x p

prop_decidableIdentity :: Property
prop_decidableIdentity =
  property $
    do
      h <- forAll (fn (fn Gen.bool) :: Gen (Fn Int (Fn Int Bool)))
      p <- forAll genPath
      a <- forAll genInt
      let x = FilePather (Predicate . apply . apply h . pathKey) :: FilePather Predicate Int
      getPredicate (at (choose Left x (lose absurd)) p) a === getPredicate (at x p) a

prop_pipeLeftIdentity :: Property
prop_pipeLeftIdentity =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (ask ~> toFilePather x) p === at (toFilePather x) p

prop_pipeRightIdentity :: Property
prop_pipeRightIdentity =
  property $
    do
      x <- forAll genPaths
      p <- forAll genPath
      at (toFilePather x ~> ask) p === at (toFilePather x) p

prop_pipeAssociativity :: Property
prop_pipeAssociativity =
  property $
    do
      x <- forAll genPaths
      y <- forAll genPaths
      z <- forAll genFilePatherList
      p <- forAll genPath
      let (x', y', z') = (toFilePather x, toFilePather y, toFilePather z)
      at ((x' ~> y') ~> z') p === at (x' ~> (y' ~> z')) p

prop_onFile :: Property
prop_onFile =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      q <- forAll genPath
      at (onFile q (toFilePather x)) p === at (toFilePather x) q

prop_whenFileTrue :: Property
prop_whenFileTrue =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (whenFile (const True) (toFilePather x)) p === at (toFilePather x) p

prop_whenFileFalse :: Property
prop_whenFileFalse =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (whenFile (const False) (toFilePather x)) p === []

prop_hoistIdentity :: Property
prop_hoistIdentity =
  property $
    do
      x <- forAll genFilePatherList
      p <- forAll genPath
      at (hoistFilePather id (toFilePather x)) p === at (toFilePather x) p

prop_everyFileAll :: Property
prop_everyFileAll =
  property $
    do
      fs <- forAll (Gen.list (Range.linear 0 5) genPath)
      d <- forAll genPath
      at (everyFile (pure fs) (rule (const True) ask) :: FilePather Identity [(FilePath, FilePath)]) d === Identity (zip fs fs)

prop_everyFileNone :: Property
prop_everyFileNone =
  property $
    do
      fs <- forAll (Gen.list (Range.linear 0 5) genPath)
      d <- forAll genPath
      at (everyFile (pure fs) (rule (const False) ask) :: FilePather Identity [(FilePath, FilePath)]) d === Identity []

prop_isWithin :: Property
prop_isWithin =
  property $
    do
      d <- forAll genPath
      f <- forAll genPath
      assert (isWithin d (d <> "/" <> f))