cached (empty) → 0.1.0.0
raw patch · 10 files changed
+1277/−0 lines, 10 filesdep +QuickCheckdep +basedep +cachedsetup-changed
Dependencies added: QuickCheck, base, cached, containers, directory, doctest, filepath, protolude, quickcheck-assertions, shake, text
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +20/−0
- Setup.hs +2/−0
- cached.cabal +71/−0
- src/Data/Cached.hs +275/−0
- src/Data/Cached/Internal.hs +172/−0
- test/Spec.hs +10/−0
- test/Test/Data/Cached.hs +515/−0
- test/Test/Util.hs +179/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for cached++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Guillaume Chérel (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Guillaume Chérel nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,20 @@+# cached++Cache values to disk.++The module `Data.Cached` lets you cache values to disk to avoid re-running+(potentially long) computations between consecutive executions of your+program. Cached values are recomputed only when needed, i.e. when other+cached values on which they depend change. Independent computations are+run in parallel. It offers convenient fonctions for caching to text files,+but caching and uncaching using arbitrary IO actions is also possible.++The module was motivated by writing scientific data flows, simulation+experiments or data science scripts. Those often involve long+computations and create "flows" where the output of some computation+are the inputs of others, until final results are produced (values,+figures, statistical tests, etc.).++See the module Data.Cached documentation:+- On hackage: <https://hackage.haskell.org/package/cached/docs/Data-Cached.html>+- In the source: [./src/Data/Cached.hs](./src/Data/Cached.hs)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cached.cabal view
@@ -0,0 +1,71 @@+cabal-version: 1.12+name: cached+version: 0.1.0.0+license: BSD3+license-file: LICENSE+copyright: 2018 Guillaume Chérel+maintainer: guillaume.cherel@iscpif.fr+author: Guillaume Chérel+homepage: https://github.com/guillaumecherel/cached#readme+bug-reports: https://github.com/guillaumecherel/cached/issues+synopsis: Cache values to disk.+description:+ The module `Data.Cached` lets you cache values to disk to avoid re-running+ (potentially long) computations between consecutive executions of your+ program. Cached values are recomputed only when needed, i.e. when other+ cached values on which they depend change. Independent computations are+ run in parallel. It offers convenient fonctions for caching to text files,+ but caching and uncaching using arbitrary IO actions is also possible.+ .+ The module was motivated by writing scientific data flows, simulation+ experiments or data science scripts. Those often involve long+ computations and create "flows" where the output of some computation+ are the inputs of others, until final results are produced (values,+ figures, statistical tests, etc.).+ .+ See the module "Data.Cached" documentation:+category: Workflow, Data Flow+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/guillaumecherel/cached++library+ exposed-modules:+ Data.Cached+ Data.Cached.Internal+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5,+ containers >=0.5.10 && <0.7,+ protolude >=0.2.2 && <0.3,+ shake >=0.16.4 && <0.18,+ text >=1.2.3 && <1.3++test-suite cached-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules:+ Test.Data.Cached+ Test.Util+ default-language: Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5,+ cached -any,+ containers >=0.5.10 && <0.7,+ directory >=1.3.1 && <1.4,+ doctest >=0.16.0 && <0.17,+ filepath >=1.4.2 && <1.5,+ protolude >=0.2.2 && <0.3,+ QuickCheck >=2.11.3 && <2.13,+ quickcheck-assertions >=0.3.0 && <0.4,+ shake >=0.16.4 && <0.18,+ text >=1.2.3 && <1.3
+ src/Data/Cached.hs view
@@ -0,0 +1,275 @@+{-| = Usage++ A value of type "Cached a" should be understood as a value of type "a" that is read from a file, or that is produced from data stored in one or more files, or from arbitrary IO actions.++ Cached values can be created from pure values,++>>> let a = cache' "/tmp/cached-ex/a" (pure 1) :: Cached Int++ or from files stored on disk.++>>> let b = source' "/tmp/cached-ex/b" :: Cached Int++ Use the functor and applicative instances to use cached values in+ new computations.++>>> let bigA = fmap (* 2) a+>>> let c = (+) <$> a <*> b++ The cached value "c" represents a value produced by summing+ together the values stored in "\/tmp\/cached-ex\/a" and+ "\/tmp\/cached-ex\/b". It is not yet associated to its own cache+ file. To actually store it into a cache file, use 'cache'' (or 'cache' for values that are not instances of Show and+ Read or when you want to control the file format, e.g. writing arrays+ to CSV files)++>>> let c' = cache' "/tmp/cached-ex/c" c++ Running the cached computation "c'" will execute all necessary+ computations and write results to files as expected:++>>> -- Before running, let's make sure the target directory is clean.+>>> :!mkdir -p /tmp/cached-ex+>>> :!rm -f /tmp/cached-ex/*+>>> :!echo 2 > /tmp/cached-ex/b+>>>+>>> runShake "/tmp/cached-ex/.shake" c'+# Writing cache (for /tmp/cached-ex/a)+# Writing cache (for /tmp/cached-ex/c)+Build completed ...+...++ Running it again won't run anything. Since none of the cached or+ source files have changed, there is nothing to re-compute.++>>> runShake "/tmp/cached-ex/.shake" c'+Build completed ...+...++ If we modify the content of "\/tmp\/cached-ex\/b", running "c'"+ again will only re-run the computation for "c'", and not for "a"+ since it does not depend on "b".++>>> :! echo 3 > /tmp/cached-ex/b+>>> runShake "/tmp/cached-ex/.shake" c'+# Writing cache (for /tmp/cached-ex/c)+Build completed ...+...++ The cache files and dependencies can be inspected with+ 'prettyCached'. ++>>> prettyCached c' >>= putStr+Cached Value = 4+Cached Needs:+ /tmp/cached-ex/c+Cached Build:+ /tmp/cached-ex/a+ /tmp/cached-ex/c+ /tmp/cached-ex/a+ /tmp/cached-ex/b++ The previous output means that the value carried by "c'" is 4, and that in order to be computed, it needs the file "\/tmp\/cached-ex\/c". The last field, "Cached Build", lists each file that is to be built by the cache system and their dependencies: "\/tmp\/cache-ex\/a" and "\/tmp\/cache-ex\/c"+ are created by the cache system, and the latter depends on+ "\/tmp\/cache-ex\/a" and "\/tmp\/cache-ex\/b"++ To put together different independent cached values into a single one so that they all get built together, use '<>'. However, "Cached a" is an instance of Semigroup only if "a" is. You can "sink" the cached values first, which will turn a "Cache a" into a "Cache ()", satisfying the Semigroup constraint.+ +>>> let d = sink' "/tmp/cached-ex/d" (pure 'd')+>>> let e = sink' "/tmp/cached-ex/e" (pure 'e')+>>> let de = d <> e+>>> prettyCached de >>= putStr+Cached Value = ()+Cached Needs:+Cached Build:+ /tmp/cached-ex/d+ /tmp/cached-ex/e++-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Cached (+ -- * Cached type+ Cached+ , getValue+ -- * Creation+ -- $creation+ , source+ , source'+ , fromIO+ -- * Caching values+ -- $caching+ , cache+ , cache'+ , cacheIO+ , sink+ , sink'+ , sinkIO+ , trigger+ -- * Running+ , toShakeRules+ , runShake+ -- * Showing+ , prettyCached+) where+ +import Protolude++import Control.Monad.Fail+import qualified Data.Set as Set+import Data.Text+import qualified Development.Shake as Shake++import Data.Cached.Internal++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Prelude (read)+++-- * Cached++-- | Extract the value cached value.+getValue :: Cached a -> IO (Either Text a)+getValue (CacheFail err) = return (Left err)+getValue (Cached a _ _) = runExceptT a+++-- $creation To create cached values from pure values, use 'pure'.+--+-- >>> let a = pure 1 :: Cached Int+-- >>> prettyCached a >>= putStr+-- Cached Value = 1+-- Cached Needs:+-- Cached Build:+--+-- Newly created cached values won't actually be written to files or+-- attached to IO actions yet, as denoted by the empty "Cached Build"+-- field. To associate them with actual cache files on disk, see+-- section "Caching values" below.+--+-- The following functions offer additionnal creation possibilities.+--++-- | Create a cached value from an input file.+source :: FilePath -> (Text -> Either Text a) -> Cached a+source path fromText = Cached+ { cacheRead = ExceptT $ first errMsg . fromText <$> readFile path+ , cacheNeeds = Set.singleton path+ , cacheBuild = mempty }+ where errMsg e = "Error reading file " <> pack path <> ": " <> e++-- | A convenient variant of 'source' when the type of the value to be read+-- instantiates 'Read'.+source' :: (Read a) => FilePath -> Cached a+source' path = source path fromText+ where fromText = bimap pack identity . readEither . unpack++-- | Create a cached value from an IO action that depends on some input files.+fromIO :: Set FilePath -> IO a -> Cached a+fromIO needs io = Cached (lift io) needs mempty+++-- $caching+-- These functions associate cached values to files on disk or IO actions.++-- | Associate a cached value to a file on disk.+cache :: FilePath -> (a -> Text) -> (Text -> Either Text a) -> Cached a+ -> Cached a+cache path toText fromText = cacheIO path+ ( writeFile path . toText )+ ( fromText <$> readFile path )++-- | A convenient variant of 'cache' when the type of the value to be read is+-- an instance of 'Read' and 'Show'.+cache' :: (Show a, Read a) => FilePath -> Cached a -> Cached a+cache' path = cache path show (bimap pack identity . readEither . unpack)++-- | Caching with arbitrary IO actions.+cacheIO :: FilePath -> (a -> IO ()) -> (IO (Either Text a)) -> Cached a+ -> Cached a+cacheIO _ _ _ (CacheFail err) = CacheFail err+cacheIO path write read a = if isBuilt path (cacheBuild a)+ then CacheFail ("The cache file already exists: " <> pack path)+ else Cached { cacheRead = ExceptT $ (fmap . first) errMsg $ read+ , cacheNeeds = Set.singleton path+ , cacheBuild = buildSingle path+ ( cacheRead a >>= lift . write )+ ( cacheNeeds a )+ <> cacheBuild a }+ where errMsg e = "Error reading file " <> pack path <> ": " <> e++-- | Associate a cached value to a file on disk without the possibility+-- to read it back. Useful for storing to a text file the final result of a+-- computation that doesn't need to be read again, like data for producing+-- figures, text output, etc.+sink :: FilePath -> (a -> Either Text Text) -> Cached a -> Cached ()+sink path toText = sinkIO path write+ where write = traverse (writeFile path) . toText++-- | A convenient variant of 'sink' when the written value type instantiates+-- 'Show'.+sink' :: (Show a) => FilePath -> Cached a -> Cached ()+sink' path = sink path (return . show)++-- | Sink with an arbitrary IO action.+sinkIO :: FilePath -> (a -> IO (Either Text ())) -> Cached a -> Cached ()+sinkIO _ _ (CacheFail err) = CacheFail err+sinkIO path write a = if isBuilt path (cacheBuild a)+ then CacheFail ("The cache file already exists: " <> pack path)+ else Cached { cacheRead = return ()+ , cacheNeeds = mempty+ , cacheBuild = buildSingle path+ (cacheRead a >>= ExceptT . write)+ (cacheNeeds a)+ <> cacheBuild a}++-- | Trigger an IO action that depends on a set of files. For example, +-- consider an executable "plot" that processes the content of a file+-- "data.csv" and writes an image to "fig.png". The figure creation can+-- be integrated into the cache system like so:+--+-- >>> import System.Process (callCommand)+-- >>> let t = trigger "fig.png" (return <$> callCommand "plot") (Set.fromList ["data.csv"])+-- >>> prettyCached t >>= putStr+-- Cached Value = ()+-- Cached Needs:+-- Cached Build:+-- fig.png+-- data.csv+-- +trigger :: FilePath -> IO (Either Text ()) -> Set FilePath -> Cached ()+trigger path action needs = sinkIO path (\_ -> action) (fromIO needs (return ()))+++-- ** Building++-- | Get shake 'Rules'. Those can be mixed together with other shake rules.+toShakeRules :: Cached a -> Shake.Rules ()+toShakeRules (CacheFail err) = Shake.action $ fail $ unpack err+toShakeRules a = buildShakeRules $ cacheBuild a++-- | Run the cached computation using shake (see <shakebuild.com>, "Development.Shake"). If you use the result of this function as your program's main, you can pass shake options as arguments. Try "my-program --help"+runShake :: FilePath -> Cached a -> IO ()+runShake shakeFiles a = Shake.shakeArgs Shake.shakeOptions+ { Shake.shakeFiles = shakeFiles+ , Shake.shakeThreads=0+ , Shake.shakeChange=Shake.ChangeModtimeAndDigest }+ ( toShakeRules a )++-- ** Pretty printing++prettyCached :: (Show a) => Cached a -> IO Text+prettyCached (CacheFail err) = return $ "CacheFail " <> err+prettyCached (Cached r n b) = do+ er <- runExceptT r+ case er of+ Left msg -> fail $ unpack msg+ Right r' -> return $ "Cached Value = " <> show r' <> "\n"+ <> "Cached Needs: \n"+ <> foldMap (\p -> " " <> pack p <> "\n") n+ <> "Cached Build: \n"+ <> (unlines $ fmap (" " <>) (lines $ prettyBuild b))+
+ src/Data/Cached/Internal.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Cached.Internal where++import Protolude++import Control.Monad.Fail+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Text+import Development.Shake++-- |A value that is produced from files on disk or arbitrary IO actions.+data Cached a = Cached { cacheRead :: ExceptT Text IO a+ , cacheNeeds :: Set FilePath+ , cacheBuild :: Build }+ | CacheFail Text++instance Functor Cached where+ fmap _ (CacheFail err) = CacheFail err+ fmap f (Cached r n b) = Cached (fmap f r) n b++instance Applicative Cached where+ pure a = Cached (return a) mempty mempty++ (CacheFail err) <*> _ = CacheFail err+ _ <*> (CacheFail err) = CacheFail err+ f <*> a = Cached ( cacheRead f <*> cacheRead a )+ ( cacheNeeds f <> cacheNeeds a )+ ( cacheBuild f <> cacheBuild a )++instance (Semigroup a) => Semigroup (Cached a) where+ (CacheFail err) <> _ = CacheFail err+ _ <> (CacheFail err) = CacheFail err+ (Cached cr1 cn1 cb1) <> (Cached cr2 cn2 cb2) =+ Cached { cacheRead = liftA2 (<>) cr1 cr2+ , cacheNeeds = cn1 <> cn2+ , cacheBuild = cb1 <> cb2 }++instance (Monoid a) => Monoid (Cached a) where+ mempty = Cached (return mempty) mempty mempty++instance Num a => Num (Cached a) where+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++ negate = fmap negate+ {-# INLINE negate #-}++ abs = fmap abs+ {-# INLINE abs #-}++ signum = fmap signum+ {-# INLINE signum #-}++ (+) = liftA2 (+)+ {-# INLINE (+) #-}++ (*) = liftA2 (*)+ {-# INLINE (*) #-}++ (-) = liftA2 (-)+ {-# INLINE (-) #-}++instance Fractional a => Fractional (Cached a) where+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++ recip = fmap recip+ {-# INLINE recip #-}++ (/) = liftA2 (/)+ {-# INLINE (/) #-}++instance Floating a => Floating (Cached a) where+ pi = pure pi+ {-# INLINE pi #-}++ exp = fmap exp+ {-# INLINE exp #-}++ sqrt = fmap sqrt+ {-# INLINE sqrt #-}++ log = fmap log+ {-# INLINE log #-}++ sin = fmap sin+ {-# INLINE sin #-}++ tan = fmap tan+ {-# INLINE tan #-}++ cos = fmap cos+ {-# INLINE cos #-}++ asin = fmap asin+ {-# INLINE asin #-}++ atan = fmap atan+ {-# INLINE atan #-}++ acos = fmap acos+ {-# INLINE acos #-}++ sinh = fmap sinh+ {-# INLINE sinh #-}++ tanh = fmap tanh+ {-# INLINE tanh #-}++ cosh = fmap cosh+ {-# INLINE cosh #-}++ asinh = fmap asinh+ {-# INLINE asinh #-}++ atanh = fmap atanh+ {-# INLINE atanh #-}++ acosh = fmap acosh+ {-# INLINE acosh #-}++ (**) = liftA2 (**)+ {-# INLINE (**) #-}++ logBase = liftA2 logBase+ {-# INLINE logBase #-}++-- * Build++newtype Build = Build {getBuild :: Map FilePath (ExceptT Text IO (), Set FilePath)}++instance Semigroup Build where+ (Build a) <> (Build b) = Build (a <> b)++instance Monoid Build where+ mempty = Build Map.empty++isBuilt :: FilePath -> Build -> Bool+isBuilt p (Build m) = Map.member p m++buildSingle :: FilePath -> ExceptT Text IO () -> Set FilePath -> Build+buildSingle path write needs = Build $ Map.singleton path (write, needs)++buildList :: Build -> [(FilePath, ExceptT Text IO (), Set FilePath)]+buildList (Build m) = fmap (\(a, (b, c)) -> (a,b,c)) (Map.toList m)++buildTargets :: Build -> [FilePath]+buildTargets (Build m) = Map.keys m++buildShakeRules :: Build -> Rules ()+buildShakeRules b = do+ want (buildTargets b)+ foldMap buildOne ( buildList b )+ where buildOne (outPath, write, needs) =+ outPath %> \_ -> do+ Development.Shake.need (Set.toList needs)+ e <- traced "Writing cache" $ runExceptT write+ case e of+ Right () -> return ()+ Left err -> fail $ "Error running shake rule building file " <> outPath <> " which needs " <> show needs <> "\nError message: "<> unpack err++prettyBuild :: Build -> Text+prettyBuild (Build a) = foldMap showOne $ Map.toList a+ where showOne :: (FilePath, (ExceptT Text IO (), Set FilePath)) -> Text+ showOne (target, (_, needs)) =+ pack target <> "\n"+ <> (unlines $ fmap (\n -> " " <> pack n) $ Set.toList needs)++
+ test/Spec.hs view
@@ -0,0 +1,10 @@+import Test.DocTest+import Test.Data.Cached (runTests)++main :: IO ()+main = do+ putStrLn "---- QuickCheck"+ runTests+ putStrLn "---- DocTest"+ doctest [ "src/Data/Cached.hs"+ , "src/Data/Cached/Internal.hs"]
+ test/Test/Data/Cached.hs view
@@ -0,0 +1,515 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Data.Cached where++import Protolude++import qualified Data.List as List+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Text+import Data.Text.Read+import Development.Shake+import Development.Shake.FilePath+import System.Directory+import Test.QuickCheck+import Test.QuickCheck.Assertions+import Test.Util++import Data.Cached+import Data.Cached.Internal++readInt :: Text -> Either Text Int+readInt = bimap pack fst . signed decimal++val :: Int -> FilePath -> Cached Int+val x p = pure x+ & cache p show readInt++addOne :: FilePath -> Cached (Int -> Int)+addOne p = pure (+ 1)++shakeGo testDir = shakeArgs shakeOptions+ { shakeReport = [testDir </> "shakeReport.html"]+ , shakeFiles = testDir </> ".shake/"+ }++ +-- Test that a file exists and contains the appropriate value.+testFile :: FilePath -> Text -> IO Property+testFile path content = do+ exists <- System.Directory.doesFileExist path+ if not exists+ then return $ counterexample ("File " <> path <> " does not exist") False+ else do + valInFile <- readFile path+ return $ counterexample ("Cached file " <> path <> " contains "+ <> show valInFile+ <> " but should contain \""+ <> unpack content+ <> "\".")+ (valInFile == content)++-- Run build in a clean directory+runClean :: FilePath -> Cached a -> IO ()+runClean dir x = do+ rmRec dir+ shakeGo dir $ toShakeRules x++-- Test function application.+testFunAp :: FilePath -> IO () -> (Text, Text) -> Property+testFunAp dir touch (expectedA, expectedFA) = once $ ioProperty $ do+ let a x = pure x+ & cache (dir </> "a") show readInt+ let f i a = pure (+ (10 * i)) <*> a+ & cache (dir </> "fa") show readInt++ -- Delete shake cache files+ rmRec dir++ -- Build "a" once+ shakeGo dir $ do+ toShakeRules $ f 1 (a 1)++ touch++ -- Build cache+ shakeGo dir $ do+ toShakeRules $ f 2 (a 2)++ -- Test the cache files+ testA <- testFile (dir </> "a") expectedA+ testFA <- testFile (dir </> "fa") expectedFA++ return $ testA .&&. testFA++++---- Tests ----++---- Single values depending on no other cached value++-- Check that when a value is computed and there is no cache file, it is created.+prop_SinValCreaCache :: Property+prop_SinValCreaCache = ioProperty $ do+ let a = val 1 "test-output/formulas/Util/Cached/SinValCreaCache/a"++ -- Make sure the directory state is clean+ rmRec "test-output/formulas/Util/Cached/SinValCreaCache"++ -- Build the cache+ shakeGo "test-output/formulas/Util/Cached/SinValCreaCache/" $ toShakeRules a++ -- Test if the file was written and contains the appropriate value+ testFile "test-output/formulas/Util/Cached/SinValCreaCache/a" "1"+ ++-- Check that a value is not recomputed when the cache file already exists+prop_SinValNoRecomp :: Property+prop_SinValNoRecomp = ioProperty $ do+ let a x = val x "test-output/formulas/Util/Cached/SinValNoRecomp/a"++ -- Make sure the file is not present+ rmRec "test-output/formulas/Util/Cached/SinValNoRecomp"++ -- Build the cache once.+ shakeGo "test-output/formulas/Util/Cached/SinValNoRecomp" $ toShakeRules (a 1)++ -- Rebuild, changing the value.+ shakeGo "test-output/formulas/Util/Cached/SinValNoRecomp" $ toShakeRules (a 2)++ -- Test if the file was written and contains the appropriate value+ testFile "test-output/formulas/Util/Cached/SinValNoRecomp/a" "1"+++-- Check that a value is recomputed when the cache file has changed.+prop_SinValRecomp :: Property+prop_SinValRecomp = ioProperty $ do+ let a x = val x "test-output/formulas/Util/Cached/SinValRecomp/a"++ -- Make sure the file is not present+ rmRec "test-output/formulas/Util/Cached/SinValRecomp"++ -- Build the cache once.+ shakeGo "test-output/formulas/Util/Cached/SinValRecomp" $ toShakeRules (a 1)++ -- Modify the cache file. (delay to make sure the file modification date is different)+ threadDelay 5000+ writeFile "test-output/formulas/Util/Cached/SinValRecomp/a" "2"++ -- Rebuild, changing the value.+ shakeGo "test-output/formulas/Util/Cached/SinValRecomp/" $ toShakeRules (a 3)++ -- Test if the file was written and contains the appropriate value+ testFile "test-output/formulas/Util/Cached/SinValRecomp/a" "3"+++---- Function application (cached values depending on another cached value)++-- State: A absent, FA absent+-- Check that when no cache file is present, the function application `pure f <*> a` creates a cache file for `a` and for the last value `f <$> a`.+prop_FunApAAbsentFAAbsent :: Property+prop_FunApAAbsentFAAbsent =+ testFunAp "test-output/formulas/Util/Cached/FunApAAbsentFAAbsent"+ (do+ rmFile "test-output/formulas/Util/Cached/FunApAAbsentFAAbsent/a"+ rmFile "test-output/formulas/Util/Cached/FunApAAbsentFAAbsent/fa")+ ("2", "22")++-- State: A unchanged, FA absent+-- Check that when the cache file for `a` only already exists, a is not recomputed and the cache file for `f <$> a` is created.+prop_FunApAUnchangedFAAbsent :: Property+prop_FunApAUnchangedFAAbsent =+ testFunAp "test-output/formulas/Util/Cached/FunApAUnchangedFAAbsent"+ (do+ rmFile "test-output/formulas/Util/Cached/FunApAUnchangedFAAbsent/fa")+ ("1", "21")++-- State: A modified, FA absent+-- Check that a is recomputed and FA is recomputed+prop_FunApAModifiedFAAbsent :: Property+prop_FunApAModifiedFAAbsent =+ testFunAp "test-output/formulas/Util/Cached/FunApAModifiedFAAbsent"+ (do+ threadDelay 5000+ writeFile "test-output/formulas/Util/Cached/FunApAModifiedFAAbsent/a" "3"+ rmFile "test-output/formulas/Util/Cached/FunApAModifiedFAAbsent/fa")+ ("2", "22")+++++-- State: A absent, FA unchanged+-- Check that "a" and "fa" are recomputed+prop_FunApAAbsentFAUnchanged :: Property+prop_FunApAAbsentFAUnchanged =+ testFunAp "test-output/formulas/Util/Cached/FunApAAbsentFAUnchanged"+ (do+ threadDelay 5000+ rmFile "test-output/formulas/Util/Cached/FunApAAbsentFAUnchanged/a")+ ("2", "22")++-- State: A unchanged, FA unchanged+-- Check that nothing is recomputed+prop_FunApAUnchangedFAUnchanged :: Property+prop_FunApAUnchangedFAUnchanged =+ testFunAp "test-output/formulas/Util/Cached/FunApAUnchangedFAUnchanged"+ (do+ return ())+ ("1", "11")++-- State: A modified, FA unchanged+-- Check that a is recomputed and FA is recomputed+prop_FunApAModifiedFAUnchanged :: Property+prop_FunApAModifiedFAUnchanged =+ testFunAp "test-output/formulas/Util/Cached/FunApAModifiedFAUnchanged"+ (do+ threadDelay 5000+ writeFile "test-output/formulas/Util/Cached/FunApAModifiedFAUnchanged/a" "3")+ ("2", "22")+++++-- State: A absent, FA modified+-- Check that both are recomputed+prop_FunApAAbsentFAModified :: Property+prop_FunApAAbsentFAModified =+ testFunAp "test-output/formulas/Util/Cached/FunApAAbsentFAModified"+ (do+ rmFile "test-output/formulas/Util/Cached/FunApAAbsentFAModified/a"+ threadDelay 5000+ writeFile "test-output/formulas/Util/Cached/FunApAAbsentFAModified/fa" "77")+ ("2", "22")++-- State: A unchanged, FA modified+-- Check that "fa" is recomputed but not "a" +prop_FunApAUnchangedFAModified :: Property+prop_FunApAUnchangedFAModified =+ testFunAp "test-output/formulas/Util/Cached/FunApAUnchangedFAModified"+ (do+ threadDelay 5000+ writeFile "test-output/formulas/Util/Cached/FunApAUnchangedFAModified/fa" "77")+ ("1", "21")++-- State: A modified, FA modified+-- Check that both are recomputed.+prop_FunApAModifiedFAModified :: Property+prop_FunApAModifiedFAModified =+ testFunAp "test-output/formulas/Util/Cached/FunApAModifiedFAModified"+ (do+ threadDelay 5000+ writeFile "test-output/formulas/Util/Cached/FunApAModifiedFAModified/a" "3"+ threadDelay 5000+ writeFile "test-output/formulas/Util/Cached/FunApAModifiedFAModified/fa" "77")+ ("2", "22")+++-- State: A absent, FA absent+-- Check with the Functor operator "f <$> a"+prop_FunApCompAllFunctor :: Property+prop_FunApCompAllFunctor = once $ ioProperty $ do+ let a = pure 1+ & cache "test-output/formulas/Util/Cached/FunApCompAllFunctor/a" show readInt+ let fa = pure (+ 1) <*> a+ & cache "test-output/formulas/Util/Cached/FunApCompAllFunctor/fa" show readInt++ -- Delete shake cache files+ rmRec "test-output/formulas/Util/Cached/FunApCompAllFunctor"++ -- Build cache+ shakeGo "test-output/formulas/Util/Cached/FunApCompAllFunctor/" $ do+ toShakeRules fa++ -- Test the cache files+ testA <- testFile "test-output/formulas/Util/Cached/FunApCompAllFunctor/a" "1"+ testFA <- testFile "test-output/formulas/Util/Cached/FunApCompAllFunctor/fa" "2"++ return $ testA .&&. testFA+++---- Monoid++-- The monoid is left-biased: when two different values are cached to the same+-- target, the first is kept.+prop_MonoidCacheTwice :: Property+prop_MonoidCacheTwice = ioProperty $ do+ let mon = cache "test-output/formulas/Util/Cached/Monoid/CacheTwice/a"+ (show . getSum) (fmap Sum . readInt) (pure (Sum 1))+ <> cache "test-output/formulas/Util/Cached/Monoid/CacheTwice/a"+ (show . getSum) (fmap Sum . readInt) (pure (Sum 2))+ runClean "test-output/formulas/Util/Cached/Monoid/CacheTwice" mon+ testFile "test-output/formulas/Util/Cached/Monoid/CacheTwice/a" "1"+++---- Applicative++-- The applicative is left-biased: Check that caching twice to the same file+-- only builds the first.+prop_ApplicativeCacheTwice :: Property+prop_ApplicativeCacheTwice = ioProperty $ do+ let ap = cache "test-output/formulas/Util/Cached/Applicative/CacheTwice/a"+ (\_ -> "1") (\_ -> Right (+ 1)) (pure (+ 1))+ <*> cache "test-output/formulas/Util/Cached/Applicative/CacheTwice/a"+ (\_ -> "2") (\_ -> Right 1) (pure 1)+ + runClean "test-output/formulas/Util/Cached/Applicative/CacheTwice" ap+ testFile "test-output/formulas/Util/Cached/Applicative/CacheTwice/a" "1"+++---- Interface functions examples++prop_source :: SimplePath -> Either Text Int -> Property+prop_source (SimplePath p) es =+ let dir="test-output/formulas/Util/Cached/Interface/source"+ path = dir </> p+ c = source path (bimap pack identity . readEither . unpack)+ -- to cover the case when es is (Left t) and t represents an Int+ es' = case es of+ Left t -> case readMaybe (unpack t) of+ Nothing -> es+ Just anInt -> Right anInt+ _ -> es+ in ioProperty $ do+ setDir dir [(path, case es of Right i -> show i; Left t -> t)]+ ev <- getValue c+ return $ counterexample (show (ev, es')) $ case (ev, es') of+ (Left errv, Left _ ) -> errv == "Error reading file " <> pack path <> ": Prelude.read: no parse"+ (Right v, Right s) -> v == s+ _ -> False++prop_source' :: SimplePath -> Either Text Int -> Property+prop_source' (SimplePath p) es =+ let dir="test-output/formulas/Util/Cached/Interface/source'"+ path = dir </> p+ in ioProperty $ do+ setDir dir [(path, case es of Right i -> show i; Left t -> t)]+ eqCached (source' path :: Cached Int)+ (source path (bimap pack identity . readEither . unpack) :: Cached Int)++prop_fromIO :: DirectoryTree -> InfiniteList Text -> Property+prop_fromIO dt (InfiniteList infTexts _) =+ let dir="test-output/formulas/Util/Cached/Interface/fromIO"+ paths = fmap (dir </>) (directoryTreePaths dt)+ texts = List.take (List.length paths) infTexts+ c = fromIO (Set.fromList paths) (foldMap readFile paths)+ in ioProperty $ do+ setDir dir (Protolude.zip paths texts)+ e <- getValue $ liftA2 (==) c (pure $ mconcat texts)+ return $ case e of+ Left _ -> False+ Right b -> b++prop_cache :: Property+prop_cache = once $+ let dir = "test-output/formulas/Util/Cached/Interface/cache"+ c1 = cache ( dir </> "c1" )+ show+ (bimap pack identity . readEither . unpack)+ ( pure 1 ) :: Cached Int+ c2 = cache ( dir </> "c2" ) + show+ (bimap pack identity . readEither . unpack)+ ( pure 2 ) :: Cached Int+ c3 = cache ( dir </> "c3" ) + show+ (bimap pack identity . readEither . unpack)+ ( c1 + c2 ) :: Cached Int+ in ioProperty $ do+ setDir dir []+ test1 <- testCached c1 (Right 1) (Set.singleton $ dir </> "c1")+ (Map.fromList [(dir </> "c1", (Right "1", mempty))])+ test2 <- testCached c3 (Right 3) (Set.singleton $ dir </> "c3")+ (Map.fromList [(dir </> "c3", (Right "3", Set.fromList [dir </> "c1"+ ,dir </> "c2"]))+ ,(dir </> "c2", (Right "2", mempty))+ ,(dir </> "c1", (Right "1", mempty))])+ return $ test1 .&&. test2++prop_cache' :: Property+prop_cache' = once $+ let dir = "test-output/formulas/Util/Cached/Interface/cache'"+ c1 = cache' ( dir </> "c1" ) ( pure 1 ) :: Cached Int+ c2 = cache' ( dir </> "c2" ) ( pure 2 ) :: Cached Int+ c3 = cache' ( dir </> "c3" ) ( c1 + c2 ) :: Cached Int+ in ioProperty $ do+ setDir dir []+ test1 <- testCached c1 (Right 1) (Set.singleton $ dir </> "c1")+ (Map.fromList [(dir </> "c1", (Right "1", mempty))])+ test2 <- testCached c3 (Right 3) (Set.singleton $ dir </> "c3")+ (Map.fromList [(dir </> "c3", (Right "3", Set.fromList [dir </> "c1"+ ,dir </> "c2"]))+ ,(dir </> "c2", (Right "2", mempty))+ ,(dir </> "c1", (Right "1", mempty))])+ return $ test1 .&&. test2+++prop_cacheIO :: Property+prop_cacheIO = once $+ let dir = "test-output/formulas/Util/Cached/Interface/cacheIO"+ c1 = cacheIO ( dir </> "c1" )+ ( writeFile (dir </> "c1") . show )+ ( bimap pack identity . readEither . unpack+ <$> readFile (dir </> "c1") )+ ( pure 1 ) :: Cached Int+ c2 = cacheIO ( dir </> "c2" )+ ( writeFile (dir </> "c2") . show )+ ( bimap pack identity . readEither . unpack+ <$> readFile (dir </> "c2") )+ ( pure 2 ) :: Cached Int+ c3 = cacheIO ( dir </> "c3" )+ ( writeFile (dir </> "c3") . show )+ ( bimap pack identity . readEither . unpack+ <$> readFile (dir </> "c3") )+ ( c1 + c2 ) :: Cached Int+ in ioProperty $ do+ setDir dir []+ test1 <- testCached c1 (Right 1) (Set.singleton $ dir </> "c1")+ (Map.fromList [(dir </> "c1", (Right "1", mempty))])+ test2 <- testCached c3 (Right 3) (Set.singleton $ dir </> "c3")+ (Map.fromList [(dir </> "c3", (Right "3", Set.fromList [dir </> "c1"+ ,dir </> "c2"]))+ ,(dir </> "c2", (Right "2", mempty))+ ,(dir </> "c1", (Right "1", mempty))])+ return $ test1 .&&. test2++prop_sink :: Property+prop_sink = once $+ let dir = "test-output/formulas/Util/Cached/Interface/sink"+ c1 = cache' ( dir </> "c1" ) ( pure 1 ) :: Cached Int+ c2 = cache' ( dir </> "c2" ) ( pure 2 ) :: Cached Int+ s1 = sink ( dir </> "s1" ) (Right . show) ( pure (1 :: Int) )+ s2 = sink ( dir </> "s2" ) (Right . show) ( c1 + c2 )+ in ioProperty $ do+ setDir dir []+ test1 <- testCached s1 (Right ()) mempty+ (Map.fromList [(dir </> "s1", (Right "1", mempty))])+ test2 <- testCached s2 (Right ()) mempty+ (Map.fromList [(dir </> "s2", (Right "3", Set.fromList [dir </> "c1"+ ,dir </> "c2"]))+ ,(dir </> "c2", (Right "2", mempty))+ ,(dir </> "c1", (Right "1", mempty))])+ return $ test1 .&&. test2++prop_sink' :: Property+prop_sink' = once $+ let dir = "test-output/formulas/Util/Cached/Interface/sink'"+ c1 = cache' ( dir </> "c1" ) ( pure 1 ) :: Cached Int+ c2 = cache' ( dir </> "c2" ) ( pure 2 ) :: Cached Int+ s1 = sink' ( dir </> "s1" ) (pure 1):: Cached ()+ s2 = sink' ( dir </> "s2" ) (c1 + c2) :: Cached ()+ in ioProperty $ do+ setDir dir []+ test1 <- testCached s1 (Right ()) mempty+ (Map.fromList [(dir </> "s1", (Right "1", mempty))])+ test2 <- testCached s2 (Right ()) mempty+ (Map.fromList [(dir </> "s2", (Right "3", Set.fromList [dir </> "c1"+ ,dir </> "c2"]))+ ,(dir </> "c2", (Right "2", mempty))+ ,(dir </> "c1", (Right "1", mempty))])+ return $ test1 .&&. test2++prop_sinkIO :: Property+prop_sinkIO = once $+ let dir = "test-output/formulas/Util/Cached/Interface/sinkIO"+ c1 = cache' ( dir </> "c1" ) ( pure 1 ) :: Cached Int+ c2 = cache' ( dir </> "c2" ) ( pure 2 ) :: Cached Int+ s1 = sinkIO ( dir </> "s1" )+ ( fmap Right . writeFile (dir </> "s1") . show )+ (pure 1):: Cached ()+ s2 = sinkIO ( dir </> "s2" )+ ( fmap Right . writeFile (dir </> "s2") . show )+ (c1 + c2) :: Cached ()+ in ioProperty $ do+ setDir dir []+ test1 <- testCached s1 (Right ()) mempty+ (Map.fromList [(dir </> "s1", (Right "1", mempty))])+ test2 <- testCached s2 (Right ()) mempty+ (Map.fromList [(dir </> "s2", (Right "3", Set.fromList [dir </> "c1"+ ,dir </> "c2"]))+ ,(dir </> "c2", (Right "2", mempty))+ ,(dir </> "c1", (Right "1", mempty))])+ return $ test1 .&&. test2++prop_trigger :: Property+prop_trigger = once $+ let dir = "test-output/formulas/Util/Cached/Interface/trigger"+ c = trigger ( dir </> "c" )+ ( Right <$> writeFile (dir </> "c") "1" )+ ( Set.fromList [dir </> "a"] )+ in ioProperty $ do+ setDir dir []+ testCached c (Right ()) mempty+ (Map.fromList [(dir </> "s1", (Right "1", (Set.fromList [dir </> "a"])))])++runTests = do+ checkOrExit "prop_SinValCreaCache" prop_SinValCreaCache+ checkOrExit "prop_SinValNoRecomp" prop_SinValNoRecomp+ checkOrExit "prop_SinValRecomp" prop_SinValRecomp+ checkOrExit "prop_FunApAAbsentFAAbsent" prop_FunApAAbsentFAAbsent+ checkOrExit "prop_FunApAAbsentFAUnchanged" prop_FunApAAbsentFAUnchanged+ checkOrExit "prop_FunApAAbsentFAModified" prop_FunApAAbsentFAModified+ checkOrExit "prop_FunApAUnchangedFAAbsent" prop_FunApAUnchangedFAAbsent+ checkOrExit "prop_FunApAUnchangedFAUnchanged" prop_FunApAUnchangedFAUnchanged+ checkOrExit "prop_FunApAUnchangedFAModified" prop_FunApAUnchangedFAModified+ checkOrExit "prop_FunApAModifiedFAAbsent" prop_FunApAModifiedFAAbsent+ checkOrExit "prop_FunApAModifiedFAUnchanged" prop_FunApAModifiedFAUnchanged+ checkOrExit "prop_FunApAModifiedFAModified" prop_FunApAModifiedFAModified+ checkOrExit "prop_FunApCompAllFunctor" prop_FunApCompAllFunctor+ checkOrExit "prop_MonoidCacheTwice" prop_MonoidCacheTwice+ checkOrExit "prop_ApplicativeCacheTwice" prop_ApplicativeCacheTwice+ checkOrExit "prop_source" prop_source+ checkOrExit "prop_source'" prop_source'+ checkOrExit "prop_fromIO" prop_fromIO+ checkOrExit "prop_cache" prop_cache+ checkOrExit "prop_cache'" prop_cache'+ checkOrExit "prop_cacheIO" prop_cacheIO+ checkOrExit "prop_sink" prop_sink+ checkOrExit "prop_sink'" prop_sink'+ checkOrExit "prop_sinkIO" prop_sinkIO+ checkOrExit "prop_trigger" prop_trigger+
+ test/Test/Util.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+++module Test.Util where++import Protolude+import qualified Data.List as List+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Text (unpack, pack)+import System.Directory+import System.FilePath+import Test.QuickCheck+import Test.QuickCheck.Assertions+import Test.QuickCheck.Test++import Data.Cached+import Data.Cached.Internal++checkOrExit :: (Testable prop) => Text -> prop -> IO ()+checkOrExit msg p = do+ success <- fmap isSuccess $ quickCheckResult+ $ label (unpack msg)+ $ counterexample ("Failing property: " ++ unpack msg)+ p+ when (not success) exitFailure++-- Make sure the given file does not exist, delete if necessary.+rmFile :: FilePath -> IO ()+rmFile f = do+ System.Directory.doesFileExist f+ >>= bool (return ()) (removeFile f)++-- Make sure the given directory does not exist, delete recursively if necessary.+rmRec:: FilePath -> IO ()+rmRec dir = removePathForcibly dir++-- Set a directory to contain only the given files and their content+setDir :: FilePath -> [(FilePath, Text)] -> IO ()+setDir rootDir content = do+ rmRec rootDir+ createDirectory rootDir+ foldMap (\(p, t) -> do+ createDirectoryIfMissing True (takeDirectory p)+ writeFile p t)+ content++-- Turn a cache into a value that can be inspected. This function+-- runs the IO actions that are contained in the cache (cachedValue+-- and Build), and expects that the IO actions only read and write files,+-- and that the IO actions in the build only writes to files that are+-- specified as targets (the Build keys).+materialize :: Cached a+ -> IO (Either Text a, Set FilePath,+ Map FilePath (Either Text Text, Set FilePath))+materialize a = do+ let needs = cacheNeeds a+ let runAndReadBack f ioe = ioe >>= \e -> readFile f >>= \r -> return (r <$ e)+ build <- Map.traverseWithKey+ (\k (ac, n) -> runAndReadBack k (runExceptT ac)+ >>= \r -> return (r,n))+ (getBuild $ cacheBuild a)+ val <- getValue a+ return (val, needs, build)++-- Test the value, needs, dependencies of a given cached value, and the content written to files.+testCached :: (Eq a, Show a)+ => Cached a+ -> Either Text a+ -> Set FilePath+ -> Map FilePath (Either Text Text, Set FilePath)+ -> IO Property+testCached c value needs build = do+ (val', needs', build') <- materialize c+ return $ value ==? val'+ .&&. needs ==? needs'+ .&&. build ==? build+++-- Test equality of two cached values: values, needs, and builds. Runs all IO actions in the cache.+eqCached :: (Eq a, Show a) => Cached a -> Cached a -> IO Property+eqCached a b = property <$> ((==?) <$> materialize a <*> materialize b)++newtype Seed = Seed Int deriving (Show)++instance Arbitrary Seed where+ arbitrary = Seed <$> choose (-100000, 100000)++newtype SimpleFileName = SimpleFileName {getSimpleFileName :: FilePath}+ deriving (Eq, Show, Ord)++instance Arbitrary SimpleFileName where+ arbitrary = scale (min 10)+ $ SimpleFileName+ <$> genStr `suchThat` (not . flip elem [".", ".."])+ where genStr :: Gen FilePath+ genStr = listOf1 $ elements+ $ (['a'..'z'] ++ ['A'..'Z'] ++ ['_', '-', '.'])++newtype SimplePath = SimplePath {getSimplePath :: FilePath}+ deriving (Show, Ord, Eq)++instance Arbitrary SimplePath where+ arbitrary = SimplePath . intercalate "/"+ <$> scale (min 10)+ (listOf1 $ fmap getSimpleFileName arbitrary )++newtype DirectoryTree = DT (Map SimpleFileName DirectoryTree)+ deriving (Eq, Show, Ord)++instance Arbitrary DirectoryTree where+ arbitrary = sized genDirectoryTree++genDirectoryTree :: Int -> Gen DirectoryTree+genDirectoryTree 0 = pure $ DT mempty+genDirectoryTree 1 = (\f -> DT $ Map.singleton f (DT mempty))+ <$> arbitrary+genDirectoryTree n = do+ nTop <- choose (1, n)+ splits <- List.sort <$> vectorOf (nTop - 1) (choose (0,n))+ let nChildren = fmap (\(a, b) -> b - a)+ (zip (0:splits) (splits ++ [n]))+ filenames <- vector nTop+ subTrees <- traverse genDirectoryTree nChildren+ return $ DT $ Map.fromList $ zip filenames subTrees++directoryTreePaths :: DirectoryTree -> [FilePath]+directoryTreePaths (DT m) = do+ (SimpleFileName f, DT d) <- Map.toList m+ if null d+ then [f]+ else fmap ((f <> "/") <>) (directoryTreePaths (DT d))++instance Arbitrary Text where+ arbitrary = pack <$> (arbitrary :: Gen [Char])++genCached :: [FilePath] -> Gen (Cached Int)+genCached [] = genCachedPure+genCached paths = sized $ \s ->+ if s == 0+ then genCachedPure+ else oneof+ [ genCachedPure+ , genCachedFile paths+ , genCachedFunctor paths+ , genCachedApplicative paths ]++-- | Generate a pure cached value that is not associated to a cache file+genCachedPure :: (Arbitrary a) => Gen (Cached a)+genCachedPure = fmap pure arbitrary++-- | Generate a cached value that is associated to a cache file+genCachedFile :: [FilePath] -> Gen (Cached Int)+genCachedFile (path:paths) = sized $ \s ->+ fmap (cache' path) (resize (s - 1) $ genCached paths)++-- | Generate a cached value that is the result of an fmap.+genCachedFunctor :: [FilePath] -> Gen (Cached Int)+genCachedFunctor paths = sized $ \s -> do+ f <- arbitrary+ c <- resize (s - 1) $ genCached paths+ return $ fmap f c+ +-- | Generate a cached value that is the result of combining two cached values+-- together with <*>.+genCachedApplicative :: [FilePath] -> Gen (Cached Int)+genCachedApplicative paths = sized $ \s -> do+ f <- arbitrary+ split <- choose (0, s - 1)+ c1 <- resize (split) $ genCached paths1+ c2 <- resize (s - 1 - split) $ genCached paths2+ return $ f <$> c1 <*> c2+ where (paths1, paths2) = splitRL paths ([],[])+ splitRL [] (p1, p2) = (p1, p2)+ splitRL (p:ps) (p1, p2) = splitRL ps (p:p2, p1)+