{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} 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) import Data.Monoid ((<>)) 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 = fmap absoluteLink . 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 }