{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE FlexibleContexts #-} module Blog ( Blog(..) , Skin(..) , build , get ) where import Arguments (Arguments(sourceDir)) import qualified Arguments (name) import Article (Article) import qualified Article (at) import Blog.Skin (Skin(..)) import qualified Blog.Skin as Skin (build) import Control.Monad ((>=>), filterM, forM) import Control.Monad.Reader (MonadReader, ask) import Data.Map (Map) import qualified Data.Map as Map (fromList, member) import Data.Set (Set) import qualified Data.Set as Set (empty, null, singleton, union) import qualified Files (find) import System.Directory (doesFileExist, withCurrentDirectory) import System.FilePath ((), dropTrailingPathSeparator, splitFileName, takeExtension, takeFileName) import System.Posix.Types (FileID) import System.Posix.Files (getFileStatus, fileID) type Collection = Map FileID Article data Blog = Blog { articles :: Collection , name :: String , root :: FilePath , skin :: Skin , tags :: Map String (Set FileID) } get :: MonadReader Blog m => (Blog -> a) -> m a get = (<$> ask) findArticles :: Int -> FilePath -> IO (Map FileID Article) findArticles linesCount = Files.find >=> filterM isMarkDownFile >=> mapM (Article.at linesCount) >=> return . Map.fromList where isMarkDownFile path = do let correctExtension = takeExtension path == ".md" (correctExtension &&) <$> doesFileExist path tagged :: Collection -> FilePath -> IO (String, Set FileID) tagged collection path = do links <- Files.find path fileIDs <- forM links $ \link -> do fileExists <- doesFileExist link if fileExists then do inode <- fileID <$> getFileStatus link return $ if Map.member inode collection then Set.singleton inode else Set.empty else return Set.empty return (takeFileName path, foldl Set.union Set.empty fileIDs) build :: Arguments -> IO Blog build arguments = withCurrentDirectory root $ do let name = maybe (takeFileName $ dropTrailingPathSeparator root) id $ Arguments.name arguments skin <- Skin.build name arguments articles <- findArticles (previewLinesCount skin) articlesPath tags <- Map.fromList . filter (not . Set.null . snd) <$> (Files.find (articlesPath "tags") >>= mapM (articles `tagged`)) return $ Blog { articles , name , root , skin , tags } where (root, articlesPath) = splitFileName $ sourceDir arguments