Make cardImage optional and detect it just like favicons
This commit is contained in:
parent
bcdcfb4ff7
commit
602e345977
2 changed files with 15 additions and 12 deletions
|
@ -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
|
||||
|
|
|
@ -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"]
|
||||
|
|
Loading…
Reference in a new issue