{-# LANGUAGE OverloadedStrings #-}
module Clay.Render
( Config (..)
, pretty
, compact
, render
, htmlInline
, putCss
, renderWith
, renderSelector
, withBanner
)
where

import           Control.Applicative
import           Control.Monad.Writer
import           Data.List              (sort)
import           Data.Maybe
import           Data.Text              (Text, pack)
import           Data.Text.Lazy.Builder
import           Prelude                hiding ((**))

import qualified Data.Text              as Text
import qualified Data.Text.Lazy         as Lazy
import qualified Data.Text.Lazy.IO      as Lazy

import           Clay.Common            (browsers)
import           Clay.Property
import           Clay.Selector
import           Clay.Stylesheet        hiding (Child, query, rule)

import qualified Clay.Stylesheet        as Rule


data Config = Config
  { Config -> Builder
indentation    :: Builder
  , Config -> Builder
newline        :: Builder
  , Config -> Builder
sep            :: Builder
  , Config -> Builder
lbrace         :: Builder
  , Config -> Builder
rbrace         :: Builder
  , Config -> Bool
finalSemicolon :: Bool
  , Config -> Bool
warn           :: Bool
  , Config -> Bool
align          :: Bool
  , Config -> Bool
banner         :: Bool
  , Config -> Bool
comments       :: Bool
  }

-- | Configuration to print to a pretty human readable CSS output.

pretty :: Config
pretty :: Config
pretty = Config :: Builder
-> Builder
-> Builder
-> Builder
-> Builder
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Config
Config
  { indentation :: Builder
indentation    = Builder
"  "
  , newline :: Builder
newline        = Builder
"\n"
  , sep :: Builder
sep            = Builder
" "
  , lbrace :: Builder
lbrace         = Builder
"{"
  , rbrace :: Builder
rbrace         = Builder
"}"
  , finalSemicolon :: Bool
finalSemicolon = Bool
True
  , warn :: Bool
warn           = Bool
True
  , align :: Bool
align          = Bool
True
  , banner :: Bool
banner         = Bool
True
  , comments :: Bool
comments       = Bool
True
  }

-- | Configuration to print to a compacted unreadable CSS output.

compact :: Config
compact :: Config
compact = Config :: Builder
-> Builder
-> Builder
-> Builder
-> Builder
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Config
Config
  { indentation :: Builder
indentation    = Builder
""
  , newline :: Builder
newline        = Builder
""
  , sep :: Builder
sep            = Builder
""
  , lbrace :: Builder
lbrace         = Builder
"{"
  , rbrace :: Builder
rbrace         = Builder
"}"
  , finalSemicolon :: Bool
finalSemicolon = Bool
False
  , warn :: Bool
warn           = Bool
False
  , align :: Bool
align          = Bool
False
  , banner :: Bool
banner         = Bool
False
  , comments :: Bool
comments       = Bool
False
  }

-- | Configuration to print to a compacted unreadable CSS output for embedding inline with HTML.

htmlInline :: Config
htmlInline :: Config
htmlInline = Config :: Builder
-> Builder
-> Builder
-> Builder
-> Builder
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Config
Config
  { indentation :: Builder
indentation    = Builder
""
  , newline :: Builder
newline        = Builder
""
  , sep :: Builder
sep            = Builder
""
  , lbrace :: Builder
lbrace         = Builder
""
  , rbrace :: Builder
rbrace         = Builder
""
  , finalSemicolon :: Bool
finalSemicolon = Bool
False
  , warn :: Bool
warn           = Bool
False
  , align :: Bool
align          = Bool
False
  , banner :: Bool
banner         = Bool
False
  , comments :: Bool
comments       = Bool
False
  }

-- | Render to CSS using the default configuration (`pretty`) and directly
-- print to the standard output.

putCss :: Css -> IO ()
putCss :: Css -> IO ()
putCss = Text -> IO ()
Lazy.putStr (Text -> IO ()) -> (Css -> Text) -> Css -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> Text
render

-- | Render a stylesheet with the default configuration. The pretty printer is
-- used by default.

render :: Css -> Lazy.Text
render :: Css -> Text
render = Config -> [App] -> Css -> Text
renderWith Config
pretty []

-- | Render a stylesheet with a custom configuration and an optional outer
-- scope.

renderWith :: Config -> [App] -> Css -> Lazy.Text
renderWith :: Config -> [App] -> Css -> Text
renderWith Config
cfg [App]
top
  = Config -> Text -> Text
renderBanner Config
cfg
  (Text -> Text) -> (Css -> Text) -> Css -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
  (Builder -> Text) -> (Css -> Builder) -> Css -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [App] -> [Rule] -> Builder
rules Config
cfg [App]
top
  ([Rule] -> Builder) -> (Css -> [Rule]) -> Css -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css -> [Rule]
runS

-- | Render a single CSS `Selector`.

renderSelector :: Selector -> Lazy.Text
renderSelector :: Selector -> Text
renderSelector = Builder -> Text
toLazyText (Builder -> Text) -> (Selector -> Builder) -> Selector -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Selector -> Builder
selector Config
compact

-------------------------------------------------------------------------------

renderBanner :: Config -> Lazy.Text -> Lazy.Text
renderBanner :: Config -> Text -> Text
renderBanner Config
cfg
  | Config -> Bool
banner Config
cfg = Text -> Text
withBanner
  | Bool
otherwise  = Text -> Text
forall a. a -> a
id

withBanner :: Lazy.Text -> Lazy.Text
withBanner :: Text -> Text
withBanner = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n/* Generated with Clay, http://fvisser.nl/clay */")

kframe :: Config -> Keyframes -> Builder
kframe :: Config -> Keyframes -> Builder
kframe Config
cfg (Keyframes Text
ident [(Double, [Rule])]
xs) =
  ((Text, Text) -> Builder) -> [(Text, Text)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
    ( \(Text
browser, Text
_) ->
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
"@" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
browser Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"keyframes "
              , Text -> Builder
fromText Text
ident
              , Config -> Builder
newline Config
cfg
              , Config -> Builder
lbrace Config
cfg
              , Config -> Builder
newline Config
cfg
              , ((Double, [Rule]) -> Builder) -> [(Double, [Rule])] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Config -> (Double, [Rule]) -> Builder
frame Config
cfg) [(Double, [Rule])]
xs
              , Config -> Builder
rbrace Config
cfg
              , Config -> Builder
newline Config
cfg
              , Config -> Builder
newline Config
cfg
              ]
    )
    (Prefixed -> [(Text, Text)]
unPrefixed Prefixed
browsers)

frame :: Config -> (Double, [Rule]) -> Builder
frame :: Config -> (Double, [Rule]) -> Builder
frame Config
cfg (Double
p, [Rule]
rs) =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ Text -> Builder
fromText (String -> Text
pack (Double -> String
forall a. Show a => a -> String
show Double
p))
    , Builder
"% "
    , Config -> [App] -> [Rule] -> Builder
rules Config
cfg [] [Rule]
rs
    ]

query :: Config -> MediaQuery -> [App] -> [Rule] -> Builder
query :: Config -> MediaQuery -> [App] -> [Rule] -> Builder
query Config
cfg MediaQuery
q [App]
sel [Rule]
rs =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ MediaQuery -> Builder
mediaQuery MediaQuery
q
    , Config -> Builder
newline Config
cfg
    , Config -> Builder
lbrace Config
cfg
    , Config -> Builder
newline Config
cfg
    , Config -> [App] -> [Rule] -> Builder
rules Config
cfg [App]
sel [Rule]
rs
    , Config -> Builder
rbrace Config
cfg
    , Config -> Builder
newline Config
cfg
    ]

mediaQuery :: MediaQuery -> Builder
mediaQuery :: MediaQuery -> Builder
mediaQuery (MediaQuery Maybe NotOrOnly
no MediaType
ty [Feature]
fs) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [ Builder
"@media "
  , case Maybe NotOrOnly
no of
      Maybe NotOrOnly
Nothing   -> Builder
""
      Just NotOrOnly
Not  -> Builder
"not "
      Just NotOrOnly
Only -> Builder
"only "
  , MediaType -> Builder
mediaType MediaType
ty
  , [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Builder
" and " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Feature -> Builder) -> Feature -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> Builder
feature (Feature -> Builder) -> [Feature] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Feature]
fs)
  ]

mediaType :: MediaType -> Builder
mediaType :: MediaType -> Builder
mediaType (MediaType (Value Prefixed
v)) = Text -> Builder
fromText (Prefixed -> Text
plain Prefixed
v)

feature :: Feature -> Builder
feature :: Feature -> Builder
feature (Feature Text
k Maybe Value
mv) =
  case Maybe Value
mv of
    Maybe Value
Nothing        -> Text -> Builder
fromText Text
k
    Just (Value Prefixed
v) -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ Builder
"(" , Text -> Builder
fromText Text
k , Builder
": " , Text -> Builder
fromText (Prefixed -> Text
plain Prefixed
v) , Builder
")" ]

face :: Config -> [Rule] -> Builder
face :: Config -> [Rule] -> Builder
face Config
cfg [Rule]
rs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [ Builder
"@font-face"
  , Config -> [App] -> [Rule] -> Builder
rules Config
cfg [] [Rule]
rs
  ]

rules :: Config -> [App] -> [Rule] -> Builder
rules :: Config -> [App] -> [Rule] -> Builder
rules Config
cfg [App]
sel [Rule]
rs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [ Config -> [App] -> [KeyVal] -> Builder
rule Config
cfg [App]
sel ((Rule -> Maybe KeyVal) -> [Rule] -> [KeyVal]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Rule -> Maybe KeyVal
property [Rule]
rs)
  , Config -> Builder
newline Config
cfg
  ,             Config -> Text -> Builder
imp    Config
cfg              (Text -> Builder) -> [Text] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
`foldMap` (Rule -> Maybe Text) -> [Rule] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Rule -> Maybe Text
imports [Rule]
rs
  ,             Config -> Keyframes -> Builder
kframe Config
cfg              (Keyframes -> Builder) -> [Keyframes] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
`foldMap` (Rule -> Maybe Keyframes) -> [Rule] -> [Keyframes]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Rule -> Maybe Keyframes
kframes [Rule]
rs
  ,             Config -> [Rule] -> Builder
face   Config
cfg              ([Rule] -> Builder) -> [[Rule]] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
`foldMap` (Rule -> Maybe [Rule]) -> [Rule] -> [[Rule]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Rule -> Maybe [Rule]
faces   [Rule]
rs
  , (\(App
a, [Rule]
b) -> Config -> [App] -> [Rule] -> Builder
rules  Config
cfg (App
a App -> [App] -> [App]
forall a. a -> [a] -> [a]
: [App]
sel) [Rule]
b) ((App, [Rule]) -> Builder) -> [(App, [Rule])] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
`foldMap` (Rule -> Maybe (App, [Rule])) -> [Rule] -> [(App, [Rule])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Rule -> Maybe (App, [Rule])
nested  [Rule]
rs
  , (\(MediaQuery
a, [Rule]
b) -> Config -> MediaQuery -> [App] -> [Rule] -> Builder
query  Config
cfg  MediaQuery
a   [App]
sel  [Rule]
b) ((MediaQuery, [Rule]) -> Builder)
-> [(MediaQuery, [Rule])] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
`foldMap` (Rule -> Maybe (MediaQuery, [Rule]))
-> [Rule] -> [(MediaQuery, [Rule])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Rule -> Maybe (MediaQuery, [Rule])
queries [Rule]
rs
  ]
  where property :: Rule -> Maybe KeyVal
property (Property [Modifier]
m Key ()
k Value
v) = KeyVal -> Maybe KeyVal
forall a. a -> Maybe a
Just ([Modifier]
m, Key ()
k, Value
v)
        property Rule
_                = Maybe KeyVal
forall a. Maybe a
Nothing
        nested :: Rule -> Maybe (App, [Rule])
nested   (Nested App
a [Rule]
ns   ) = (App, [Rule]) -> Maybe (App, [Rule])
forall a. a -> Maybe a
Just (App
a, [Rule]
ns)
        nested   Rule
_                = Maybe (App, [Rule])
forall a. Maybe a
Nothing
        queries :: Rule -> Maybe (MediaQuery, [Rule])
queries  (Query MediaQuery
q [Rule]
ns    ) = (MediaQuery, [Rule]) -> Maybe (MediaQuery, [Rule])
forall a. a -> Maybe a
Just (MediaQuery
q, [Rule]
ns)
        queries  Rule
_                = Maybe (MediaQuery, [Rule])
forall a. Maybe a
Nothing
        kframes :: Rule -> Maybe Keyframes
kframes  (Keyframe Keyframes
fs   ) = Keyframes -> Maybe Keyframes
forall a. a -> Maybe a
Just Keyframes
fs;
        kframes  Rule
_                = Maybe Keyframes
forall a. Maybe a
Nothing
        faces :: Rule -> Maybe [Rule]
faces    (Face [Rule]
ns       ) = [Rule] -> Maybe [Rule]
forall a. a -> Maybe a
Just [Rule]
ns
        faces    Rule
_                = Maybe [Rule]
forall a. Maybe a
Nothing
        imports :: Rule -> Maybe Text
imports  (Import Text
i      ) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
        imports  Rule
_                = Maybe Text
forall a. Maybe a
Nothing

imp :: Config -> Text -> Builder
imp :: Config -> Text -> Builder
imp Config
cfg Text
t =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ Builder
"@import url("
    , Text -> Builder
fromText Text
t
    , Builder
");"
    , Config -> Builder
newline Config
cfg ]

-- | A key-value pair with associated comment.
type KeyVal = ([Modifier], Key (), Value)

rule :: Config -> [App] -> [KeyVal] -> Builder
rule :: Config -> [App] -> [KeyVal] -> Builder
rule Config
_   [App]
_   []    = Builder
forall a. Monoid a => a
mempty
rule Config
cfg [App]
sel [KeyVal]
props =
  let xs :: [Representation]
xs = KeyVal -> [Representation]
collect (KeyVal -> [Representation]) -> [KeyVal] -> [Representation]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [KeyVal]
props
   in [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ Config -> Selector -> Builder
selector Config
cfg ([App] -> Selector
merger [App]
sel)
      , Config -> Builder
newline Config
cfg
      , Config -> Builder
lbrace Config
cfg
      , Config -> Builder
newline Config
cfg
      , Config -> [Representation] -> Builder
properties Config
cfg [Representation]
xs
      , Config -> Builder
rbrace Config
cfg
      , Config -> Builder
newline Config
cfg
      ]

merger :: [App] -> Selector
merger :: [App] -> Selector
merger []     = Selector
"" -- error "this should be fixed!"
merger (App
x:[App]
xs) =
  case App
x of
    Rule.Child Selector
s -> case [App]
xs of [] -> Selector
s; [App]
_  -> [App] -> Selector
merger [App]
xs Selector -> Selector -> Selector
|> Selector
s
    Sub        Selector
s -> case [App]
xs of [] -> Selector
s; [App]
_  -> [App] -> Selector
merger [App]
xs Selector -> Selector -> Selector
** Selector
s
    Root       Selector
s -> Selector
s Selector -> Selector -> Selector
** [App] -> Selector
merger [App]
xs
    Pop        Int
i -> [App] -> Selector
merger (Int -> [App] -> [App]
forall a. Int -> [a] -> [a]
drop Int
i (App
xApp -> [App] -> [App]
forall a. a -> [a] -> [a]
:[App]
xs))
    Self       Refinement
f -> case [App]
xs of [] -> Selector
star Selector -> Refinement -> Selector
`with` Refinement
f; [App]
_ -> [App] -> Selector
merger [App]
xs Selector -> Refinement -> Selector
`with` Refinement
f

data Representation
  = Warning Text
  | KeyValRep [Modifier] Text Text
  deriving (Int -> Representation -> ShowS
[Representation] -> ShowS
Representation -> String
(Int -> Representation -> ShowS)
-> (Representation -> String)
-> ([Representation] -> ShowS)
-> Show Representation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Representation] -> ShowS
$cshowList :: [Representation] -> ShowS
show :: Representation -> String
$cshow :: Representation -> String
showsPrec :: Int -> Representation -> ShowS
$cshowsPrec :: Int -> Representation -> ShowS
Show)

keys :: [Representation] -> [Text]
keys :: [Representation] -> [Text]
keys = (Representation -> Maybe Text) -> [Representation] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Representation -> Maybe Text
f
  where
    f :: Representation -> Maybe Text
f (KeyValRep [Modifier]
_ Text
k Text
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
k
    f Representation
_                 = Maybe Text
forall a. Maybe a
Nothing

collect :: KeyVal -> [Representation]
collect :: KeyVal -> [Representation]
collect ([Modifier]
ms, Key Prefixed
ky, Value Prefixed
vl) = case (Prefixed
ky, Prefixed
vl) of
    ( Plain    Text
k  , Plain    Text
v  ) -> [Text -> Text -> Representation
prop Text
k Text
v]
    ( Prefixed [(Text, Text)]
ks , Plain    Text
v  ) -> (((Text, Text) -> Representation)
 -> [(Text, Text)] -> [Representation])
-> [(Text, Text)]
-> ((Text, Text) -> Representation)
-> [Representation]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, Text) -> Representation)
-> [(Text, Text)] -> [Representation]
forall a b. (a -> b) -> [a] -> [b]
map [(Text, Text)]
ks (((Text, Text) -> Representation) -> [Representation])
-> ((Text, Text) -> Representation) -> [Representation]
forall a b. (a -> b) -> a -> b
$ \(Text
p, Text
k) -> Text -> Text -> Representation
prop (Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k) Text
v
    ( Plain    Text
k  , Prefixed [(Text, Text)]
vs ) -> (((Text, Text) -> Representation)
 -> [(Text, Text)] -> [Representation])
-> [(Text, Text)]
-> ((Text, Text) -> Representation)
-> [Representation]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, Text) -> Representation)
-> [(Text, Text)] -> [Representation]
forall a b. (a -> b) -> [a] -> [b]
map [(Text, Text)]
vs (((Text, Text) -> Representation) -> [Representation])
-> ((Text, Text) -> Representation) -> [Representation]
forall a b. (a -> b) -> a -> b
$ \(Text
p, Text
v) -> Text -> Text -> Representation
prop Text
k (Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v)
    ( Prefixed [(Text, Text)]
ks , Prefixed [(Text, Text)]
vs ) -> (((Text, Text) -> Representation)
 -> [(Text, Text)] -> [Representation])
-> [(Text, Text)]
-> ((Text, Text) -> Representation)
-> [Representation]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, Text) -> Representation)
-> [(Text, Text)] -> [Representation]
forall a b. (a -> b) -> [a] -> [b]
map [(Text, Text)]
ks (((Text, Text) -> Representation) -> [Representation])
-> ((Text, Text) -> Representation) -> [Representation]
forall a b. (a -> b) -> a -> b
$ \(Text
p, Text
k) -> (Text -> Representation
Warning (Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k) Representation
-> (Text -> Representation) -> Maybe Text -> Representation
forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` (Text -> Text -> Representation
prop (Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k) (Text -> Representation)
-> (Text -> Text) -> Text -> Representation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
p)) (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
p [(Text, Text)]
vs)
  where prop :: Text -> Text -> Representation
prop Text
k Text
v = [Modifier] -> Text -> Text -> Representation
KeyValRep [Modifier]
ms Text
k Text
v

properties :: Config -> [Representation] -> Builder
properties :: Config -> [Representation] -> Builder
properties Config
cfg [Representation]
xs =
  let width :: Int
width     = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Text -> Int
Text.length (Text -> Int) -> [Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Representation] -> [Text]
keys [Representation]
xs)
      ind :: Builder
ind       = Config -> Builder
indentation Config
cfg
      new :: Builder
new       = Config -> Builder
newline Config
cfg
      finalSemi :: Builder
finalSemi = if Config -> Bool
finalSemicolon Config
cfg then Builder
";" else Builder
""
   in (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
new) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
finalSemi) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> Builder
forall a. Monoid a => a -> [a] -> a
intercalate (Builder
";" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
new) ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ ((Representation -> Builder) -> [Representation] -> [Builder])
-> [Representation] -> (Representation -> Builder) -> [Builder]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Representation -> Builder) -> [Representation] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map [Representation]
xs ((Representation -> Builder) -> [Builder])
-> (Representation -> Builder) -> [Builder]
forall a b. (a -> b) -> a -> b
$ \Representation
p ->
        case Representation
p of
          Warning Text
w -> if Config -> Bool
warn Config
cfg
                    then Builder
ind Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"/* no value for " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" */" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
new
                    else Builder
forall a. Monoid a => a
mempty
          KeyValRep [Modifier]
ms Text
k Text
v ->
            let pad :: Builder
pad = if Config -> Bool
align Config
cfg
                      then Text -> Builder
fromText (Int -> Text -> Text
Text.replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
k) Text
" ")
                      else Builder
""
                imptant :: Builder
imptant = Builder -> (Text -> Builder) -> Maybe Text -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" ((Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
fromText) (Maybe Text -> Builder)
-> ([Modifier] -> Maybe Text) -> [Modifier] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modifier -> Maybe Text) -> [Modifier] -> Maybe Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Modifier -> Maybe Text
_Important ([Modifier] -> Builder) -> [Modifier] -> Builder
forall a b. (a -> b) -> a -> b
$ [Modifier]
ms
                comm :: Builder
comm = case ((Modifier -> Maybe CommentText) -> [Modifier] -> Maybe CommentText
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Modifier -> Maybe CommentText
_Comment [Modifier]
ms, Config -> Bool
comments Config
cfg) of
                  (Just CommentText
c, Bool
True) -> Builder
" /* " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (CommentText -> Text
unCommentText CommentText
c) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" */"
                  (Maybe CommentText, Bool)
_              -> Builder
forall a. Monoid a => a
mempty
             in [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
ind, Text -> Builder
fromText Text
k, Builder
pad, Builder
":", Config -> Builder
sep Config
cfg, Text -> Builder
fromText Text
v, Builder
imptant, Builder
comm]

selector :: Config -> Selector -> Builder
selector :: Config -> Selector -> Builder
selector Config { lbrace :: Config -> Builder
lbrace = Builder
"", rbrace :: Config -> Builder
rbrace = Builder
"" } = Selector -> Builder
forall p p. IsString p => p -> p
rec
  where rec :: p -> p
rec p
_ = p
""
selector Config
cfg = Builder -> [Builder] -> Builder
forall a. Monoid a => a -> [a] -> a
intercalate (Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Config -> Builder
newline Config
cfg) ([Builder] -> Builder)
-> (Selector -> [Builder]) -> Selector -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> [Builder]
rec
  where rec :: Selector -> [Builder]
rec (In (SelectorF (Refinement [Predicate]
ft) Path Selector
p)) = (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Predicate -> Builder) -> [Predicate] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Predicate -> Builder
predicate ([Predicate] -> [Predicate]
forall a. Ord a => [a] -> [a]
sort [Predicate]
ft)) (Builder -> Builder) -> [Builder] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          case Path Selector
p of
            Path Selector
Star           -> if [Predicate] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Predicate]
ft then [Builder
"*"] else [Builder
""]
            Elem Text
t         -> [Text -> Builder
fromText Text
t]
            Child      Selector
a Selector
b -> Builder -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a -> a
ins Builder
" > " (Builder -> Builder -> Builder)
-> [Builder] -> [Builder -> Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selector -> [Builder]
rec Selector
a [Builder -> Builder] -> [Builder] -> [Builder]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> [Builder]
rec Selector
b
            Deep       Selector
a Selector
b -> Builder -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a -> a
ins Builder
" "   (Builder -> Builder -> Builder)
-> [Builder] -> [Builder -> Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selector -> [Builder]
rec Selector
a [Builder -> Builder] -> [Builder] -> [Builder]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> [Builder]
rec Selector
b
            Adjacent   Selector
a Selector
b -> Builder -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a -> a
ins Builder
" + " (Builder -> Builder -> Builder)
-> [Builder] -> [Builder -> Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selector -> [Builder]
rec Selector
a [Builder -> Builder] -> [Builder] -> [Builder]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> [Builder]
rec Selector
b
            Sibling    Selector
a Selector
b -> Builder -> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a -> a
ins Builder
" ~ " (Builder -> Builder -> Builder)
-> [Builder] -> [Builder -> Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selector -> [Builder]
rec Selector
a [Builder -> Builder] -> [Builder] -> [Builder]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> [Builder]
rec Selector
b
            Combined   Selector
a Selector
b -> Selector -> [Builder]
rec Selector
a [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ Selector -> [Builder]
rec Selector
b
          where ins :: a -> a -> a -> a
ins a
s a
a a
b = a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b

predicate :: Predicate -> Builder
predicate :: Predicate -> Builder
predicate Predicate
ft = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
  case Predicate
ft of
    Id           Text
a   -> [ Builder
"#" , Text -> Builder
fromText Text
a                                             ]
    Class        Text
a   -> [ Builder
"." , Text -> Builder
fromText Text
a                                             ]
    Attr         Text
a   -> [ Builder
"[" , Text -> Builder
fromText Text
a,                     Builder
"]"                    ]
    AttrVal      Text
a Text
v -> [ Builder
"[" , Text -> Builder
fromText Text
a,  Builder
"='", Text -> Builder
fromText Text
v, Builder
"']"                    ]
    AttrBegins   Text
a Text
v -> [ Builder
"[" , Text -> Builder
fromText Text
a, Builder
"^='", Text -> Builder
fromText Text
v, Builder
"']"                    ]
    AttrEnds     Text
a Text
v -> [ Builder
"[" , Text -> Builder
fromText Text
a, Builder
"$='", Text -> Builder
fromText Text
v, Builder
"']"                    ]
    AttrContains Text
a Text
v -> [ Builder
"[" , Text -> Builder
fromText Text
a, Builder
"*='", Text -> Builder
fromText Text
v, Builder
"']"                    ]
    AttrSpace    Text
a Text
v -> [ Builder
"[" , Text -> Builder
fromText Text
a, Builder
"~='", Text -> Builder
fromText Text
v, Builder
"']"                    ]
    AttrHyph     Text
a Text
v -> [ Builder
"[" , Text -> Builder
fromText Text
a, Builder
"|='", Text -> Builder
fromText Text
v, Builder
"']"                    ]
    Pseudo       Text
a   -> [ Builder
":" , Text -> Builder
fromText Text
a                                             ]
    PseudoFunc   Text
a [Text]
p -> [ Builder
":" , Text -> Builder
fromText Text
a, Builder
"(", Builder -> [Builder] -> Builder
forall a. Monoid a => a -> [a] -> a
intercalate Builder
"," ((Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromText [Text]
p), Builder
")" ]
    PseudoElem   Text
a   -> [ Builder
"::", Text -> Builder
fromText Text
a                                             ]