51 lines
1.6 KiB
Haskell
51 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 :: Maybe FilePath
|
|
, favicon :: Maybe FilePath
|
|
, head :: Maybe String
|
|
, previewArticlesCount :: Int
|
|
, previewLinesCount :: Int
|
|
}
|
|
|
|
absolute :: FilePath -> FilePath
|
|
absolute ('.':path) = path
|
|
absolute path = "/" </> path
|
|
|
|
findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
|
|
findImage _ (Just path) = return . Just $ absolute path
|
|
findImage name Nothing =
|
|
fmap absolute . listToMaybe <$> filterM doesFileExist pathsToCheck
|
|
where
|
|
directories = [".", "image", "images", "pictures", "skin", "static"]
|
|
extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"]
|
|
pathsToCheck = [ dir </> name <.> ext | dir <- directories, ext <- extensions ]
|
|
|
|
build :: String -> Arguments -> IO Skin
|
|
build blogName arguments = do
|
|
banner <- mapM readFile $ Arguments.bannerPath arguments
|
|
cardImage <- findImage blogName $ Arguments.cardImage arguments
|
|
favicon <- findImage "favicon" $ Arguments.favicon arguments
|
|
head <- mapM readFile $ Arguments.headPath arguments
|
|
return $ Skin {
|
|
banner
|
|
, cardImage
|
|
, favicon
|
|
, head
|
|
, previewArticlesCount = Arguments.previewArticlesCount arguments
|
|
, previewLinesCount = Arguments.previewLinesCount arguments
|
|
}
|