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