Tissevert
/
hablo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changing directory to keep paths relative and generate urls more easily

This commit is contained in:
Tissevert 2019-02-01 13:46:55 +01:00
parent cf2876abb9
commit 375ea0f7b0
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Blog.hs
View File

@ -9,16 +9,17 @@ import Arguments (Arguments(..))
import Control.Monad ((>=>), filterM, forM) import Control.Monad ((>=>), filterM, forM)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Data.Map (Map) import Data.Map (Map)
import Data.Text (Text, pack)
import qualified Data.Map as Map (fromList, member) import qualified Data.Map as Map (fromList, member)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set (empty, null, singleton, union) import qualified Data.Set as Set (empty, null, singleton, union)
import System.Directory (doesFileExist, listDirectory) import System.Directory (doesFileExist, listDirectory, withCurrentDirectory)
import System.FilePath.Posix ((</>), takeExtension, takeDirectory, takeFileName) import System.FilePath ((</>), dropTrailingPathSeparator, splitFileName, takeExtension, takeFileName)
import System.Posix.Types (FileID) import System.Posix.Types (FileID)
import System.Posix.Files (FileStatus, getFileStatus, fileID) import System.Posix.Files (FileStatus, getFileStatus, fileID)
data Article = Article { data Article = Article {
filePath :: FilePath urlPath :: Text
, fileStatus :: FileStatus , fileStatus :: FileStatus
} }
@ -41,7 +42,7 @@ find path =
article :: MonadIO m => FilePath -> m (FileID, Article) article :: MonadIO m => FilePath -> m (FileID, Article)
article filePath = do article filePath = do
fileStatus <- liftIO $ getFileStatus filePath fileStatus <- liftIO $ getFileStatus filePath
return (fileID fileStatus, Article { filePath, fileStatus }) return (fileID fileStatus, Article { urlPath = pack $ "/" </> filePath, fileStatus })
findArticles :: MonadIO m => FilePath -> m (Map FileID Article) findArticles :: MonadIO m => FilePath -> m (Map FileID Article)
findArticles = findArticles =
@ -64,10 +65,11 @@ tagged collection path = do
return (takeFileName path, foldl Set.union Set.empty fileIDs) return (takeFileName path, foldl Set.union Set.empty fileIDs)
get :: Arguments -> IO Blog get :: Arguments -> IO Blog
get (Arguments {sourceDir, blogName, previewCountArg}) = do get (Arguments {sourceDir, blogName, previewCountArg}) = withCurrentDirectory root $ do
let root = takeDirectory sourceDir let name = maybe (takeFileName $ dropTrailingPathSeparator root) id $ blogName
let name = maybe (takeFileName root) id $ blogName articles <- findArticles articlesPath
articles <- findArticles sourceDir
tags <- Map.fromList . filter (not . Set.null . snd) tags <- Map.fromList . filter (not . Set.null . snd)
<$> (find (sourceDir </> "tags") >>= mapM (articles `tagged`)) <$> (find (articlesPath </> "tags") >>= mapM (articles `tagged`))
return $ Blog { articles , name, previewCount = previewCountArg, root, tags } return $ Blog { articles , name, previewCount = previewCountArg, root, tags }
where
(root, articlesPath) = splitFileName sourceDir