50 lines
1.6 KiB
Haskell
50 lines
1.6 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Blog.Skin (
|
|
Skin(..)
|
|
, build
|
|
) where
|
|
|
|
import Arguments (Arguments)
|
|
import qualified Arguments (bannerPath, favicon, cardImage, headPath, previewArticlesCount, previewLinesCount)
|
|
import Control.Monad (filterM)
|
|
import Data.Maybe (listToMaybe)
|
|
import Prelude hiding (head)
|
|
import System.Directory (doesFileExist)
|
|
import System.FilePath ((</>), (<.>))
|
|
|
|
data Skin = Skin {
|
|
banner :: Maybe String
|
|
, cardImage :: FilePath
|
|
, favicon :: Maybe FilePath
|
|
, head :: Maybe String
|
|
, previewArticlesCount :: Int
|
|
, previewLinesCount :: Int
|
|
}
|
|
|
|
findFavicon :: Arguments -> IO (Maybe FilePath)
|
|
findFavicon arguments =
|
|
case Arguments.favicon arguments of
|
|
Just path -> return . Just $ absolute path
|
|
_ -> fmap absolute . listToMaybe <$> filterM doesFileExist pathsToCheck
|
|
where
|
|
directories = [".", "image", "images", "pictures", "skin", "static"]
|
|
extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"]
|
|
pathsToCheck = [ dir </> "favicon" <.> ext | dir <- directories, ext <- extensions ]
|
|
absolute ('.':path) = path
|
|
absolute path = "/" </> path
|
|
|
|
build :: String -> Arguments -> IO Skin
|
|
build blogName arguments = do
|
|
let cardImage = maybe ("/image" </> blogName <.> "png") id $ Arguments.cardImage arguments
|
|
banner <- mapM readFile $ Arguments.bannerPath arguments
|
|
favicon <- findFavicon arguments
|
|
head <- mapM readFile $ Arguments.headPath arguments
|
|
return $ Skin {
|
|
banner
|
|
, cardImage
|
|
, favicon
|
|
, head
|
|
, previewArticlesCount = Arguments.previewArticlesCount arguments
|
|
, previewLinesCount = Arguments.previewLinesCount arguments
|
|
}
|