{-|
Module      : Css.Internal
Description : Semi-public functions for the css-simple library
Copyright   : (c) Alexey Seledkov, 2022
License     : GPL-3
Maintainer  : qyutou@gmail.com
Stability   : experimental
Portability : portable
-}

{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeFamilies               #-}

module Css.Internal
    ( -- * Types
      Rule(..)
    , Css(..)
      -- * Rendering
    , Config(..)
    , pretty
    , compact
    , renderRule
    , renderRuleWith
    , renderRuleWith'
    , renderCss
    , renderCssWith
    , putCss
    , putCssWith
    , renderCssToFile
    , renderCssToFileWith
      -- * eDSL
    , (?)
    , rule
    , (|>)
    , declaration
      -- * Utility
    , getRules
    ) where

import           Control.Monad.Writer (MonadWriter, Writer, listen, pass,
                                       runWriter, tell)
import           Data.String          (IsString (fromString))
import           Data.Text            (Text)
import qualified Data.Text            as T
import qualified Data.Text.IO         as TIO
import           Text.Builder         (Builder, run, text)

-- * Types

-- | AST-like CSS Rule representation
data Rule
    -- | Rule: selector, inner rules/declarations, next
    = Rule !Text !Rule !Rule
    -- | Declaration: property, value, next
    | Declaration !Text !Text !Rule
    -- | Leaf: text
    -- This is used to allow creating the declarations without using of
    -- functions
    | Leaf !Text
    -- | Empty
    | Empty

-- | Semigroup instance for CSS Rule
instance Semigroup Rule where
    Rule Text
selector Rule
inner Rule
next <> :: Rule -> Rule -> Rule
<> Rule
a =
        Text -> Rule -> Rule -> Rule
Rule Text
selector Rule
inner (Rule
next Rule -> Rule -> Rule
forall a. Semigroup a => a -> a -> a
<> Rule
a)
    Declaration Text
property Text
value Rule
next <> Rule
a =
        Text -> Text -> Rule -> Rule
Declaration Text
property Text
value (Rule
next Rule -> Rule -> Rule
forall a. Semigroup a => a -> a -> a
<> Rule
a)
    Rule
_ <> Rule
a = Rule
a

-- | Monoid instance for CSS Rule
instance Monoid Rule where
    mempty :: Rule
mempty = Rule
Empty

-- | Show instance for the CSS Rule
instance Show Rule where
    show :: Rule -> String
show = Text -> String
T.unpack (Text -> String) -> (Rule -> Text) -> Rule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> Text
renderRule

-- | Css monad - newtype wrapper around Control.Monad.Writer.Writer monad
newtype Css a = Css
    { forall a. Css a -> Writer Rule a
runCss :: Writer Rule a }
    deriving ((forall a b. (a -> b) -> Css a -> Css b)
-> (forall a b. a -> Css b -> Css a) -> Functor Css
forall a b. a -> Css b -> Css a
forall a b. (a -> b) -> Css a -> Css b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Css b -> Css a
$c<$ :: forall a b. a -> Css b -> Css a
fmap :: forall a b. (a -> b) -> Css a -> Css b
$cfmap :: forall a b. (a -> b) -> Css a -> Css b
Functor, Functor Css
Functor Css
-> (forall a. a -> Css a)
-> (forall a b. Css (a -> b) -> Css a -> Css b)
-> (forall a b c. (a -> b -> c) -> Css a -> Css b -> Css c)
-> (forall a b. Css a -> Css b -> Css b)
-> (forall a b. Css a -> Css b -> Css a)
-> Applicative Css
forall a. a -> Css a
forall a b. Css a -> Css b -> Css a
forall a b. Css a -> Css b -> Css b
forall a b. Css (a -> b) -> Css a -> Css b
forall a b c. (a -> b -> c) -> Css a -> Css b -> Css c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Css a -> Css b -> Css a
$c<* :: forall a b. Css a -> Css b -> Css a
*> :: forall a b. Css a -> Css b -> Css b
$c*> :: forall a b. Css a -> Css b -> Css b
liftA2 :: forall a b c. (a -> b -> c) -> Css a -> Css b -> Css c
$cliftA2 :: forall a b c. (a -> b -> c) -> Css a -> Css b -> Css c
<*> :: forall a b. Css (a -> b) -> Css a -> Css b
$c<*> :: forall a b. Css (a -> b) -> Css a -> Css b
pure :: forall a. a -> Css a
$cpure :: forall a. a -> Css a
Applicative, Applicative Css
Applicative Css
-> (forall a b. Css a -> (a -> Css b) -> Css b)
-> (forall a b. Css a -> Css b -> Css b)
-> (forall a. a -> Css a)
-> Monad Css
forall a. a -> Css a
forall a b. Css a -> Css b -> Css b
forall a b. Css a -> (a -> Css b) -> Css b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Css a
$creturn :: forall a. a -> Css a
>> :: forall a b. Css a -> Css b -> Css b
$c>> :: forall a b. Css a -> Css b -> Css b
>>= :: forall a b. Css a -> (a -> Css b) -> Css b
$c>>= :: forall a b. Css a -> (a -> Css b) -> Css b
Monad)

-- | MonadWriter instance for the Css monad
instance MonadWriter Rule Css where
    tell :: Rule -> Css ()
tell = Writer Rule () -> Css ()
forall a. Writer Rule a -> Css a
Css (Writer Rule () -> Css ())
-> (Rule -> Writer Rule ()) -> Rule -> Css ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> Writer Rule ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: forall a. Css a -> Css (a, Rule)
listen = Writer Rule (a, Rule) -> Css (a, Rule)
forall a. Writer Rule a -> Css a
Css (Writer Rule (a, Rule) -> Css (a, Rule))
-> (Css a -> Writer Rule (a, Rule)) -> Css a -> Css (a, Rule)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT Rule Identity a -> Writer Rule (a, Rule)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (WriterT Rule Identity a -> Writer Rule (a, Rule))
-> (Css a -> WriterT Rule Identity a)
-> Css a
-> Writer Rule (a, Rule)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css a -> WriterT Rule Identity a
forall a. Css a -> Writer Rule a
runCss
    pass :: forall a. Css (a, Rule -> Rule) -> Css a
pass = Writer Rule a -> Css a
forall a. Writer Rule a -> Css a
Css (Writer Rule a -> Css a)
-> (Css (a, Rule -> Rule) -> Writer Rule a)
-> Css (a, Rule -> Rule)
-> Css a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT Rule Identity (a, Rule -> Rule) -> Writer Rule a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (WriterT Rule Identity (a, Rule -> Rule) -> Writer Rule a)
-> (Css (a, Rule -> Rule)
    -> WriterT Rule Identity (a, Rule -> Rule))
-> Css (a, Rule -> Rule)
-> Writer Rule a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css (a, Rule -> Rule) -> WriterT Rule Identity (a, Rule -> Rule)
forall a. Css a -> Writer Rule a
runCss

-- | Semigroup instance for the Css monad
instance Semigroup (Css ()) where
    Css ()
css <> :: Css () -> Css () -> Css ()
<> Css ()
a = Rule -> Css ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Rule -> Css ()) -> Rule -> Css ()
forall a b. (a -> b) -> a -> b
$ Css () -> Rule
getRules Css ()
css Rule -> Rule -> Rule
forall a. Semigroup a => a -> a -> a
<> Css () -> Rule
getRules Css ()
a

-- | Monoid instance for the Css monad
instance Monoid (Css ()) where
    mempty :: Css ()
mempty = Rule -> Css ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Rule
Empty

-- | IsString instance used to allow the creation of declarations
-- NOTE: This is only for creating the Declarations, it doesn't do anything
-- else.
instance IsString (Css ()) where
    fromString :: String -> Css ()
    fromString :: String -> Css ()
fromString = Rule -> Css ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Rule -> Css ()) -> (String -> Rule) -> String -> Css ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Rule
Leaf (Text -> Rule) -> (String -> Text) -> String -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    {-# INLINE fromString #-}

-- | IsString instance used to create the rules
instance (a ~ Css (), b ~ Css ()) => IsString (a -> b) where
    fromString :: String -> Css () -> Css ()
    fromString :: String -> Css () -> Css ()
fromString String
strSelector Css ()
css = case Css () -> Rule
getRules Css ()
css of
        Leaf Text
txt -> Text -> Text -> Css ()
declaration (String -> Text
T.pack String
strSelector) Text
txt
        Rule
inner    -> Text -> Css () -> Css ()
rule (String -> Text
T.pack String
strSelector) (Rule -> Css ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Rule
inner)
    {-# INLINE fromString #-}

-- | Show instance for the Css monad
instance Show (Css ()) where
    show :: Css () -> String
show = Text -> String
T.unpack (Text -> String) -> (Css () -> Text) -> Css () -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css () -> Text
renderCss

-- * eDSL

-- | Create new rule
--
-- ==== __Examples__
--
-- >>> rule "body" (background "#000000") <> rule ".wrapper" (width "90vw" <> maxWidth "72rem")
-- body {
--     background: #000000;
-- }
-- .wrapper {
--     width: 90vw;
--     max-width: 72rem;
-- }
rule
    :: Text   -- ^ Selector
    -> Css () -- ^ Inner Css
    -> Css () -- ^ Return in Css Monad
rule :: Text -> Css () -> Css ()
rule Text
selector Css ()
inner =
    Rule -> Css ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Rule -> Css ()) -> Rule -> Css ()
forall a b. (a -> b) -> a -> b
$ Text -> Rule -> Rule -> Rule
Rule Text
selector (Css () -> Rule
getRules Css ()
inner) Rule
forall a. Monoid a => a
mempty
{-# INLINE rule #-}

-- | Infix version of 'rule'
(?)
    :: Text   -- ^ Selector
    -> Css () -- ^ Inner Css
    -> Css () -- ^ Return in Css Monad
? :: Text -> Css () -> Css ()
(?) = Text -> Css () -> Css ()
rule
{-# INLINE (?) #-}

-- | Create new declaration
--
-- ==== __Examples__
--
-- >>> declaration "width" "90vw"
-- width: 90vw;
declaration
    :: Text   -- ^ Property
    -> Text   -- ^ Value
    -> Css () -- ^ Return in Css Monad
declaration :: Text -> Text -> Css ()
declaration Text
property Text
value =
    Rule -> Css ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Rule -> Css ()) -> Rule -> Css ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Rule -> Rule
Declaration Text
property Text
value Rule
forall a. Monoid a => a
mempty
{-# INLINE declaration #-}

-- | Infix version of 'declaration'
(|>)
    :: Text   -- ^ Property
    -> Text   -- ^ Value
    -> Css () -- ^ Return in Css Monad
|> :: Text -> Text -> Css ()
(|>) = Text -> Text -> Css ()
declaration
{-# INLINE (|>) #-}

-- * Rendering

-- | Rendering configuration
data Config = Config
    { Config -> Text
_newline :: !Text -- ^ Newline symbol
    , Config -> Text
_indent  :: !Text -- ^ Indentation
    , Config -> Text
_spacing :: !Text -- ^ Small spacing
    }

-- | Pretty render configuration
pretty :: Config
pretty :: Config
pretty = Text -> Text -> Text -> Config
Config Text
"\n" Text
"  " Text
" "

-- | Compact render configuration
compact :: Config
compact :: Config
compact = Text -> Text -> Text -> Config
Config Text
"" Text
"" Text
""

-- | Used to render the Css Rules with pretty config
renderRule
    :: Rule -- ^ Rule to render
    -> Text -- ^ Return as a Text
renderRule :: Rule -> Text
renderRule = (Rule -> Config -> Text
`renderRuleWith` Config
pretty)

-- | Render the Css Rules with certain configuration
renderRuleWith
    :: Rule   -- ^ Rule to render
    -> Config -- ^ Rendering configuration
    -> Text   -- ^ Return as a Text
renderRuleWith :: Rule -> Config -> Text
renderRuleWith Rule
rule Config
config =
    Builder -> Text
run (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Rule -> Config -> Builder -> Builder
renderRuleWith' Rule
rule Config
config Builder
""

-- | Helper function for render rules
-- Actually this is the main rendering functions, while the rest of the
-- functions are something like front-end
renderRuleWith'
    :: Rule    -- ^ Rule to render
    -> Config  -- ^ Rendering configuration
    -> Builder -- ^ Prefix
    -> Builder -- ^ Return as a Builder
renderRuleWith' :: Rule -> Config -> Builder -> Builder
renderRuleWith' (Rule Text
selector Rule
inner Rule
Empty) Config
config Builder
prefix =
    Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text Text
selector Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_spacing) Config
config Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"{"
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_newline) Config
config
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Rule -> Config -> Builder -> Builder
renderRuleWith' Rule
inner Config
config (Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_indent) Config
config)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_newline) Config
config Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
renderRuleWith' (Rule Text
selector Rule
inner Rule
next) Config
config Builder
prefix =
    Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text Text
selector Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_spacing) Config
config Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"{"
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_newline) Config
config
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Rule -> Config -> Builder -> Builder
renderRuleWith' Rule
inner Config
config (Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_indent) Config
config)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_newline) Config
config Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_newline) Config
config
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Rule -> Config -> Builder -> Builder
renderRuleWith' Rule
next Config
config Builder
prefix
renderRuleWith' (Declaration Text
property Text
value Rule
Empty) Config
config Builder
prefix =
    Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text Text
property Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_spacing) Config
config Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text Text
value
renderRuleWith' (Declaration Text
property Text
value Rule
next) Config
config Builder
prefix =
    Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text Text
property Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_spacing) Config
config Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text Text
value
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
text (Text -> Builder) -> (Config -> Text) -> Config -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Text
_newline) Config
config
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Rule -> Config -> Builder -> Builder
renderRuleWith' Rule
next Config
config Builder
prefix
renderRuleWith' Rule
_ Config
_ Builder
_ = Builder
""

-- | Render the Css Monad with pretty config as Text
renderCss
    :: Css () -- ^ Css to render
    -> Text   -- ^ Return as a Text
renderCss :: Css () -> Text
renderCss = Rule -> Text
renderRule (Rule -> Text) -> (Css () -> Rule) -> Css () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css () -> Rule
getRules

-- | Render the Css Monad and print it to stdout
putCss
    :: Css () -- ^ Css to render
    -> IO ()  -- ^ Print to stdoup
putCss :: Css () -> IO ()
putCss = Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (Css () -> Text) -> Css () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> Text
renderRule (Rule -> Text) -> (Css () -> Rule) -> Css () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css () -> Rule
getRules

-- | Render the Css Monad and save it to the filePath
renderCssToFile
    :: Css ()   -- ^ Css to render
    -> FilePath -- ^ Path/to/file
    -> IO ()    -- ^ Save the rendered Css to the file path
renderCssToFile :: Css () -> String -> IO ()
renderCssToFile Css ()
css String
filePath =
    String -> Text -> IO ()
TIO.writeFile String
filePath (Text -> IO ()) -> (Css () -> Text) -> Css () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> Text
renderRule (Rule -> Text) -> (Css () -> Rule) -> Css () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css () -> Rule
getRules (Css () -> IO ()) -> Css () -> IO ()
forall a b. (a -> b) -> a -> b
$ Css ()
css

-- | Render the Css Monad with certain config as Text
renderCssWith
    :: Css () -- ^ Css to render
    -> Config -- ^ Configuration
    -> Text   -- ^ Return as a Text
renderCssWith :: Css () -> Config -> Text
renderCssWith = Rule -> Config -> Text
renderRuleWith (Rule -> Config -> Text)
-> (Css () -> Rule) -> Css () -> Config -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css () -> Rule
getRules

-- | Render the CSS with certain configuration and print it to stdout
putCssWith
    :: Css () -- ^ Css to render
    -> Config -- ^ Configuration
    -> IO ()  -- ^ Print to stdout
putCssWith :: Css () -> Config -> IO ()
putCssWith Css ()
css Config
config = Text -> IO ()
TIO.putStrLn (Rule -> Config -> Text
renderRuleWith (Css () -> Rule
getRules Css ()
css) Config
config)

-- | Render the Css Monad with certain config and save it to the filepath
renderCssToFileWith
    :: Css ()   -- ^ Css to render
    -> Config   -- ^ Configuration
    -> FilePath -- ^ Path/to/file
    -> IO ()    -- ^ Save the Css to the file
renderCssToFileWith :: Css () -> Config -> String -> IO ()
renderCssToFileWith Css ()
css Config
config String
filePath =
    String -> Text -> IO ()
TIO.writeFile String
filePath (Rule -> Config -> Text
renderRuleWith (Css () -> Rule
getRules Css ()
css) Config
config)

-- * Utility

-- | Utility function to extract the Css Rule from Css Monad
getRules :: Css () -> Rule
getRules :: Css () -> Rule
getRules = ((), Rule) -> Rule
forall a b. (a, b) -> b
snd (((), Rule) -> Rule) -> (Css () -> ((), Rule)) -> Css () -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer Rule () -> ((), Rule)
forall w a. Writer w a -> (a, w)
runWriter (Writer Rule () -> ((), Rule))
-> (Css () -> Writer Rule ()) -> Css () -> ((), Rule)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Css () -> Writer Rule ()
forall a. Css a -> Writer Rule a
runCss
{-# INLINE getRules #-}