diff --git a/src/Blog/Skin.hs b/src/Blog/Skin.hs index 3f7fcf4..fff5449 100644 --- a/src/Blog/Skin.hs +++ b/src/Blog/Skin.hs @@ -14,30 +14,31 @@ import System.FilePath ((), (<.>)) data Skin = Skin { banner :: Maybe String - , cardImage :: FilePath + , cardImage :: Maybe FilePath , favicon :: Maybe FilePath , head :: Maybe String , previewArticlesCount :: Int , previewLinesCount :: Int } -findFavicon :: Arguments -> IO (Maybe FilePath) -findFavicon arguments = - case Arguments.favicon arguments of - Just path -> return . Just $ absolute path - _ -> fmap absolute . listToMaybe <$> filterM doesFileExist pathsToCheck +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 "favicon" <.> ext | dir <- directories, ext <- extensions ] - absolute ('.':path) = path - absolute path = "/" path + pathsToCheck = [ dir name <.> ext | dir <- directories, ext <- extensions ] build :: String -> Arguments -> IO Skin build blogName arguments = do - let cardImage = maybe ("/image" blogName <.> "png") id $ Arguments.cardImage arguments banner <- mapM readFile $ Arguments.bannerPath arguments - favicon <- findFavicon arguments + cardImage <- findImage blogName $ Arguments.cardImage arguments + favicon <- findImage "favicon" $ Arguments.favicon arguments head <- mapM readFile $ Arguments.headPath arguments return $ Skin { banner diff --git a/src/Dom.hs b/src/Dom.hs index 5e9ce04..6967972 100644 --- a/src/Dom.hs +++ b/src/Dom.hs @@ -9,6 +9,7 @@ import qualified Article (preview) import ArticlesList (ArticlesList(..), otherUrl, pageTitle) import Blog (Blog(..), Path(..), Skin(..), Wording(..)) import qualified Blog (get) +import Control.Applicative ((<|>)) import Control.Monad.Reader (ReaderT) import qualified Data.Map as Map (keys, lookup) import Data.Monoid ((<>)) @@ -68,10 +69,11 @@ makeCard :: String -> Text -> Maybe String -> HtmlGenerator () makeCard title description image = do og "title" $ pack title og "description" description - og "image" =<< pack <$> maybe (Blog.get $skin.$cardImage) return image + maybeImage =<< ((image <|>) <$> (Blog.get $skin.$cardImage)) og "site_name" =<< (Blog.get $name.$pack) where og attribute value = meta_ [makeAttribute "property" $ "og:" <> attribute , content_ value] + maybeImage = maybe (return ()) (og "image" . pack) navigationA :: Term arg result => arg -> result navigationA = "a" `termWith` [class_ "navigation"]