Changing directory to keep paths relative and generate urls more easily

src/Blog.hs

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