hablo/src/Blog/Skin.hs

62 lines
2.0 KiB
Haskell

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Blog.Skin (
Skin(..)
, build
) where
import Arguments (Arguments)
import qualified Arguments (bannerPath, favicon, cardImage, headPath, previewArticlesCount, previewLinesCount)
import Control.Monad (filterM)
import Data.Aeson (ToJSON(..), (.=), pairs)
import Data.Maybe (listToMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Files (absoluteLink)
import GHC.Generics (Generic)
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
} deriving Generic
instance ToJSON Skin where
toEncoding (Skin {previewArticlesCount, previewLinesCount}) = pairs (
"previewArticlesCount" .= previewArticlesCount
<> "previewLinesCount" .= previewLinesCount
)
findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
findImage _ (Just path) = return . Just $ absoluteLink path
findImage name Nothing =
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
}