hablo/src/Blog/Skin.hs

66 lines
2.2 KiB
Haskell

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Blog.Skin (
Skin(..)
, build
, findImage
) where
import Arguments (Arguments)
import qualified Arguments (bannerPath, favicon, cardImage, headPath, previewArticlesCount, previewLinesCount)
import Blog.URL (checkURL, pathRelative)
import Control.Monad (filterM)
import Data.Aeson (ToJSON(..), (.=), object, pairs)
import Data.Maybe (listToMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Network.URL (URL)
import Prelude hiding (head)
import System.Directory (doesFileExist)
import System.FilePath ((</>), (<.>))
data Skin = Skin {
banner :: Maybe String
, cardImage :: Maybe URL
, favicon :: Maybe URL
, head :: Maybe String
, previewArticlesCount :: Int
, previewLinesCount :: Int
}
instance ToJSON Skin where
toJSON (Skin {previewArticlesCount, previewLinesCount}) = object [
("previewArticlesCount", toJSON previewArticlesCount)
, ("previewLinesCount", toJSON previewLinesCount)
]
toEncoding (Skin {previewArticlesCount, previewLinesCount}) = pairs (
"previewArticlesCount" .= previewArticlesCount
<> "previewLinesCount" .= previewLinesCount
)
findImage :: String -> Maybe FilePath -> IO (Maybe URL)
findImage _ (Just path) = Just <$> checkURL path
findImage name Nothing =
fmap pathRelative . 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
}