{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE OverloadedStrings #-}
module Clay.Comments where

import Data.Maybe (isNothing)
import Data.List (partition)

import Clay.Stylesheet

-- | Annotate the supplied 'Css' with the supplied comment.
-- Comments work with 'OverloadedStrings'. This will annotate every non-nested
-- value.
commenting :: CommentText -> Css -> Css
commenting :: CommentText -> Css -> Css
commenting CommentText
c Css
css = (Rule -> Css) -> [Rule] -> Css
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Rule -> Css
rule (Rule -> Css) -> (Rule -> Rule) -> Rule -> Css
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentText -> Rule -> Rule
addComment CommentText
c) ([Rule] -> Css) -> [Rule] -> Css
forall a b. (a -> b) -> a -> b
$ Css -> [Rule]
runS Css
css
infixl 3 `commenting`

-- The last case indicates there may be something wrong in the typing, as
-- it shouldn't be possible to comment a wrong rule. In practice, this implementation
-- means only the directly applied property rule is affected, i.e. no nested
-- rules. That could be changed by adding recursive cases.
addComment :: CommentText -> Rule -> Rule
addComment :: CommentText -> Rule -> Rule
addComment CommentText
c (Property (PartitionComments [Modifier]
xs (Just CommentText
cs)) Key ()
k Value
v) = let c1 :: Modifier
c1 = CommentText -> Modifier
Comment (CommentText -> Modifier) -> CommentText -> Modifier
forall a b. (a -> b) -> a -> b
$ CommentText
cs CommentText -> CommentText -> CommentText
forall a. Semigroup a => a -> a -> a
<> CommentText
"; " CommentText -> CommentText -> CommentText
forall a. Semigroup a => a -> a -> a
<> CommentText
c in
  [Modifier] -> Key () -> Value -> Rule
Property (Modifier
c1 Modifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
: [Modifier]
xs) Key ()
k Value
v
addComment CommentText
c (Property [Modifier]
ms Key ()
k Value
v  ) = [Modifier] -> Key () -> Value -> Rule
Property (CommentText -> Modifier
Comment CommentText
c Modifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
: [Modifier]
ms) Key ()
k Value
v
addComment CommentText
_ Rule
r                   = Rule
r

pattern PartitionComments :: [Modifier] -> Maybe CommentText -> [Modifier]
pattern $mPartitionComments :: forall r.
[Modifier]
-> ([Modifier] -> Maybe CommentText -> r) -> (Void# -> r) -> r
PartitionComments xs cs <- (fmap (foldMap _Comment) . partition (isNothing . _Comment) -> (xs, cs))