content: {-# LANGUAGE OverloadedStrings #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      : Hasmin.Types.Dimension
  -- Copyright   : (c) 2017 Cristian Adrián Ontivero
  -- License     : BSD3
  -- Stability   : experimental
  -- Portability : unknown
  --
  -- CSS Dimension data types: \<length\>, \<angle\>, \<time\>, \<frequency\>,
  -- and \<resolution\>. Provides conversion of absolute dimensions into other
  -- equivalent dimensions.
  --
  -----------------------------------------------------------------------------
  module Hasmin.Types.Dimension
      ( Length(..)
      , LengthUnit(..)
      , Angle(..)
      , AngleUnit(..)
      , Time(..)
      , TimeUnit(..)
      , Frequency(..)
      , FrequencyUnit(..)
      , Resolution(..)
      , ResolutionUnit(..)
      , toInches
      , toPixels
      , toRadians
      , isRelative
      , isRelativeLength
      , isZeroLen
      , isZeroAngle
      ) where
  
  import Control.Monad.Reader (asks)
  import Data.Monoid ((<>))
  import Data.Text.Lazy.Builder (singleton, fromText)
  
  import Hasmin.Class
  import Hasmin.Config
  import Hasmin.Types.Numeric
  import Hasmin.Utils
  
  -- | The \<length\> CSS data type
  data Length = Length Number LengthUnit
              | NullLength
    deriving (Show)
  instance Eq Length where
    (Length r1 u1) == (Length r2 u2)
      | u1 == u2                       = r1 == r2
      | isAbsolute u1 && isAbsolute u2 = toInches r1 u1 == toInches r2 u2
      | otherwise                      = r1 == 0 && r2 == 0
    x == y = isZeroLen x && isZeroLen y
  instance Minifiable Length where
    minify NullLength = pure NullLength
    minify d@(Length r u) = do
        shouldMinifyUnits <- asks ((DimMinOn ==) . dimensionSettings)
        pure $ if d == Length 0 Q
                  then NullLength
                  else if (not . isRelative) u && shouldMinifyUnits
                          then minDim Length r u [Q, CM, MM, IN, PC, PT, PX]
                          else d
  
  isRelative :: LengthUnit -> Bool
  isRelative x = x == EM || x == EX || x == CH || x == VH
              || x == VW || x == VMIN || x == VMAX || x == REM
  
  isAbsolute :: LengthUnit -> Bool
  isAbsolute x = x == PX || x == PT || x == PC || x == IN
              || x == MM || x == CM || x == Q
  
  isRelativeLength :: Length -> Bool
  isRelativeLength (Length _ u) = isRelative u
  isRelativeLength NullLength   = False
  
  isZeroLen :: Length -> Bool
  isZeroLen (Length 0 _) = True
  isZeroLen NullLength   = True
  isZeroLen _            = False
  
  instance ToText Length where
    toBuilder (Length r u) = (fromText . toText) r <> (fromText . toText) u
    toBuilder NullLength   = singleton '0'
  
  -- | The \<angle\> CSS data type
  data Angle = Angle Number AngleUnit
            | NullAngle
    deriving (Show)
  instance Eq Angle where
    (Angle r1 u1) == (Angle r2 u2)
      | u1 == u2  = r1 == r2
      | otherwise = toDegrees r1 u1 == toDegrees r2 u2
    x == y = isZeroAngle x && isZeroAngle y
  
  isZeroAngle :: Angle -> Bool
  isZeroAngle NullAngle   = True
  isZeroAngle (Angle 0 _) = True
  isZeroAngle _           = False
  
  instance Minifiable Angle where
    minify (Angle 0 _)   = pure NullAngle
    minify a@(Angle r u) = do
        dimSettings <- asks dimensionSettings
        pure $ case dimSettings of
                 DimMinOn  -> minDim Angle r u [minBound..]
                 DimMinOff -> a
    minify NullAngle = pure NullAngle
  
  instance ToText Angle where
    toBuilder NullAngle   = singleton '0'
    toBuilder (Angle r u) = toBuilder r <> toBuilder u
  
  -- | The \<time\> CSS data type
  data Time = Time Number TimeUnit
    deriving (Show)
  instance Eq Time where
    (Time r1 u1) == (Time r2 u2)
      | u1 == u2  = r1 == r2
      | otherwise = toSeconds r1 u1 == toSeconds r2 u2
  instance Minifiable Time where
    minify d@(Time r u) = do
        dimSettings <- asks dimensionSettings
        pure $ case dimSettings of
                  DimMinOn  -> minDim Time r u [minBound..]
                  DimMinOff -> d
  instance ToText Time where
    toBuilder (Time r u) = toBuilder r <> toBuilder u
  
  -- | The \<frequency\> CSS data type
  data Frequency = Frequency Number FrequencyUnit
    deriving (Show)
  instance Eq Frequency where
    (Frequency r1 u1) == (Frequency r2 u2)
      | u1 == u2  = r1 == r2
      | otherwise = toHertz r1 u1 == toHertz r2 u2
  instance Minifiable Frequency where
    minify f@(Frequency r u) = do
        dimSettings <- asks dimensionSettings
        pure $ case dimSettings of
                  DimMinOn  -> minDim Frequency r u [minBound..]
                  DimMinOff -> f
  instance ToText Frequency where
    toBuilder (Frequency r u) = toBuilder r <> toBuilder u
  
  -- | The \<resolution\> CSS data type
  data Resolution = Resolution Number ResolutionUnit
    deriving (Show)
  instance Eq Resolution where
    (Resolution r1 u1) == (Resolution r2 u2)
      | u1 == u2  = r1 == r2
      | otherwise = toDpi r1 u1 == toDpi r2 u2
  instance Minifiable Resolution where
    minify x@(Resolution r u) = do
        dimSettings <- asks dimensionSettings
        pure $ case dimSettings of
                 DimMinOn  -> minDim Resolution r u [minBound..]
                 DimMinOff -> x
  instance ToText Resolution where
    toBuilder (Resolution r u) = toBuilder r <> toBuilder u
  
  -- | Given a constructor, a number, and a unit, returns
  -- the shortest equivalent representation. If there is more than one, returns
  -- the latest found to "normalize" values, hopefully improving gzip compression.
  minDim :: (Unit a, ToText a) => (Number -> a -> b) -> Number -> a -> [a] -> b
  minDim constructor r u [] = constructor r u
  minDim constructor r u (x:xs)
      | currentLength < newLength = minDim constructor r u xs
      | otherwise                 = minDim constructor equivValue x xs
    where equivValue    = convertTo x r u
          currentLength = textualLength r + textualLength u
          newLength     = textualLength equivValue + textualLength x
  
  class Unit a where
    convertTo :: a -> Number -> a -> Number
  
  data LengthUnit = IN | CM | MM | PC | PT | PX | Q            -- absolute
                  | EM | EX | CH | VH | VW | VMIN | VMAX | REM -- relative
    deriving (Show, Eq, Enum, Bounded)
  instance ToText LengthUnit where
    toBuilder IN   = "in"
    toBuilder CM   = "cm"
    toBuilder MM   = "mm"
    toBuilder Q    = "q"
    toBuilder PC   = "pc"
    toBuilder PT   = "pt"
    toBuilder PX   = "px"
    toBuilder EM   = "em"
    toBuilder EX   = "ex"
    toBuilder CH   = "ch"
    toBuilder VH   = "vh"
    toBuilder VW   = "vw"
    toBuilder VMIN = "vmin"
    toBuilder VMAX = "vmax"
    toBuilder REM  = "rem"
  instance  Unit LengthUnit where
    convertTo IN = toInches
    convertTo CM = toCentimeters
    convertTo MM = toMilimeters
    convertTo Q  = toQuarterMilimeter
    convertTo PT = toPoints
    convertTo PC = toPica
    convertTo PX = toPixels
    convertTo _  = const
  
  data AngleUnit = Turn | Grad | Rad | Deg
    deriving (Show, Eq, Enum, Bounded)
  instance ToText AngleUnit where
    toBuilder Turn = "turn"
    toBuilder Grad = "grad"
    toBuilder Rad  = "rad"
    toBuilder Deg  = "deg"
  instance Unit AngleUnit where
    convertTo Turn = toTurns
    convertTo Grad = toGradians
    convertTo Rad  = toRadians
    convertTo Deg  = toDegrees
  
  data TimeUnit = S -- seconds
                | Ms -- miliseconds
    deriving (Show, Eq, Enum, Bounded)
  instance ToText TimeUnit where
    toBuilder S  = "s"
    toBuilder Ms = "ms"
  instance Unit TimeUnit where
    convertTo S  = toSeconds
    convertTo Ms = toMiliseconds
  
  data FrequencyUnit = Hz | Khz
    deriving (Show, Eq, Enum, Bounded)
  instance ToText FrequencyUnit where
    toBuilder Hz  = "hz"
    toBuilder Khz = "khz"
  instance Unit FrequencyUnit where
    convertTo Hz  = toHertz
    convertTo Khz = toKilohertz
  
  data ResolutionUnit = Dpcm | Dppx | Dpi
    deriving (Show, Eq, Enum, Bounded)
  instance ToText ResolutionUnit where
    toBuilder Dpi  = "dpi"
    toBuilder Dpcm = "dpcm"
    toBuilder Dppx = "dppx"
  instance Unit ResolutionUnit where
    convertTo Dpi  = toDpi
    convertTo Dpcm = toDpcm
    convertTo Dppx = toDppx
  
  toInches :: Number -> LengthUnit -> Number
  toInches d CM = d / 2.54
  toInches d MM = d / 25.4
  toInches d Q  = d / 101.6
  toInches d PT = d / 72
  toInches d PC = d / 6
  toInches d PX = d / 96
  toInches d _  = d -- IN, or any relative value
  
  toCentimeters :: Number -> LengthUnit -> Number
  toCentimeters d IN = d * 2.54
  toCentimeters d MM = d / 10
  toCentimeters d Q  = d / 40
  toCentimeters d PT = d * (2.54 / 72)
  toCentimeters d PC = d * (2.54 / 6)
  toCentimeters d PX = d * (2.54 / 96)
  toCentimeters d _  = d -- CM, or any relative value
  
  toMilimeters :: Number -> LengthUnit -> Number
  toMilimeters d IN = d * 25.4
  toMilimeters d CM = d * 10
  toMilimeters d Q  = d / 4
  toMilimeters d PT = d * (25.4 / 72)
  toMilimeters d PC = d * (25.4 / 6)
  toMilimeters d PX = d * (25.4 / 96)
  toMilimeters d _  = d
  
  toQuarterMilimeter :: Number -> LengthUnit -> Number
  toQuarterMilimeter d IN = d * 101.6
  toQuarterMilimeter d CM = d * 40
  toQuarterMilimeter d MM = d * 4
  toQuarterMilimeter d PT = d * (101.6 / 72)
  toQuarterMilimeter d PC = d * (101.6 / 6)
  toQuarterMilimeter d PX = d * (101.6 / 96)
  toQuarterMilimeter d _  = d
  
  toPoints :: Number -> LengthUnit -> Number
  toPoints d IN = d * 72
  toPoints d CM = d * (72 / 2.54)
  toPoints d MM = d * (72 / 25.4)
  toPoints d Q  = d * (72 / 101.6)
  toPoints d PC = d * 12
  toPoints d PX = d * (3 / 4)
  toPoints d _  = d
  
  toPica :: Number -> LengthUnit -> Number
  toPica d IN = d * 6
  toPica d CM = d * (6 / 2.54)
  toPica d MM = d * (6 / 25.4)
  toPica d Q  = d * (6 / 101.6)
  toPica d PT = d / 12
  toPica d PX = d / 16
  toPica d _  = d
  
  toPixels :: Number -> LengthUnit -> Number
  toPixels d IN = d * 96
  toPixels d CM = d * (96 / 2.54)
  toPixels d MM = d * (96 / 25.4)
  toPixels d Q  = d * (96 / 101.6)
  toPixels d PT = d * (4 / 3)
  toPixels d PC = d * 16
  toPixels d _  = d
  ------------------------------------------------------------------------------
  rationalPi :: Number
  rationalPi = Number $ toRational (pi :: Double)
  
  toDegrees :: Number -> AngleUnit -> Number
  toDegrees d Deg  = d
  toDegrees d Grad = d * (9 / 10)
  toDegrees d Rad  = d * (180 / rationalPi)
  toDegrees d Turn = d * 360
  
  toGradians :: Number -> AngleUnit -> Number
  toGradians d Deg  = d * (10 / 9)
  toGradians d Grad = d
  toGradians d Rad  = d * (200 / rationalPi)
  toGradians d Turn = d * 400
  
  toRadians :: Number -> AngleUnit -> Number
  toRadians d Deg  = d * (rationalPi / 180)
  toRadians d Grad = d * (rationalPi / 200)
  toRadians d Rad  = d
  toRadians d Turn = d * 2 * rationalPi
  
  toTurns :: Number -> AngleUnit -> Number
  toTurns d Deg  = d / 360
  toTurns d Grad = d / 400
  toTurns d Rad  = d / (2 * rationalPi)
  toTurns d Turn = d
  ------------------------------------------------------------------------------
  toSeconds :: Number -> TimeUnit -> Number
  toSeconds d S     = d
  toSeconds d Ms = d / 1000
  
  toMiliseconds :: Number -> TimeUnit -> Number
  toMiliseconds d S     = d * 1000
  toMiliseconds d Ms = d
  ------------------------------------------------------------------------------
  toHertz :: Number -> FrequencyUnit -> Number
  toHertz d Hz  = d
  toHertz d Khz = d * 1000
  
  toKilohertz :: Number -> FrequencyUnit -> Number
  toKilohertz d Hz  = d / 1000
  toKilohertz d Khz = d
  ------------------------------------------------------------------------------
  toDpi :: Number -> ResolutionUnit -> Number
  toDpi d Dpi  = d
  toDpi d Dpcm = d * 2.54
  toDpi d Dppx = d * 96
  
  toDpcm :: Number -> ResolutionUnit -> Number
  toDpcm d Dpi  = d / 2.54
  toDpcm d Dpcm = d
  toDpcm d Dppx = d * (96 / 2.54)
  
  toDppx :: Number -> ResolutionUnit -> Number
  toDppx d Dpi  = d / 96
  toDppx d Dpcm = d * (2.54 / 96)
  toDppx d Dppx = d
  