content: {-# LANGUAGE OverloadedStrings #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      : Hasmin.Types.Gradient
  -- Copyright   : (c) 2017 Cristian Adrián Ontivero
  -- License     : BSD3
  -- Stability   : experimental
  -- Portability : non-portable
  --
  -----------------------------------------------------------------------------
  module Hasmin.Types.Gradient
      ( Gradient(..)
      , Side(..)
      , ColorStop(..)
      , Size(..)
      , Shape(..)
      ) where
  
  import Control.Monad.Reader (Reader, ask)
  import Data.Monoid ((<>))
  import Data.Text.Lazy.Builder (singleton)
  import Data.Maybe (catMaybes, fromJust, isNothing, isJust)
  import Data.Either (isLeft)
  
  import Hasmin.Class
  import Hasmin.Config
  import Hasmin.Types.Color
  import Hasmin.Types.Dimension
  import Hasmin.Types.Numeric
  import Hasmin.Types.PercentageLength
  import Hasmin.Types.Position
  import Hasmin.Utils
  
  -- | CSS <side-or-corner> data type
  data Side = LeftSide | RightSide | TopSide | BottomSide
    deriving (Show, Eq)
  instance ToText Side where
    toBuilder LeftSide   = "left"
    toBuilder RightSide  = "right"
    toBuilder TopSide    = "top"
    toBuilder BottomSide = "bottom"
  
  -- Possible pair of values, as expected by linear-gradient()
  type SideOrCorner = (Side, Maybe Side)
  
  -- | CSS <color-stop> data type
  data ColorStop = ColorStop { csColor   :: Color
                             , colorHint :: Maybe PercentageLength
                             } deriving (Show, Eq)
  instance ToText ColorStop where
    toBuilder (ColorStop c mpl) = toBuilder c <> maybe mempty f mpl
      where f (Left p)  = singleton ' ' <> toBuilder p
            f (Right l) = singleton ' ' <> toBuilder l
  instance Minifiable ColorStop where
    minify (ColorStop c mlp) = do
      newC   <- minify c
      newMlp <- (mapM . mapM) minify mlp
      pure $ ColorStop newC newMlp
  
  -- minifies color hints in a \<color-stops\> list
  minifyColorHints :: [ColorStop] -> [ColorStop]
  minifyColorHints [c1,c2] = [newC1, newC2]
    where ch1 = colorHint c1
          ch2 = colorHint c2
          newC1
              | isJust ch1 && isZero (fromJust ch1) = c1 {colorHint = Nothing}
              | otherwise = c1
          newC2
              | ch2 == Just (Left (Percentage 100)) = c2 {colorHint = Nothing}
              | ch2 `notGreaterThan` ch1 = c2 {colorHint = Just $ Right NullLength}
              | otherwise                = c2
  minifyColorHints (c@(ColorStop a x):xs) = case x of
                         Nothing -> c : analyzeList (Left $ Percentage 0) 1 (c:xs) xs
                         Just y  -> if isZero y
                                       then ColorStop a Nothing : analyzeList y 1 (c:xs) xs
                                       else c: analyzeList y 1 (c:xs) xs
  minifyColorHints xs = error ("invalid <color-stop> list: " ++ show xs)
  
  -- Returns True if the first value is equal or less than the second one, and False
  -- otherwise, or if a comparison isn't possible.
  notGreaterThan :: Maybe PercentageLength -> Maybe PercentageLength -> Bool
  y `notGreaterThan` x
      | isNothing x || isZero (fromJust x) = notPositive y
      | otherwise = case fromJust x of
                      Left p  -> maybe False (either (<= p) (const False)) y
                      Right d -> maybe False (either (const False) (notGreaterThanLength d)) y
    where notPositive  = maybe False (either (<= 0) notPositiveLength)
  
          notPositiveLength (Length d _) = d <= 0
          notPositiveLength NullLength   = True
  
          notGreaterThanLength NullLength NullLength   = True
          notGreaterThanLength NullLength (Length r _) = r <= 0
          notGreaterThanLength (Length r _) NullLength = 0 <= r
          notGreaterThanLength (Length r1 u1) (Length r2 u2)
              | u1 == u2 = r2 <= r1
              | isRelative u1 || isRelative u2 = False
              | otherwise = toInches r2 u2 <= toInches r1 u1
  
  -- Gathers at least three color stops to interpolate between the first and
  -- last, and see if the middle one can be removed. As long as the color hints
  -- are Nothing, keeps accumulating until it finds a Just it can use to interpolate.
  analyzeList :: PercentageLength -> Int -> [ColorStop]
              -> [ColorStop] -> [ColorStop]
  analyzeList start n list (ColorStop _ mpl:xs)
      | n < 2 = analyzeList start (n+1) list xs
      | otherwise =
          case mpl of
            Just y  -> let (newList, remainingList, startVal) = minifySegment start y n list
                       in newList ++ analyzeList startVal 2 remainingList xs
            Nothing -> analyzeList start (n+1) list xs
  analyzeList start n list [] =
      case mpl of
        Just (Left (Percentage 100)) -> [ColorStop x Nothing]
        Nothing  -> let end = Left $ Percentage 100
                        (newList, _, _) = minifySegment start end (n-1) list
                    in newList ++ [(last list) {colorHint = Nothing}]
        _        -> [c]
    where c@(ColorStop x mpl) = last list
  
  -- Given two values and a count of values, uses them to create a list of
  -- interpolated values, and based on the list decides if it should remove a
  -- color hint or not.
  minifySegment :: PercentageLength -> PercentageLength -> Int -> [ColorStop]
                -> ([ColorStop], [ColorStop], PercentageLength)
  minifySegment start end n list
      | all isPercentage segment = handlePercentages (fromLeft' start) (fromLeft' end) n remainingList
      -- add here support for dimension interpolation
      | otherwise = (take (n-1) remainingList, remainingList, fromJust $ colorHint (head remainingList))
    where segment = take (n+1) list
          (_, remainingList) = splitAt (n-1) list
          isPercentage x = maybe True isLeft (colorHint x)
  
  -- Handles the minification of color hint values between percentages
  handlePercentages :: Percentage -> Percentage -> Int
                    -> [ColorStop] -> ([ColorStop], [ColorStop], PercentageLength)
  handlePercentages start end n remainingList =
      let newList = zipWith simplifyValue remainingList interpolation
      in (newList, remainingList, Left newStartVal)
    where newStartVal = maybe (last interpolation) fromLeft' (colorHint $ head remainingList)
          step = (end - start) / toPercentage n
          interpolation = [start + toPercentage x * step | x <- [1..n-1]]
          simplifyValue (ColorStop x mpl) y = ColorStop x $ mpl >>= \v ->
              if fromLeft' v == y
                 then Nothing
                 else if fromLeft' v <= start
                         then Just $ Right NullLength
                         else Just v
  
  -- | CSS <https://drafts.csswg.org/css-images-3/#typedef-gradient \<gradient\>>
  -- data type.
  data Gradient = OldLinearGradient (Maybe (Either Angle SideOrCorner)) [ColorStop]
                -- OldLinearGradient is for the old syntax. It should eventually be deleted.
                | LinearGradient (Maybe (Either Angle SideOrCorner)) [ColorStop]
                | RadialGradient (Maybe Shape) (Maybe Size) (Maybe Position) [ColorStop]
                  -- TODO: replace with Maybe (These Shape Size)
    deriving (Show)
                -- ,| RepeatingLinearGradient
                -- ,| RepeatingRadialGradient
  
  
  {-
    radial-gradient() = radial-gradient(
      [ <ending-shape> || <size> ]? [ at <position> ]? ,
      <color-stop-list>
    )
  
    radial-gradient(
      [ [ circle || <length> ]                         [ at <position> ]? , |
        [ ellipse || [ <length> | <percentage> ]{2} ]  [ at <position> ]? , |
        [ [ circle | ellipse ] || <extent-keyword> ]   [ at <position> ]? , |
        at <position> ,
      ]?
      <color-stop> [ , <color-stop> ]+
    )
    where <extent-keyword> = closest-corner | closest-side | farthest-corner | farthest-side
      and <color-stop>     = <color> [ <percentage> | <length> ]?
  -}
  
  -- | CSS <https://drafts.csswg.org/css-images-3/#typedef-size \<size\>> data
  -- type, used by @radial-gradient()@.
  data Size = ClosestCorner
            | ClosestSide
            | FarthestCorner
            | FarthestSide
            | SL Length
            | PL PercentageLength PercentageLength
    deriving (Eq, Show)
  
  instance ToText Size where
    toBuilder ClosestCorner  = "closest-corner"
    toBuilder ClosestSide    = "closest-side"
    toBuilder FarthestCorner = "farthest-corner"
    toBuilder FarthestSide   = "farthest-side"
    toBuilder (SL d)         = toBuilder d
    toBuilder (PL pl1 pl2)   = toBuilder pl1 <> singleton ' ' <> toBuilder pl2
  
  -- TODO rename to EndingShape
  -- | CSS <https://drafts.csswg.org/css-images-3/#valdef-radial-gradient-ending-shape \<ending-shape\>> data type, used by @radial-gradient()@.
  data Shape = Circle | Ellipse
    deriving (Eq, Show)
  
  instance ToText Shape where
    toBuilder Circle  = "circle"
    toBuilder Ellipse = "ellipse"
  
  -- If the argument is to top, to right, to bottom, or to left, the angle of
  -- the gradient line is 0deg, 90deg, 180deg, or 270deg, respectively.
  instance Minifiable Gradient where
    minify g@(OldLinearGradient x cs) = do
        conf <- ask
        case gradientSettings conf of
          GradientMinOn  -> do css  <- mapM minify cs
                               pure $ OldLinearGradient x (minifyColorHints css)
          GradientMinOff -> pure g
    minify g@(LinearGradient x cs) = do
        conf <- ask
        case gradientSettings conf of
          GradientMinOn  -> do css  <- mapM minify cs
                               newX <- minifyAngleOrSide x
                               pure $ LinearGradient newX (minifyColorHints css)
          GradientMinOff -> pure g
    minify g@(RadialGradient sh sz p cs) = do
        conf <- ask
        case gradientSettings conf of
          GradientMinOn  -> do css  <- mapM minify cs
                               let np = minifyRadialPosition True {-shouldMinifyPosition conf-} p
                               pure $ minShapeAndSize sh sz np (minifyColorHints css)
          GradientMinOff -> pure g
  
  -- If a single length was used, the default shape is circle, otherwise ellipse.
  -- circle farthest-corner == circle
  -- ellipse farthest-corner == ellipse == farthest-corner
  minShapeAndSize :: Maybe Shape -> Maybe Size -> Maybe Position -> [ColorStop] -> Gradient
  minShapeAndSize (Just Circle) sz@(Just (SL _))       = RadialGradient Nothing sz
  minShapeAndSize (Just Circle) (Just FarthestCorner)  = RadialGradient (Just Circle) Nothing
  minShapeAndSize (Just Ellipse) sz@(Just (PL _ _))    = RadialGradient Nothing sz
  minShapeAndSize (Just Ellipse) (Just FarthestCorner) = RadialGradient Nothing Nothing
  minShapeAndSize (Just Ellipse) sz@(Just _)           = RadialGradient Nothing sz
  minShapeAndSize (Just Ellipse) Nothing               = RadialGradient Nothing Nothing
  minShapeAndSize Nothing (Just FarthestCorner)        = RadialGradient Nothing Nothing
  minShapeAndSize x sz                                 = RadialGradient x sz
  
  -- Minifies the position in the radial gradient based on the position
  -- minification settings. If positions should be minified, and if it is
  -- equivalent to 'center', it is removed. If positions should not be minified,
  -- it still removes it if it is equivalent to 'center', but leaves it untouched
  -- otherwise.
  minifyRadialPosition :: Bool -> Maybe Position -> Maybe Position
  minifyRadialPosition _ Nothing = Nothing
  minifyRadialPosition cond (Just p)
      | minifiedPos == centerPos = Nothing
      | cond                     = Just minifiedPos
      | otherwise                = Just p
    where centerPos = Position Nothing p50 Nothing Nothing
          minifiedPos = minifyPosition p
  
  minifyAngleOrSide :: Maybe (Either Angle SideOrCorner)
                    -> Reader Config (Maybe (Either Angle SideOrCorner))
  minifyAngleOrSide Nothing  = pure Nothing
  minifyAngleOrSide (Just (Left a))
      | a == defaultGradientAngle = pure Nothing
      | otherwise                 = Just . Left <$> minify a
    where defaultGradientAngle = Angle 180 Deg
  minifyAngleOrSide (Just (Right b))
      | b == defaultGradientSideOrCorner = pure Nothing
      | otherwise                        = pure $ Just (minifySide b)
    where defaultGradientSideOrCorner      = (BottomSide, Nothing)
          minifySide (TopSide, Nothing)    = Left NullAngle
          minifySide (RightSide, Nothing)  = Left (Angle 90 Deg)
          minifySide (BottomSide, Nothing) = Left (Angle 180 Deg)
          minifySide (LeftSide, Nothing)   = Left (Angle 270 Deg)
          minifySide z                     = Right z
  
  instance ToText Gradient where
    toBuilder (OldLinearGradient mas csl) = maybe mempty f mas
        <> mconcatIntersperse id (singleton ',') (fmap toBuilder csl)
      where f         = either ((<> singleton ',') . toBuilder) g
            g (s, ms) = toBuilder s
                     <> maybe mempty (\x -> singleton ' ' <> toBuilder x) ms
                     <> singleton ','
    toBuilder (LinearGradient mas csl) = maybe mempty f mas
        <> mconcatIntersperse id (singleton ',') (fmap toBuilder csl)
      where f         = either ((<> singleton ',') . toBuilder) g
            g (s, ms) = "to " <> toBuilder s
                     <> maybe mempty (\x -> singleton ' ' <> toBuilder x) ms
                     <> singleton ','
    toBuilder (RadialGradient sh sz p cs) = firstPart
        <> mconcatIntersperse id (singleton ',') (fmap toBuilder cs)
      where l = catMaybes [fmap toBuilder sh, fmap toBuilder sz, fmap (\x -> "at " <> toBuilder x) p]
            firstPart
                | null l    = mempty
                | otherwise = mconcatIntersperse id (singleton ' ') l <> singleton ','
  
  instance Eq Gradient where
    LinearGradient x1 csl1 == LinearGradient x2 csl2 =
        handleMaybe x1 x2 && csl1 == csl2
      where handleMaybe Nothing Nothing      = True
            handleMaybe (Just x) (Just y)    = handleEither x y
            handleMaybe _ _                  = False
            handleEither (Left a1) (Left a2) = a1 == a2
            handleEither (Left a) (Right s)  = angleSideEq a s
            handleEither (Right s) (Left a)  = angleSideEq a s
            handleEither s1 s2               = s1 == s2
    LinearGradient{} == _ = False
    _ == LinearGradient{} = False
    _ == _ = False -- TODO implement other comparisons
  
  angleSideEq :: Angle -> SideOrCorner -> Bool
  angleSideEq (Angle 90 Deg) (RightSide, Nothing)   = True
  angleSideEq (Angle 180 Deg) (BottomSide, Nothing) = True
  angleSideEq (Angle 270 Deg) (LeftSide, Nothing)   = True
  angleSideEq a (TopSide, Nothing)
      | isZeroAngle a = True
      | otherwise     = False
  angleSideEq _ _                                   = False
  