Build.hs

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

module Data.CSS.Build
    ( -- * Media types
      onAll,
      onMedia,

      -- * Selectors
      select,
      -- ** Selector modifiers
      below,
      local,

      -- * Setting properties
      ($=),
      important,
      inherit,
      setProp,

      -- * Auxiliary
      importFrom,
      importUrl
    )
    where

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Bc
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Applicative
import Control.Lens
import Control.Monad.Reader
import Control.Monad.Writer.Class
import Data.CSS.Types
import Data.Set (Set)
import Data.Text (Text)
import Web.Routes.RouteT


-- | Set the given property to the given value.  (infix 2)
--
-- Infix version of 'setProp'.

($=) ::
    (ToPropValue a)
    => PropName   -- ^ Property to set.
    -> a          -- ^ Value to set the property to.
    -> SetProp
prop $= val = do
    BuildCfg mt sel <- ask
    tell (CSS M.empty (M.singleton mt [Property sel prop (toPropValue val) False]))

infix 2 $=


-- | Given children of the current selector.

below :: (MonadWriter CSS m) => [Selector] -> m a -> m a
below sels =
    censoring (cssProps . mapped . mapped . propSelector)
              (liftA2 (\(Selector sel) (Selector sel') ->
                           Selector $ B.append (Bc.snoc sel' ' ') sel)
                      sels)


-- | Mark all property values important.

important :: (MonadWriter CSS m) => m a -> m a
important =
    censoring (cssProps . mapped . mapped . propImportant)
              (const True)


-- | Import the given style sheet for the given media type.

importFrom :: (MonadWriter CSS m) => MediaType -> Text -> m ()
importFrom mt url = tell (CSS (M.singleton url (S.singleton mt)) M.empty)


-- | Import the given style sheet for the given media type.

importUrl ::
    (MonadRoute m, MonadWriter CSS m)
    => MediaType
    -> URL m
    -> m ()
importUrl mt = showURL >=> importFrom mt


-- | Set the given property to be inherited.

inherit :: (MonadReader BuildCfg m, MonadWriter CSS m) => PropName -> m ()
inherit = ($= PropValue "inherit")


-- | Specify stylesheets for all media,

onAll :: (Monad m) => ReaderT (Set MediaType) m a -> m a
onAll = onMedia [MediaType "all"]


-- | Specify stylesheets for the given media.

onMedia :: (Monad m) => [MediaType] -> ReaderT (Set MediaType) m a -> m a
onMedia = flip runReaderT . S.fromList


-- | Specify the selector.

select ::
    (Monad m)
    => [Selector]
    -> ReaderT BuildCfg m a
    -> ReaderT (Set MediaType) m a
select sel (ReaderT c) = ReaderT $ \mt -> c (BuildCfg mt sel)


-- | Set the given property to the given value.
--
-- Non-infix version of '$='.

setProp ::
    (ToPropValue a)
    => PropName   -- ^ Property to set.
    -> a          -- ^ Value to set the property to.
    -> SetProp
setProp = ($=)