-- |
-- Module:     Data.CSS.Properties.Classes
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

module Data.CSS.Properties.Classes
    ( -- * Length prisms
      HasLength(..),
      HasAutoLength(..),
      HasPercent(..)
    )
    where

import Control.Lens


-- | Class for length types with a notion of automatic length.

class HasAutoLength len where
    -- | Automatic length.
    autoLen :: len a


-- | Class of types, which feature CSS lengths.
--
-- Minimal complete definition:  '_Em', '_Ex', '_Mm', '_Px', 'zeroLen'.

class HasLength len where
    -- | 'Length' in centimeters (@cm@).  Compatible with '_In', '_Mm',
    -- '_Pc' and '_Pt'.
    _Cm :: (Fractional a, Real a) => Prism' (len a) a
    _Cm = _Mm . iso (/ 10) (* 10)

    -- | 'Length' in units of the font size (@em@).
    _Em :: (Fractional a, Real a) => Prism' (len a) a

    -- | 'Length' in units of the height of the @x@ character in the
    -- current font (@ex@).
    _Ex :: (Fractional a, Real a) => Prism' (len a) a

    -- | 'Length' in inches (@in@).  Compatible with '_Cm', '_Mm', '_Pc'
    -- and '_Pt'.
    _In :: (Fractional a, Real a) => Prism' (len a) a
    _In = _Mm . iso (/ 25.4) (* 25.4)

    -- | 'Length' in millimeters (@mm@).  Compatible with '_Cm', '_In',
    -- '_Pc' and '_Pt'.
    _Mm :: (Fractional a, Real a) => Prism' (len a) a

    -- | 'Length' in picas (@pc@).  Compatible with '_Cm', '_In', '_Mm'
    -- and '_Pt'.
    _Pc :: (Fractional a, Real a) => Prism' (len a) a
    _Pc = _Mm . iso (/ (127/30)) (* (127/30))

    -- | 'Length' in points (@pt@).  Compatible with '_Cm', '_In', '_Mm'
    -- and '_Pc'.
    _Pt :: (Fractional a, Real a) => Prism' (len a) a
    _Pt = _Mm . iso (/ (127/360)) (* (127/360))

    -- | 'Length' in pixels (@px@).
    _Px :: (Fractional a, Real a) => Prism' (len a) a

    -- | Zero length.
    zeroLen :: len a


-- | Class for length types with percentages.
--
-- Minimal complete definition: '_Factor'.

class HasPercent len where
    -- | Relative 'Length' by factor where 1 means 100% (@%@).
    -- Compatible with '_Percent'.
    _Factor :: (Fractional a, Real a) => Prism' (len a) a

    -- | Relative 'Length' in percent (@%@).  Compatible with '_Factor'.
    _Percent :: (Fractional a, Real a) => Prism' (len a) a
    _Percent = _Factor . iso (* 100) (/ 100)