Comment.hs

{-|
Description:    Tokenization rules for characters within @\<!--@ ... @--\>@ sections.

Copyright:      (c) 2020 Sam May
License:        MPL-2.0
Maintainer:     ag.eitilt@gmail.com

Stability:      stable
Portability:    portable
-}
module Web.Mangrove.Parse.Tokenize.Comment
    ( tokenCommentStart
    , packCommentToken
    ) where


import qualified Data.Text as T

import Web.Mangrove.Parse.Common.Error
import Web.Mangrove.Parse.Tokenize.Common
import Web.Willow.Common.Encoding.Character


-- | Wrap a given span of 'Char's into the payload of a 'Comment'.
packCommentToken :: TokenizerOutput String -> TokenizerOutput Token
packCommentToken = fmap $ Comment . T.pack


-- | __HTML:__
--      @[comment start state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-start-state)@
-- 
-- The parsing instructions for after reading @"\<!--"@ in a section of the
-- state machine which allows markup declarations.
tokenCommentStart :: Tokenizer (TokenizerOutput String)
tokenCommentStart = tokenizer (Just ([EOFInComment], ""))
    [ if_ (== '-') tokenCommentStartDash
    , if_ (== '>') $ changeState DataState *> packToken ([AbruptClosingOfEmptyComment], "")
    , elsePush_ tokenComment
    ]

-- | __HTML:__
--      @[comment start dash state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-start-state)@
-- 
-- The parsing instructions for after reading @"\<!---"@ in a section of the
-- state machine which allows markup declarations.
tokenCommentStartDash :: Tokenizer (TokenizerOutput String)
tokenCommentStartDash = tokenizer (Just ([EOFInComment], ""))
    [ if_ (== '-') tokenCommentEnd
    , if_ (== '>') $ changeState DataState *> packToken ([AbruptClosingOfEmptyComment], "")
    , elsePush_ $ consOut '-' <$> tokenComment
    ]

-- | __HTML:__
--      @[comment state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-state)@
-- 
-- The parsing instructions rooted in the HTML comment section of the state
-- machine.
tokenComment :: Tokenizer (TokenizerOutput String)
tokenComment = tokenizer (Just ([EOFInComment], ""))
    [ ifChar (== '<') $ \c -> consOut c <$> tokenCommentLessThanSign
    , if_ (== '-') tokenCommentEndDash
    , if_ (== '\NUL') $ consTokenError UnexpectedNullCharacter . consOut replacementChar <$> tokenComment
    , elseChar $ \c -> consOut c <$> tokenComment
    ]

-- | __HTML:__
--      @[comment less-than sign state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-less-than-sign-state)@
-- 
-- The parsing instructions for after reading @"\<"@ in the HTML comment
-- section of the state machine.
tokenCommentLessThanSign :: Tokenizer (TokenizerOutput String)
tokenCommentLessThanSign = tokenizer (Just ([EOFInComment], ""))
    [ ifChar (== '!') $ \c -> consOut c <$> tokenCommentLessThanSignBang
    , ifChar (== '<') $ \c -> consOut c <$> tokenCommentLessThanSign
    , elsePush_ tokenComment
    ]

-- | __HTML:__
--      @[comment less-than sign bang state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-less-than-sign-bang-state)@
-- 
-- The parsing instructions for after reading @"\<!"@ in the HTML comment
-- section of the state machine.
tokenCommentLessThanSignBang :: Tokenizer (TokenizerOutput String)
tokenCommentLessThanSignBang = tokenizer (Just ([EOFInComment], ""))
    [ if_ (== '-') tokenCommentLessThanSignBangDash
    , elsePush_ tokenComment
    ]

-- | __HTML:__
--      @[comment less-than sign bang dash state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-less-than-sign-bang-dash-state)@
-- 
-- The parsing instructions for after reading @"\<!-"@ in the HTML comment
-- section of the state machine.
tokenCommentLessThanSignBangDash :: Tokenizer (TokenizerOutput String)
tokenCommentLessThanSignBangDash = tokenizer (Just ([EOFInComment], ""))
    [ if_ (== '-') tokenCommentLessThanSignBangDashDash
    , elsePush_ tokenCommentEndDash
    ]

-- | __HTML:__
--      @[comment less-than sign bang dash dash state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-less-than-sign-bang-dash-dash-state)@
-- 
-- The parsing instructions for after reading @"\<!--"@ in the HTML comment
-- section of the state machine.
tokenCommentLessThanSignBangDashDash :: Tokenizer (TokenizerOutput String)
tokenCommentLessThanSignBangDashDash = tokenizer (Just ([EOFInComment], ""))
    [ ifPush_ (== '>') tokenCommentEnd
    , elsePush_ $ consTokenError NestedComment <$> tokenCommentEnd
    ]

-- | __HTML:__
--      @[comment end dash state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-end-dash-state)@
-- 
-- The parsing instructions for after reading @"-"@ in the HTML comment section
-- of the state machine.
tokenCommentEndDash :: Tokenizer (TokenizerOutput String)
tokenCommentEndDash = tokenizer (Just ([EOFInComment], ""))
    [ if_ (== '-') tokenCommentEnd
    , elsePush_ $ consOut '-' <$> tokenComment
    ]

-- | __HTML:__
--      @[comment end state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-end-state)@
-- 
-- The parsing instructions for after reading @"--"@ in the HTML comment
-- section of the state machine.
tokenCommentEnd :: Tokenizer (TokenizerOutput String)
tokenCommentEnd = tokenizer (Just ([EOFInComment], ""))
    [ if_ (== '>') $ changeState DataState *> packToken ([], "")
    , if_ (== '!') tokenCommentEndBang
    , ifChar (== '-') $ \c -> consOut c <$> tokenCommentEnd
    , elsePush_ $ consOuts "--" <$> tokenComment
    ]

-- | __HTML:__
--      @[comment end bang state]
--      (https://html.spec.whatwg.org/multipage/parsing.html#comment-end-bang-state)@
-- 
-- The parsing instructions for after reading @"--!"@ in the HTML comment
-- section of the state machine.
tokenCommentEndBang :: Tokenizer (TokenizerOutput String)
tokenCommentEndBang = tokenizer (Just ([EOFInComment], ""))
    [ if_ (== '-') $ consOuts "--!" <$> tokenCommentEndDash
    , if_ (== '>') $ packToken ([IncorrectlyClosedComment], "")
    , elsePush_ $ consOuts "--!" <$> tokenComment
    ]