aboutsummaryrefslogtreecommitdiff
path: root/Utils.hs
diff options
context:
space:
mode:
authorMirek Kratochvil <exa.exa@gmail.com>2023-07-21 21:03:53 +0200
committerMirek Kratochvil <exa.exa@gmail.com>2023-07-21 21:03:53 +0200
commite930e2e35da899a9ebdaddccb00ca0dfb22ea79e (patch)
treed255939f479a04efc0620eb2b0dfdfd077d13942 /Utils.hs
parent9834ea90dd3bd9587f97235dda3c96e11444df94 (diff)
downloadreploy-e930e2e35da899a9ebdaddccb00ca0dfb22ea79e.tar.gz
reploy-e930e2e35da899a9ebdaddccb00ca0dfb22ea79e.tar.bz2
remove hakyll from deps
Closes #12
Diffstat (limited to 'Utils.hs')
-rw-r--r--Utils.hs42
1 files changed, 41 insertions, 1 deletions
diff --git a/Utils.hs b/Utils.hs
index cb21de1..4426b68 100644
--- a/Utils.hs
+++ b/Utils.hs
@@ -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