hablo/src/Blog/Skin.hs

{-# 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 Files (absoluteLink)
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
  }

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
    }