Changing directory to keep paths relative and generate urls more easily
This commit is contained in:
parent
cf2876abb9
commit
375ea0f7b0
1 changed files with 11 additions and 9 deletions
20
src/Blog.hs
20
src/Blog.hs
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue