diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for shake-plus-extended + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2020 Daniel Firth + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,60 @@ +# Shake+ Extended - Experimental Mechanisms For Shake + +This library extends +[shake-plus](https://hackage.haskell.org/package/shake-plus), which enriches +[shake](https://hackage.haskell.org/package/shake) with `ReaderT` and the +`Path` library. This extended ruleset introduces +[within](https://hackage.haskell.org/package/within), for better keeping track of +source and output directories, as well as batch loading mechanisms. + +## Using Within + +One common complaint about Shake is having to keep track of source and output +directories and translating `FilePath`s when using the input to an `Action`, +leading to lots of repetition of the form `(sourceFolder ) . (-<.> ".ext") . +dropDirectory1` which is prone to breakage. Using `Path` helps this to some +degree, but in some cases is even more annoying because lots of `Path` +functions use `MonadThrow`, leading to lots of monadic steps inside an +`RAction`. + +To alleviate this somewhat, we use `Within b (Path Rel File)` as a standard +pattern for representing a file within a directory. `Within` is a type +available in the [within](https://hackage.haskell.org/package/within) package +that is simply a newtype wrapper over an `Env` comonad with the environment +specialized to `Path b Dir`. We provide variants of the file operations and +rules that typically accept or return `Path`s or contain callbacks that expect +paths and change these to `Within` values. These functions are generally +suffixed `within`. Here is the variant of `getDirectoryFiles` that +produces `Within` values. + +```{.haskell} +getDirectoryFilesWithin' :: MonadAction m => Within Rel [FilePattern] -> m [Within b (Path Rel File)] +``` + +You can convert to and from this within-style using `within` and `fromWithin`. + +```{.haskell} +let x = $(mkRelFile "a.txt") `within` $(mkRelDir "foo") -- Within Rel (Path Rel File) +fromWithin x -- produces a `Path Rel File` +``` + +and you can assert that an existing path lies in a directory by using `asWithin`, which throws +if the directory is not a proper prefix of the `Path`. + +```{.haskell} +$(mkRelFile "foo/a.txt") `asWithin` $(mkRelDir "foo") -- fine +$(mkRelFile "a.txt") `asWithin` $(mkRelDir "foo") -- throws error +``` + +Filerules such as `(%>)` have within-style variants that accept an ` (Path b +Dir) FilePattern` on the left and carry that env to the callback. + +```{.haskell} +(%^>) :: (Partial, MonadReader r m, MonadRules m) => Within Rel FilePattern -> (Within Rel (Path Rel File) -> RAction r ()) -> m () +``` + +You change the underlying filepath with `fmap` or `mapM`, whilst you can move +to a new parent directory by using `localDir`, or `localDirM` which is defined +in the `Within` library for when the map between parent directories may throw. +The `Within` library also contains more functions and instances for more +precise changes between output and source directories. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/shake-plus-extended.cabal b/shake-plus-extended.cabal new file mode 100644 --- /dev/null +++ b/shake-plus-extended.cabal @@ -0,0 +1,47 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.2. +-- +-- see: https://github.com/sol/hpack + +name: shake-plus-extended +version: 0.1.0.0 +synopsis: Experimental extensions to shake-plus +description: Experimental extensions to shake-plus - `within`-style file rules, HashMap and IxSet batch loaders. +category: development, shake +author: Daniel Firth +maintainer: dan.firth@homotopic.tech +copyright: 2020 Daniel Firth +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://gitlab.com/shake-plus/shake-plus-extended + +library + exposed-modules: + Development.Shake.Plus.Extended + Development.Shake.Plus.Extended.FileRules + Development.Shake.Plus.Extended.Loaders + Development.Shake.Plus.Extended.Simple + other-modules: + Paths_shake_plus_extended + hs-source-dirs: + src + default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns + build-depends: + base >=4.7 && <5 + , comonad + , extra + , ixset-typed + , path + , rio + , shake + , shake-plus >=0.3.0.0 + , within + default-language: Haskell2010 diff --git a/src/Development/Shake/Plus/Extended.hs b/src/Development/Shake/Plus/Extended.hs new file mode 100644 --- /dev/null +++ b/src/Development/Shake/Plus/Extended.hs @@ -0,0 +1,19 @@ +{- | + Module : Development.Shake.Plus.Extended + Copyright : Copyright (C) 2020 Daniel Firth + Maintainer : Daniel Firth + License : MIT + Stability : experimental + +Module exports for Development.Shake.Plus.Extended. +-} + +module Development.Shake.Plus.Extended ( + module Development.Shake.Plus.Extended.FileRules +, module Development.Shake.Plus.Extended.Loaders +, module Development.Shake.Plus.Extended.Simple +) where + +import Development.Shake.Plus.Extended.FileRules +import Development.Shake.Plus.Extended.Loaders +import Development.Shake.Plus.Extended.Simple diff --git a/src/Development/Shake/Plus/Extended/FileRules.hs b/src/Development/Shake/Plus/Extended/FileRules.hs new file mode 100644 --- /dev/null +++ b/src/Development/Shake/Plus/Extended/FileRules.hs @@ -0,0 +1,27 @@ +{- | + Module : Development.Shake.Plus.Extended.FileRules + Copyright : Copyright (C) 2020 Daniel Firth + Maintainer : Daniel Firth ) +, (|%^>) +) where + +import Control.Comonad.Env as E +import Control.Exception.Extra +import Development.Shake.FilePath +import Development.Shake.Plus +import RIO as R +import Within + +-- | `Within` variant of `(%>)`, used to keep track of local directories. +(%^>) :: (Partial, MonadReader r m, MonadRules m) => Within Rel FilePattern -> (Within Rel (Path Rel File) -> RAction r ()) -> m () +(%^>) xs ract = liftA2 (Development.Shake.FilePath.) (toFilePath . E.ask) extract xs %> (ract <=< (`asWithin` E.ask xs)) + +-- | `Within` variant of `(%>)`, used to keep track of local directories. +(|%^>) :: (Partial, MonadReader r m, MonadRules m) => Within Rel [FilePattern] -> (Within Rel (Path Rel File) -> RAction r ()) -> m () +(|%^>) xs ract = ((Development.Shake.FilePath.) (toFilePath . E.ask $ xs) <$> extract xs) |%> (ract <=< (`asWithin` E.ask xs)) diff --git a/src/Development/Shake/Plus/Extended/Loaders.hs b/src/Development/Shake/Plus/Extended/Loaders.hs new file mode 100644 --- /dev/null +++ b/src/Development/Shake/Plus/Extended/Loaders.hs @@ -0,0 +1,67 @@ +{- | + Module : Development.Shake.Plus.Extended.Loaders + Copyright : Copyright (C) 2020 Daniel Firth + Maintainer : Daniel Firth (a -> f b) -> a -> f (a, b) +traverseToSnd f a = (a,) <$> f a + +-- | Load a directory of `FilePattern`s via some loading function. This should +-- be a `Development.Shake.newCache` operation that takes full filepaths. +batchLoad :: MonadAction m + => Path b Dir -- ^ The directory to search in + -> [FilePattern] -- ^ A filepattern to match against. + -> (Path b File -> m a) -- ^ A `Development.Shake.Plus.newCache` operation that loads the file and turns it into some `a`. + -> m (HashMap (Path Rel File) a) +batchLoad dir pat f = do + xs <- getDirectoryFiles dir pat + xs' <- mapM (traverseToSnd $ f . (dir )) xs + return . HM.fromList $ xs' + +-- | Like `batchLoad`, but returns an `Within` of a `Dir` containing the `HashMap` +batchLoadWithin :: MonadAction m + => Within b [FilePattern] -- ^ The directory and filepattern to search. + -> (Within b (Path Rel File) -> m a) -- ^ A `Development.Shake.Plus.newCache` operation that loads the file and turns it into some `a`. + -> m (Within b (HashMap (Path Rel File) a)) +batchLoadWithin w f = do + xs <- getDirectoryFiles (E.ask w) (extract w) + xs' <- mapM (traverseToSnd $ f . (`within` E.ask w)) xs + return $ (`within` E.ask w) $ HM.fromList xs' + +-- | Like `batchLoadWithin'`, but returns a `HashMap` containing `Within` values instead of an `Within` of a `Hashmap`. +batchLoadWithin' :: MonadAction m + => Within b [FilePattern] -- ^ The directory and filepattern to search. + -> (Within b (Path Rel File) -> m a) -- ^ A `Development.Shake.Plus.newCache` operation that loads the file and turns it into some `a`. + -> m (HashMap (Within b (Path Rel File)) a) +batchLoadWithin' w f = do + xs <- getDirectoryFiles (E.ask w) (extract w) + xs' <- mapM (traverseToSnd $ f . (`within` E.ask w)) xs + return $ HM.fromList (first (`within` E.ask w) <$> xs') + +-- | Take a loading function and a filepattern and return an IxSet +batchLoadIndex :: (MonadAction m, Ix.Indexable ixs x) + => (Path Rel File -> m x) + -> Path Rel Dir + -> [FilePattern] + -> m (Ix.IxSet ixs x) +batchLoadIndex rd dir fp = Ix.fromList . HM.elems <$> batchLoad dir fp rd diff --git a/src/Development/Shake/Plus/Extended/Simple.hs b/src/Development/Shake/Plus/Extended/Simple.hs new file mode 100644 --- /dev/null +++ b/src/Development/Shake/Plus/Extended/Simple.hs @@ -0,0 +1,24 @@ +{- | + Module : Development.Shake.Plus.Extended.Simple + Copyright : Copyright (C) 2020 Daniel Firth + Maintainer : Daniel Firth + License : MIT + Stability : experimental + +Shortcuts to run shake-plus with a simple environment. +-} +module Development.Shake.Plus.Extended.Simple ( + runSimpleShakePlus +) where + +import Control.Exception +import Development.Shake.Plus +import RIO + +-- | Run a `ShakePlus` with just a `LogFunc` in the environment that logs to stderr. +runSimpleShakePlus :: MonadIO m => ShakePlus LogFunc a -> m () +runSimpleShakePlus m = do + lo <- logOptionsHandle stderr True + (lf, dlf) <- newLogFunc (setLogMinLevel LevelInfo lo) + liftIO $ shakeArgs shakeOptions $ void $ runShakePlus lf m + dlf