{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Defines html image handling functions.
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
  )

-- | Defines a srcset attribute value.
data HTMLSrcset = HTMLSrcset
  { HTMLSrcset -> [HTMLSrcsetCandidate]
htmlSrcsetCandidates :: ![HTMLSrcsetCandidate]
  } deriving (Int -> HTMLSrcset -> ShowS
[HTMLSrcset] -> ShowS
HTMLSrcset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTMLSrcset] -> ShowS
$cshowList :: [HTMLSrcset] -> ShowS
show :: HTMLSrcset -> String
$cshow :: HTMLSrcset -> String
showsPrec :: Int -> HTMLSrcset -> ShowS
$cshowsPrec :: Int -> HTMLSrcset -> ShowS
Show, HTMLSrcset -> HTMLSrcset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTMLSrcset -> HTMLSrcset -> Bool
$c/= :: HTMLSrcset -> HTMLSrcset -> Bool
== :: HTMLSrcset -> HTMLSrcset -> Bool
$c== :: HTMLSrcset -> HTMLSrcset -> Bool
Eq, Eq HTMLSrcset
HTMLSrcset -> HTMLSrcset -> Bool
HTMLSrcset -> HTMLSrcset -> Ordering
HTMLSrcset -> HTMLSrcset -> HTMLSrcset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HTMLSrcset -> HTMLSrcset -> HTMLSrcset
$cmin :: HTMLSrcset -> HTMLSrcset -> HTMLSrcset
max :: HTMLSrcset -> HTMLSrcset -> HTMLSrcset
$cmax :: HTMLSrcset -> HTMLSrcset -> HTMLSrcset
>= :: HTMLSrcset -> HTMLSrcset -> Bool
$c>= :: HTMLSrcset -> HTMLSrcset -> Bool
> :: HTMLSrcset -> HTMLSrcset -> Bool
$c> :: HTMLSrcset -> HTMLSrcset -> Bool
<= :: HTMLSrcset -> HTMLSrcset -> Bool
$c<= :: HTMLSrcset -> HTMLSrcset -> Bool
< :: HTMLSrcset -> HTMLSrcset -> Bool
$c< :: HTMLSrcset -> HTMLSrcset -> Bool
compare :: HTMLSrcset -> HTMLSrcset -> Ordering
$ccompare :: HTMLSrcset -> HTMLSrcset -> Ordering
Ord)

-- | Defines the image candidates.
data HTMLSrcsetCandidate = HTMLSrcsetCandidate
  { HTMLSrcsetCandidate -> Text
htmlSrcsetURL        :: !Text
  , HTMLSrcsetCandidate -> HTMLSrcsetDescriptor
htmlSrcsetDescriptor :: !HTMLSrcsetDescriptor
  } deriving (Int -> HTMLSrcsetCandidate -> ShowS
[HTMLSrcsetCandidate] -> ShowS
HTMLSrcsetCandidate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTMLSrcsetCandidate] -> ShowS
$cshowList :: [HTMLSrcsetCandidate] -> ShowS
show :: HTMLSrcsetCandidate -> String
$cshow :: HTMLSrcsetCandidate -> String
showsPrec :: Int -> HTMLSrcsetCandidate -> ShowS
$cshowsPrec :: Int -> HTMLSrcsetCandidate -> ShowS
Show, HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
$c/= :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
== :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
$c== :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
Eq, Eq HTMLSrcsetCandidate
HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Ordering
HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> HTMLSrcsetCandidate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> HTMLSrcsetCandidate
$cmin :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> HTMLSrcsetCandidate
max :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> HTMLSrcsetCandidate
$cmax :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> HTMLSrcsetCandidate
>= :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
$c>= :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
> :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
$c> :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
<= :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
$c<= :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
< :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
$c< :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Bool
compare :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Ordering
$ccompare :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate -> Ordering
Ord)

-- | Defines the srcset descriptor.
data HTMLSrcsetDescriptor
  = HTMLSrcsetWidth Int
  | HTMLSrcsetPixel Int
  | HTMLSrcsetNone
    deriving (Int -> HTMLSrcsetDescriptor -> ShowS
[HTMLSrcsetDescriptor] -> ShowS
HTMLSrcsetDescriptor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HTMLSrcsetDescriptor] -> ShowS
$cshowList :: [HTMLSrcsetDescriptor] -> ShowS
show :: HTMLSrcsetDescriptor -> String
$cshow :: HTMLSrcsetDescriptor -> String
showsPrec :: Int -> HTMLSrcsetDescriptor -> ShowS
$cshowsPrec :: Int -> HTMLSrcsetDescriptor -> ShowS
Show, HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
$c/= :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
== :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
$c== :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
Eq, Eq HTMLSrcsetDescriptor
HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Ordering
HTMLSrcsetDescriptor
-> HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HTMLSrcsetDescriptor
-> HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor
$cmin :: HTMLSrcsetDescriptor
-> HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor
max :: HTMLSrcsetDescriptor
-> HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor
$cmax :: HTMLSrcsetDescriptor
-> HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor
>= :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
$c>= :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
> :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
$c> :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
<= :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
$c<= :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
< :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
$c< :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Bool
compare :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Ordering
$ccompare :: HTMLSrcsetDescriptor -> HTMLSrcsetDescriptor -> Ordering
Ord)

-- | Parses a srcset attribute value.
htmlSrcsetParse :: Text -> HTMLSrcset
htmlSrcsetParse :: Text -> HTMLSrcset
htmlSrcsetParse =
  ( [HTMLSrcsetCandidate] -> HTMLSrcset
HTMLSrcset
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe HTMLSrcsetCandidate
htmlSrcsetParseCandidate
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
","
  )

-- | Parses a srcset candidate value.
htmlSrcsetParseCandidate :: Text -> Maybe HTMLSrcsetCandidate
htmlSrcsetParseCandidate :: Text -> Maybe HTMLSrcsetCandidate
htmlSrcsetParseCandidate Text
x =
  case Text -> [Text]
T.words Text
x of
    (Text
u:Text
d:[])   -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> HTMLSrcsetDescriptor -> HTMLSrcsetCandidate
HTMLSrcsetCandidate Text
u forall a b. (a -> b) -> a -> b
$ Text -> HTMLSrcsetDescriptor
htmlSrcsetParseDescriptor Text
d
    (Text
u:[])     -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> HTMLSrcsetDescriptor -> HTMLSrcsetCandidate
HTMLSrcsetCandidate Text
u HTMLSrcsetDescriptor
HTMLSrcsetNone
    [Text]
_otherwise -> forall a. Maybe a
Nothing

-- | Parses a srcset descriptor value.
htmlSrcsetParseDescriptor :: Text -> HTMLSrcsetDescriptor
htmlSrcsetParseDescriptor :: Text -> HTMLSrcsetDescriptor
htmlSrcsetParseDescriptor Text
x = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$
  (Int -> HTMLSrcsetDescriptor
HTMLSrcsetWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Int
f Text
"w")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> HTMLSrcsetDescriptor
HTMLSrcsetPixel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Int
f Text
"x")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. a -> Maybe a
Just HTMLSrcsetDescriptor
HTMLSrcsetNone)
  where
    f :: Text -> Maybe Int
f Text
s = Text -> Text -> Maybe Text
T.stripSuffix Text
s Text
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
textReadDec

-- | Renders a srcset.
htmlSrcsetRender :: HTMLSrcset -> Text
htmlSrcsetRender :: HTMLSrcset -> Text
htmlSrcsetRender =
  ( Text -> [Text] -> Text
T.intercalate Text
","
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HTMLSrcsetCandidate -> Text
htmlSrcsetRenderCandidate
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTMLSrcset -> [HTMLSrcsetCandidate]
htmlSrcsetCandidates
  )

-- | Renders a srcset candidate.
htmlSrcsetRenderCandidate :: HTMLSrcsetCandidate -> Text
htmlSrcsetRenderCandidate :: HTMLSrcsetCandidate -> Text
htmlSrcsetRenderCandidate (HTMLSrcsetCandidate Text
u HTMLSrcsetDescriptor
d) =
  [Text] -> Text
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall a b. (a -> b) -> a -> b
$ [ Text
u, HTMLSrcsetDescriptor -> Text
htmlSrcsetRenderDescriptor HTMLSrcsetDescriptor
d ]

-- | Renders a srcset descriptor.
htmlSrcsetRenderDescriptor :: HTMLSrcsetDescriptor -> Text
htmlSrcsetRenderDescriptor :: HTMLSrcsetDescriptor -> Text
htmlSrcsetRenderDescriptor = \case
  HTMLSrcsetWidth Int
x -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
x forall a. Semigroup a => a -> a -> a
<> String
"w"
  HTMLSrcsetPixel Int
x -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
x forall a. Semigroup a => a -> a -> a
<> String
"x"
  HTMLSrcsetDescriptor
HTMLSrcsetNone -> Text
T.empty

-- | Returns the URLs for a srcset.
htmlSrcsetListURL :: HTMLSrcset -> [Text]
htmlSrcsetListURL :: HTMLSrcset -> [Text]
htmlSrcsetListURL (HTMLSrcset [HTMLSrcsetCandidate]
c) =
  forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map HTMLSrcsetCandidate -> Text
htmlSrcsetURL [HTMLSrcsetCandidate]
c

-- | Maps a function over the srcset URLs.
htmlSrcsetMapURL :: (Text -> Text) -> HTMLSrcset -> HTMLSrcset
htmlSrcsetMapURL :: (Text -> Text) -> HTMLSrcset -> HTMLSrcset
htmlSrcsetMapURL Text -> Text
f (HTMLSrcset [HTMLSrcsetCandidate]
c) = [HTMLSrcsetCandidate] -> HTMLSrcset
HTMLSrcset forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map HTMLSrcsetCandidate -> HTMLSrcsetCandidate
g [HTMLSrcsetCandidate]
c
  where
    g :: HTMLSrcsetCandidate -> HTMLSrcsetCandidate
g (HTMLSrcsetCandidate Text
u HTMLSrcsetDescriptor
d) = Text -> HTMLSrcsetDescriptor -> HTMLSrcsetCandidate
HTMLSrcsetCandidate (Text -> Text
f Text
u) HTMLSrcsetDescriptor
d

-- | Returns the smallest image in the srcset.
htmlSrcsetImageMin :: HTMLSrcset -> Text
htmlSrcsetImageMin :: HTMLSrcset -> Text
htmlSrcsetImageMin (HTMLSrcset [HTMLSrcsetCandidate]
c) =
  ( forall a b. (a, b) -> b
snd
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> (Int, a)
IntMap.findMin
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [(Int, a)] -> IntMap a
IntMap.fromList
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HTMLSrcsetCandidate -> (Int, Text)
htmlSrcsetCandidatePair
  ) [HTMLSrcsetCandidate]
c

-- | Returns the largest image in the srcset.
htmlSrcsetImageMax :: HTMLSrcset -> Text
htmlSrcsetImageMax :: HTMLSrcset -> Text
htmlSrcsetImageMax (HTMLSrcset [HTMLSrcsetCandidate]
c) =
  ( forall a b. (a, b) -> b
snd
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> (Int, a)
IntMap.findMax
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [(Int, a)] -> IntMap a
IntMap.fromList
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HTMLSrcsetCandidate -> (Int, Text)
htmlSrcsetCandidatePair
  ) [HTMLSrcsetCandidate]
c

-- | Gets the size of the descriptor.
htmlSrcsetDescriptorSize :: HTMLSrcsetDescriptor -> Int
htmlSrcsetDescriptorSize :: HTMLSrcsetDescriptor -> Int
htmlSrcsetDescriptorSize = \case
  HTMLSrcsetWidth Int
x -> Int
x
  HTMLSrcsetPixel Int
x -> Int
x
  HTMLSrcsetDescriptor
HTMLSrcsetNone -> Int
1

-- | Converts a candidate to a pair.
htmlSrcsetCandidatePair :: HTMLSrcsetCandidate -> (Int, Text)
htmlSrcsetCandidatePair :: HTMLSrcsetCandidate -> (Int, Text)
htmlSrcsetCandidatePair (HTMLSrcsetCandidate Text
u HTMLSrcsetDescriptor
d) =
  (HTMLSrcsetDescriptor -> Int
htmlSrcsetDescriptorSize HTMLSrcsetDescriptor
d, Text
u)

-- | Filter candidates from a srcset.
htmlSrcsetFilter :: (HTMLSrcsetCandidate -> Bool) -> HTMLSrcset -> HTMLSrcset
htmlSrcsetFilter :: (HTMLSrcsetCandidate -> Bool) -> HTMLSrcset -> HTMLSrcset
htmlSrcsetFilter HTMLSrcsetCandidate -> Bool
f (HTMLSrcset [HTMLSrcsetCandidate]
c) = [HTMLSrcsetCandidate] -> HTMLSrcset
HTMLSrcset forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter HTMLSrcsetCandidate -> Bool
f [HTMLSrcsetCandidate]
c