content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TupleSections #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      : Hasmin.Parser.Value
  -- Copyright   : (c) 2017 Cristian Adrián Ontivero
  -- License     : BSD3
  -- Stability   : experimental
  -- Portability : unknown
  --
  -- Parsers for CSS \<gradient> values.
  --
  -----------------------------------------------------------------------------
  module Hasmin.Parser.Gradient where
  
  import Control.Applicative ((<|>), many, optional)
  import Data.Functor (($>))
  import Text.Parser.Permutation ((<|?>), (<$$>), (<$?>), (<||>), permute)
  import Data.Maybe (isNothing)
  import Data.Attoparsec.Text (Parser)
  import qualified Data.Attoparsec.Text as A
  
  import Hasmin.Parser.Utils
  import Hasmin.Parser.Color
  import Hasmin.Parser.Position
  import Hasmin.Parser.Dimension
  import Hasmin.Parser.PercentageLength
  import Hasmin.Types.Gradient
  import Hasmin.Utils
  
  radialgradient :: Parser Gradient
  radialgradient = functionParser $ do
      (def, c) <- A.option (True, RadialGradient Nothing Nothing) ((False,) <$> endingShapeAndSize <* skipComments)
      p  <- optional (A.asciiCI "at" *> skipComments *> position)
      _  <- if def && isNothing p
               then pure '*' -- do nothing
               else comma
      c p <$>  colorStopList
    where circle = A.asciiCI "circle" $> Just Circle <* skipComments
          ellipse = A.asciiCI "ellipse" $> Just Ellipse <* skipComments
          endingShapeAndSize = r1 <|> r2 <|> r3
            where r1 = permute (RadialGradient <$?> (Nothing, ellipse) <||> (Just <$> (PL <$> percentageLength <*> lexeme percentageLength)))
                  r2 = permute (RadialGradient <$?> (Nothing, circle) <||> (Just . SL <$> distance <* skipComments))
                  r3 = permute (RadialGradient <$?> (Nothing, circle <|> ellipse) <||> extentKeyword)
                     <|> permute (RadialGradient <$$> (circle <|> ellipse) <|?> (Nothing, extentKeyword))
                  extentKeyword = Just <$>
                      parserFromPairs [("closest-corner",  pure ClosestCorner)
                                      ,("closest-side",    pure ClosestSide)
                                      ,("farthest-corner", pure FarthestCorner)
                                      ,("farthest-side",   pure FarthestSide)] <* skipComments
  
  -- | Assumes "linear-gradient(", or one of its prefixed equivalents, has been parsed.
  -- : [<angle>|to <side-or-corner> ,]? <color-stop> [, <color-stop>]+
  lineargradient :: Parser Gradient
  lineargradient = functionParser (lg <|> oldLg)
    where lg = LinearGradient <$> optional angleOrSide <*> colorStopList
          oldLg = OldLinearGradient <$> optional ((ga <|> sc) <* comma)
                                    <*> colorStopList
          angleOrSide = (ga <|> gs) <* comma
          ga = Left <$> angle
          gs = A.asciiCI "to" *> skipComments *> sc
          sc = Right <$> sideOrCorner
  
  -- <side-or-corner> = [left | right] || [top | bottom]
  sideOrCorner :: Parser (Side, Maybe Side)
  sideOrCorner = orderOne <|> orderTwo
    where orderOne = mzip (leftright <* skipComments) (optional topbottom)
          orderTwo = mzip (topbottom <* skipComments) (optional leftright)
  
          leftright :: Parser Side
          leftright =  parserFromPairs [("left", pure LeftSide), ("right", pure RightSide)]
  
          topbottom :: Parser Side
          topbottom = parserFromPairs [("top", pure TopSide), ("bottom", pure BottomSide)]
  
  colorStopList :: Parser [ColorStop]
  colorStopList = do
      c1 <- colorStop
      _  <- A.char ',' <* skipComments
      c2 <- colorStop
      cs <- many (A.char ',' *> skipComments *> colorStop)
      pure $ c1:c2:cs
  
  colorStop :: Parser ColorStop
  colorStop = ColorStop <$> color <* skipComments
          <*> optional (percentageLength <* skipComments)
  