{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Zenacy.HTML.Internal.Image
( HTMLSrcset(..)
, HTMLSrcsetCandidate(..)
, HTMLSrcsetDescriptor(..)
, htmlSrcsetParse
, htmlSrcsetParseCandidate
, htmlSrcsetParseDescriptor
, htmlSrcsetRender
, htmlSrcsetRenderCandidate
, htmlSrcsetRenderDescriptor
, htmlSrcsetListURL
, htmlSrcsetMapURL
, htmlSrcsetImageMin
, htmlSrcsetImageMax
, htmlSrcsetDescriptorSize
, htmlSrcsetCandidatePair
, htmlSrcsetFilter
) where
import Zenacy.HTML.Internal.Core
import Control.Applicative
( (<|>)
)
import qualified Data.IntMap as IntMap
( findMax
, findMin
, fromList
)
import Data.Maybe
( catMaybes
, fromJust
)
import Data.Monoid
( (<>)
)
import Data.Text
( Text
)
import qualified Data.Text as T
( empty
, intercalate
, null
, pack
, splitOn
, stripSuffix
, words
, unwords
)
data HTMLSrcset = HTMLSrcset
{ htmlSrcsetCandidates :: ![HTMLSrcsetCandidate]
} deriving (Show, Eq, Ord)
data HTMLSrcsetCandidate = HTMLSrcsetCandidate
{ htmlSrcsetURL :: !Text
, htmlSrcsetDescriptor :: !HTMLSrcsetDescriptor
} deriving (Show, Eq, Ord)
data HTMLSrcsetDescriptor
= HTMLSrcsetWidth Int
| HTMLSrcsetPixel Int
| HTMLSrcsetNone
deriving (Show, Eq, Ord)
htmlSrcsetParse :: Text -> HTMLSrcset
htmlSrcsetParse =
( HTMLSrcset
. catMaybes
. map htmlSrcsetParseCandidate
. T.splitOn ","
)
htmlSrcsetParseCandidate :: Text -> Maybe HTMLSrcsetCandidate
htmlSrcsetParseCandidate x =
case T.words x of
(u:d:[]) -> Just $ HTMLSrcsetCandidate u $ htmlSrcsetParseDescriptor d
(u:[]) -> Just $ HTMLSrcsetCandidate u HTMLSrcsetNone
_otherwise -> Nothing
htmlSrcsetParseDescriptor :: Text -> HTMLSrcsetDescriptor
htmlSrcsetParseDescriptor x = fromJust $
(HTMLSrcsetWidth <$> f "w")
<|> (HTMLSrcsetPixel <$> f "x")
<|> (Just HTMLSrcsetNone)
where
f s = T.stripSuffix s x >>= textReadDec
htmlSrcsetRender :: HTMLSrcset -> Text
htmlSrcsetRender =
( T.intercalate ","
. map htmlSrcsetRenderCandidate
. htmlSrcsetCandidates
)
htmlSrcsetRenderCandidate :: HTMLSrcsetCandidate -> Text
htmlSrcsetRenderCandidate (HTMLSrcsetCandidate u d) =
T.unwords . filter (not . T.null) $ [ u, htmlSrcsetRenderDescriptor d ]
htmlSrcsetRenderDescriptor :: HTMLSrcsetDescriptor -> Text
htmlSrcsetRenderDescriptor = \case
HTMLSrcsetWidth x -> T.pack $ show x <> "w"
HTMLSrcsetPixel x -> T.pack $ show x <> "x"
HTMLSrcsetNone -> T.empty
htmlSrcsetListURL :: HTMLSrcset -> [Text]
htmlSrcsetListURL (HTMLSrcset c) =
filter (not . T.null) $ map htmlSrcsetURL c
htmlSrcsetMapURL :: (Text -> Text) -> HTMLSrcset -> HTMLSrcset
htmlSrcsetMapURL f (HTMLSrcset c) = HTMLSrcset $ map g c
where
g (HTMLSrcsetCandidate u d) = HTMLSrcsetCandidate (f u) d
htmlSrcsetImageMin :: HTMLSrcset -> Text
htmlSrcsetImageMin (HTMLSrcset c) =
( snd
. IntMap.findMin
. IntMap.fromList
. map htmlSrcsetCandidatePair
) c
htmlSrcsetImageMax :: HTMLSrcset -> Text
htmlSrcsetImageMax (HTMLSrcset c) =
( snd
. IntMap.findMax
. IntMap.fromList
. map htmlSrcsetCandidatePair
) c
htmlSrcsetDescriptorSize :: HTMLSrcsetDescriptor -> Int
htmlSrcsetDescriptorSize = \case
HTMLSrcsetWidth x -> x
HTMLSrcsetPixel x -> x
HTMLSrcsetNone -> 1
htmlSrcsetCandidatePair :: HTMLSrcsetCandidate -> (Int, Text)
htmlSrcsetCandidatePair (HTMLSrcsetCandidate u d) =
(htmlSrcsetDescriptorSize d, u)
htmlSrcsetFilter :: (HTMLSrcsetCandidate -> Bool) -> HTMLSrcset -> HTMLSrcset
htmlSrcsetFilter f (HTMLSrcset c) = HTMLSrcset $ filter f c