    {-# LANGUAGE OverloadedStrings #-}
    -- | Parse CSS with parseNestedBlocks and render it with renderNestedBlock
    module Text.CSS.Parse
        ( NestedBlock(..)
        , parseNestedBlocks
        , parseBlocks
        , parseBlock
        , attrParser
        , attrsParser
        , blockParser
        , blocksParser
        , parseAttr
        , parseAttrs
        ) where

    import Prelude hiding (takeWhile, take)
    import Data.Attoparsec.Text
    import Data.Text (Text, strip)
    import Control.Applicative ((<|>), many, (<$>))
    import Data.Char (isSpace)

    type CssBlock = (Text, [(Text, Text)])
    data NestedBlock = NestedBlock Text [NestedBlock] -- ^ for example a media query
                     | LeafBlock CssBlock
                     deriving (NestedBlock -> NestedBlock -> Bool
    (NestedBlock -> NestedBlock -> Bool)
    -> (NestedBlock -> NestedBlock -> Bool) -> Eq NestedBlock
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: NestedBlock -> NestedBlock -> Bool
    == :: NestedBlock -> NestedBlock -> Bool
    $c/= :: NestedBlock -> NestedBlock -> Bool
    /= :: NestedBlock -> NestedBlock -> Bool
    Eq, Int -> NestedBlock -> ShowS
    [NestedBlock] -> ShowS
    NestedBlock -> String
    (Int -> NestedBlock -> ShowS)
    -> (NestedBlock -> String)
    -> ([NestedBlock] -> ShowS)
    -> Show NestedBlock
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> NestedBlock -> ShowS
    showsPrec :: Int -> NestedBlock -> ShowS
    $cshow :: NestedBlock -> String
    show :: NestedBlock -> String
    $cshowList :: [NestedBlock] -> ShowS
    showList :: [NestedBlock] -> ShowS
    Show)

    -- | The preferred parser, will capture media queries
    parseNestedBlocks :: Text -> Either String [NestedBlock]
    parseNestedBlocks :: Text -> Either String [NestedBlock]
    parseNestedBlocks = Parser [NestedBlock] -> Text -> Either String [NestedBlock]
    forall a. Parser a -> Text -> Either String a
    parseOnly Parser [NestedBlock]
    nestedBlocksParser

    -- | The original parser of basic CSS, but throws out media queries
    parseBlocks :: Text -> Either String [CssBlock]
    parseBlocks :: Text -> Either String [CssBlock]
    parseBlocks = Parser [CssBlock] -> Text -> Either String [CssBlock]
    forall a. Parser a -> Text -> Either String a
    parseOnly Parser [CssBlock]
    blocksParser

    parseBlock :: Text -> Either String CssBlock
    parseBlock :: Text -> Either String CssBlock
    parseBlock = Parser CssBlock -> Text -> Either String CssBlock
    forall a. Parser a -> Text -> Either String a
    parseOnly Parser CssBlock
    blockParser

    parseAttrs :: Text -> Either String [(Text, Text)]
    parseAttrs :: Text -> Either String [(Text, Text)]
    parseAttrs = Parser [(Text, Text)] -> Text -> Either String [(Text, Text)]
    forall a. Parser a -> Text -> Either String a
    parseOnly Parser [(Text, Text)]
    attrsParser

    parseAttr :: Text -> Either String (Text, Text)
    parseAttr :: Text -> Either String (Text, Text)
    parseAttr = Parser (Text, Text) -> Text -> Either String (Text, Text)
    forall a. Parser a -> Text -> Either String a
    parseOnly Parser (Text, Text)
    attrParser

    skipWS :: Parser ()
    skipWS :: Parser ()
    skipWS = (Text -> Parser Text
    string Text
    "/*" Parser Text -> Parser () -> Parser ()
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Parser ()
    endComment Parser () -> Parser () -> Parser ()
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Parser ()
    skipWS)
         Parser () -> Parser () -> Parser ()
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ((Char -> Bool) -> Parser ()
    skip Char -> Bool
    isSpace Parser () -> Parser () -> Parser ()
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Parser ()
    skipWhile Char -> Bool
    isSpace Parser () -> Parser () -> Parser ()
    forall a b. Parser Text a -> Parser Text b -> Parser Text b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Parser ()
    skipWS)
         Parser () -> Parser () -> Parser ()
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> () -> Parser ()
    forall a. a -> Parser Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        endComment :: Parser ()
    endComment = do
            (Char -> Bool) -> Parser ()
    skipWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '*')
            (do
                _ <- Char -> Parser Char
    char Char
    '*'
                (char '/' >> return ()) <|> endComment
                ) Parser () -> Parser () -> Parser ()
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> Parser ()
    forall a. String -> Parser Text a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Missing end comment"

    attrParser :: Parser (Text, Text)
    attrParser :: Parser (Text, Text)
    attrParser = do
        Parser ()
    skipWS
        key <- (Char -> Bool) -> Parser Text
    takeWhile1 (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ':' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '{' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '}')
        _ <- char ':' <|> fail "Missing colon in attribute"
        value <- valueParser
        return (strip key, strip value)

    valueParser :: Parser Text
    valueParser :: Parser Text
    valueParser = (Char -> Bool) -> Parser Text
    takeWhile (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ';' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '}')

    attrsParser :: Parser [(Text, Text)]
    attrsParser :: Parser [(Text, Text)]
    attrsParser = (do
        a <- Parser (Text, Text)
    attrParser
        (char ';' >> skipWS >> ((a :) <$> attrsParser))
          <|> return [a]
      ) Parser [(Text, Text)]
    -> Parser [(Text, Text)] -> Parser [(Text, Text)]
    forall a. Parser Text a -> Parser Text a -> Parser Text a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> [(Text, Text)] -> Parser [(Text, Text)]
    forall a. a -> Parser Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    blockParser :: Parser (Text, [(Text, Text)])
    blockParser :: Parser CssBlock
    blockParser = do
        Parser ()
    skipWS
        sel <- (Char -> Bool) -> Parser Text
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '{')
        _ <- char '{'
        attrs <- attrsParser
        skipWS
        _ <- char '}'
        return (strip sel, attrs)

    nestedBlockParser :: Parser NestedBlock
    nestedBlockParser :: Parser NestedBlock
    nestedBlockParser = do
        Parser ()
    skipWS
        sel <- Text -> Text
    strip (Text -> Text) -> Parser Text -> Parser Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> Bool) -> Parser Text
    takeTill (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '{')
        _ <- char '{'
        skipWS

        unknown <- strip <$> takeTill (\Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '{' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '}' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ':')
        mc <- peekChar
        res <- case mc of
          Maybe Char
    Nothing -> String -> Parser NestedBlock
    forall a. String -> Parser Text a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "unexpected end of input"
          Just Char
    c -> Text -> Text -> Char -> Parser NestedBlock
    nestedParse Text
    sel Text
    unknown Char
    c

        skipWS
        _ <- char '}'
        return res
      where
        -- no colon means no content
        nestedParse :: Text -> Text -> Char -> Parser NestedBlock
    nestedParse Text
    sel Text
    _ Char
    '}' = NestedBlock -> Parser NestedBlock
    forall a. a -> Parser Text a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NestedBlock -> Parser NestedBlock)
    -> NestedBlock -> Parser NestedBlock
    forall a b. (a -> b) -> a -> b
    $ CssBlock -> NestedBlock
    LeafBlock (Text
    sel, [])

        nestedParse Text
    sel Text
    unknown Char
    ':' = do
            _ <- Char -> Parser Char
    char Char
    ':'
            value <- valueParser
            (char ';' >> return ()) <|> return ()
            skipWS
            moreAttrs <- attrsParser
            return $ LeafBlock (sel, (unknown, strip value) : moreAttrs)

        -- TODO: handle infinite nesting
        nestedParse Text
    sel Text
    unknown Char
    '{' = do
            _ <- Char -> Parser Char
    char Char
    '{'
            attrs <- attrsParser
            skipWS
            _ <- char '}'
            blocks <- blocksParser
            return $ NestedBlock sel $ map LeafBlock $ (unknown, attrs) : blocks
        nestedParse Text
    _ Text
    _ Char
    c = String -> Parser NestedBlock
    forall a. String -> Parser Text a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Parser NestedBlock) -> String -> Parser NestedBlock
    forall a b. (a -> b) -> a -> b
    $ String
    "expected { or : but got " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char
    c]

    blocksParser :: Parser [(Text, [(Text, Text)])]
    blocksParser :: Parser [CssBlock]
    blocksParser = Parser CssBlock -> Parser [CssBlock]
    forall a. Parser Text a -> Parser Text [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Parser CssBlock
    blockParser

    nestedBlocksParser :: Parser [NestedBlock]
    nestedBlocksParser :: Parser [NestedBlock]
    nestedBlocksParser = Parser NestedBlock -> Parser [NestedBlock]
    forall a. Parser Text a -> Parser Text [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Parser NestedBlock
    nestedBlockParser