diff options
| -rw-r--r-- | Utils.hs | 42 | ||||
| -rw-r--r-- | reploy.cabal | 1 | ||||
| -rw-r--r-- | reploy.hs | 1 |
3 files changed, 41 insertions, 3 deletions
@@ -17,13 +17,19 @@ module Utils where +import Control.Monad (filterM, forM) import Control.Monad.IO.Class import Data.List.Extra (stripSuffix) import Data.Maybe (isJust) import qualified Data.Text as T +import System.Directory + ( createDirectoryIfMissing + , doesDirectoryExist + , getDirectoryContents + ) +import System.FilePath ((</>), takeDirectory) import Text.Pandoc.Definition import qualified Text.Pandoc.Walk - import Types -- | A shortcut for `liftIO`. @@ -72,11 +78,45 @@ addHeadingLinks cls = Text.Pandoc.Walk.walk go [Link ("", [cls], []) [Str "#"] ("#" <> id, "Link to this section")]) go x = x +-- | @"https://example.com" `hasUriScheme` "https"@ hasUriScheme :: String -> String -> Bool hasUriScheme x = all id . zipWith (==) x . (++ ":") +-- | @unAbsolute "/root/path" == "root/path"@ unAbsolute :: String -> String unAbsolute = dropWhile (== '/') +-- | Lift a function that processes `Block`s to a function that -- processes a +-- `Pandoc`. withPandocBlocks :: ([Block] -> [Block]) -> Pandoc -> Pandoc withPandocBlocks f (Pandoc meta blocks) = Pandoc meta (f blocks) + +-- | Get all contents of a directory. (Interned from Hakyll.) +getRecursiveContents :: + (FilePath -> IO Bool) -- ^ Ignore this file/directory + -> FilePath -- ^ Directory to search + -> IO [FilePath] -- ^ List of files found +getRecursiveContents ignore top = go "" + where + isProper x + | x `elem` [".", ".."] = return False + | otherwise = not <$> ignore x + go dir = do + dirExists <- doesDirectoryExist (top </> dir) + if not dirExists + then return [] + else do + names <- filterM isProper =<< getDirectoryContents (top </> dir) + paths <- + forM names $ \name -> do + let rel = dir </> name + isDirectory <- doesDirectoryExist (top </> rel) + if isDirectory + then go rel + else return [rel] + return $ concat paths + +-- | Given a path to a file, try to make the path writable by making all +-- directories on the path. (Interned from Hakyll.) +makeDirectories :: FilePath -> IO () +makeDirectories = createDirectoryIfMissing True . takeDirectory diff --git a/reploy.cabal b/reploy.cabal index 6f720d1..157a11a 100644 --- a/reploy.cabal +++ b/reploy.cabal @@ -19,7 +19,6 @@ executable reploy , directory , extra , filepath - , hakyll == 4.16.* , microlens , microlens-aeson , microlens-mtl @@ -38,7 +38,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding import qualified Data.Text.IO as TIO import qualified Data.Yaml as Y -import Hakyll.Core.Util.File (getRecursiveContents, makeDirectories) import Lens.Micro import Lens.Micro.Aeson import Lens.Micro.Mtl |