parent
9834ea90dd
commit
e930e2e35d
42
Utils.hs
42
Utils.hs
|
@ -17,13 +17,19 @@
|
||||||
|
|
||||||
module Utils where
|
module Utils where
|
||||||
|
|
||||||
|
import Control.Monad (filterM, forM)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Data.List.Extra (stripSuffix)
|
import Data.List.Extra (stripSuffix)
|
||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import System.Directory
|
||||||
|
( createDirectoryIfMissing
|
||||||
|
, doesDirectoryExist
|
||||||
|
, getDirectoryContents
|
||||||
|
)
|
||||||
|
import System.FilePath ((</>), takeDirectory)
|
||||||
import Text.Pandoc.Definition
|
import Text.Pandoc.Definition
|
||||||
import qualified Text.Pandoc.Walk
|
import qualified Text.Pandoc.Walk
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
-- | A shortcut for `liftIO`.
|
-- | A shortcut for `liftIO`.
|
||||||
|
@ -72,11 +78,45 @@ addHeadingLinks cls = Text.Pandoc.Walk.walk go
|
||||||
[Link ("", [cls], []) [Str "#"] ("#" <> id, "Link to this section")])
|
[Link ("", [cls], []) [Str "#"] ("#" <> id, "Link to this section")])
|
||||||
go x = x
|
go x = x
|
||||||
|
|
||||||
|
-- | @"https://example.com" `hasUriScheme` "https"@
|
||||||
hasUriScheme :: String -> String -> Bool
|
hasUriScheme :: String -> String -> Bool
|
||||||
hasUriScheme x = all id . zipWith (==) x . (++ ":")
|
hasUriScheme x = all id . zipWith (==) x . (++ ":")
|
||||||
|
|
||||||
|
-- | @unAbsolute "/root/path" == "root/path"@
|
||||||
unAbsolute :: String -> String
|
unAbsolute :: String -> String
|
||||||
unAbsolute = dropWhile (== '/')
|
unAbsolute = dropWhile (== '/')
|
||||||
|
|
||||||
|
-- | Lift a function that processes `Block`s to a function that -- processes a
|
||||||
|
-- `Pandoc`.
|
||||||
withPandocBlocks :: ([Block] -> [Block]) -> Pandoc -> Pandoc
|
withPandocBlocks :: ([Block] -> [Block]) -> Pandoc -> Pandoc
|
||||||
withPandocBlocks f (Pandoc meta blocks) = Pandoc meta (f blocks)
|
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
|
||||||
|
|
|
@ -19,7 +19,6 @@ executable reploy
|
||||||
, directory
|
, directory
|
||||||
, extra
|
, extra
|
||||||
, filepath
|
, filepath
|
||||||
, hakyll == 4.16.*
|
|
||||||
, microlens
|
, microlens
|
||||||
, microlens-aeson
|
, microlens-aeson
|
||||||
, microlens-mtl
|
, microlens-mtl
|
||||||
|
|
|
@ -38,7 +38,6 @@ import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding
|
import qualified Data.Text.Encoding
|
||||||
import qualified Data.Text.IO as TIO
|
import qualified Data.Text.IO as TIO
|
||||||
import qualified Data.Yaml as Y
|
import qualified Data.Yaml as Y
|
||||||
import Hakyll.Core.Util.File (getRecursiveContents, makeDirectories)
|
|
||||||
import Lens.Micro
|
import Lens.Micro
|
||||||
import Lens.Micro.Aeson
|
import Lens.Micro.Aeson
|
||||||
import Lens.Micro.Mtl
|
import Lens.Micro.Mtl
|
||||||
|
|
Loading…
Reference in a new issue