{-# LANGUAGE OverloadedStrings #-}

module Text.Blizzard.Css
    ( css
    ) where


import Clay (Css, compact, renderWith)
import Data.String (fromString)
import Data.Text (unpack)
import Data.Text.Lazy (toStrict)
import Text.Blaze.Html5 (Attribute)
import Text.Blaze.Html5.Attributes (style)


css :: [Css] -> Attribute
css :: [Css] -> Attribute
css []     = AttributeValue -> Attribute
style AttributeValue
""
css [Css]
styles = AttributeValue -> Attribute
style (AttributeValue -> Attribute)
-> ([Css] -> AttributeValue) -> [Css] -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> ([Css] -> String) -> [Css] -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
firstLast (String -> String) -> ([Css] -> String) -> [Css] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> ([Css] -> Text) -> [Css] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict (Text -> Text) -> ([Css] -> Text) -> [Css] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [App] -> Css -> Text
renderWith Config
compact [] (Css -> Text) -> ([Css] -> Css) -> [Css] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Css -> Css -> Css) -> [Css] -> Css
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Css -> Css -> Css
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) ([Css] -> Attribute) -> [Css] -> Attribute
forall a b. (a -> b) -> a -> b
$ [Css]
styles

firstLast :: [a] -> [a]
firstLast :: [a] -> [a]
firstLast []  = []
firstLast [a
x] = []
firstLast [a]
xs  = [a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]
forall a. [a] -> [a]
init [a]
xs)