hw-xml-0.4.0.2: src/HaskellWorks/Data/Xml/Internal/Blank.hs
{-# OPTIONS_GHC-funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module HaskellWorks.Data.Xml.Internal.Blank
( blankXml
, BlankData(..)
) where
import Data.ByteString (ByteString)
import Data.Semigroup ((<>))
import Data.Word
import Data.Word8
import HaskellWorks.Data.Xml.Internal.Words
import Prelude
import qualified Data.ByteString as BS
type ExpectedChar = Word8
data BlankState
= InXml
| InTag
| InAttrList
| InCloseTag
| InClose
| InBang !Int
| InString !ExpectedChar
| InText
| InMeta
| InCdataTag
| InCdata !Int
| InRem !Int
| InIdent
data BlankData = BlankData
{ blankState :: !BlankState
, blankA :: !Word8
, blankB :: !Word8
, blankC :: !ByteString
}
blankXml :: [ByteString] -> [ByteString]
blankXml = blankXmlPlan1 BS.empty InXml
blankXmlPlan1 :: ByteString -> BlankState -> [ByteString] -> [ByteString]
blankXmlPlan1 as lastState is = case is of
(bs:bss) -> do
let cs = as <> bs
case BS.uncons cs of
Just (d, ds) -> case BS.uncons ds of
Just (e, es) -> blankXmlRun False d e es lastState bss
Nothing -> blankXmlPlan1 cs lastState bss
Nothing -> blankXmlPlan1 cs lastState bss
[] -> [BS.map (const _space) as]
blankXmlPlan2 :: Word8 -> Word8 -> BlankState -> [ByteString] -> [ByteString]
blankXmlPlan2 a b lastState is = case is of
(cs:css) -> blankXmlRun False a b cs lastState css
[] -> blankXmlRun True a b (BS.pack [_space, _space]) lastState []
blankXmlRun :: Bool -> Word8 -> Word8 -> ByteString -> BlankState -> [ByteString] -> [ByteString]
blankXmlRun done a b cs lastState is = do
let (!ds, Just (BlankData !nextState _ _ _)) = BS.unfoldrN (BS.length cs) blankByteString (BlankData lastState a b cs)
let (yy, zz) = case BS.unsnoc cs of
Just (ys, z) -> case BS.unsnoc ys of
Just (_, y) -> (y, z)
Nothing -> (b, z)
Nothing -> (a, b)
if done
then [ds]
else ds:blankXmlPlan2 yy zz nextState is
mkNext :: Word8 -> BlankState -> Word8 -> ByteString -> Maybe (Word8, BlankData)
mkNext w s a bs = case BS.uncons bs of
Just (b, cs) -> Just (w, BlankData s a b cs)
Nothing -> error "This should never happen"
{-# INLINE mkNext #-}
blankByteString :: BlankData -> Maybe (Word8, BlankData)
blankByteString (BlankData InXml a b cs) | isMetaStart a b = mkNext _bracketleft InMeta b cs
blankByteString (BlankData InXml a b cs) | isEndTag a b = mkNext _space InCloseTag b cs
blankByteString (BlankData InXml a b cs) | isTextStart a = mkNext _t InText b cs
blankByteString (BlankData InXml a b cs) | a == _less = mkNext _less InTag b cs
blankByteString (BlankData InXml a b cs) | isSpace a = mkNext a InXml b cs
blankByteString (BlankData InXml _ b cs) = mkNext _space InXml b cs
blankByteString (BlankData InTag a b cs) | isSpace a = mkNext _parenleft InAttrList b cs
blankByteString (BlankData InTag a b cs) | isTagClose a b = mkNext _space InClose b cs
blankByteString (BlankData InTag a b cs) | a == _greater = mkNext _space InXml b cs
blankByteString (BlankData InTag a b cs) | isSpace a = mkNext a InTag b cs
blankByteString (BlankData InTag _ b cs) = mkNext _space InTag b cs
blankByteString (BlankData InCloseTag a b cs) | a == _greater = mkNext _greater InXml b cs
blankByteString (BlankData InCloseTag a b cs) | isSpace a = mkNext a InCloseTag b cs
blankByteString (BlankData InCloseTag _ b cs) = mkNext _space InCloseTag b cs
blankByteString (BlankData InAttrList a b cs) | a == _greater = mkNext _parenright InXml b cs
blankByteString (BlankData InAttrList a b cs) | isTagClose a b = mkNext _parenright InClose b cs
blankByteString (BlankData InAttrList a b cs) | isNameStartChar a = mkNext _a InIdent b cs
blankByteString (BlankData InAttrList a b cs) | isQuote a = mkNext _v (InString a) b cs
blankByteString (BlankData InAttrList a b cs) | isSpace a = mkNext a InAttrList b cs
blankByteString (BlankData InAttrList _ b cs) = mkNext _space InAttrList b cs
blankByteString (BlankData InClose _ b cs) = mkNext _greater InXml b cs
blankByteString (BlankData InIdent a b cs) | isNameChar a = mkNext _space InIdent b cs
blankByteString (BlankData InIdent a b cs) | isSpace a = mkNext _space InAttrList b cs
blankByteString (BlankData InIdent a b cs) | a == _equal = mkNext _space InAttrList b cs
blankByteString (BlankData InIdent a b cs) | isSpace a = mkNext a InAttrList b cs
blankByteString (BlankData InIdent _ b cs) = mkNext _space InAttrList b cs
blankByteString (BlankData (InString q ) a b cs) | a == q = mkNext _space InAttrList b cs
blankByteString (BlankData (InString q ) a b cs) | isSpace a = mkNext a (InString q) b cs
blankByteString (BlankData (InString q ) _ b cs) = mkNext _space (InString q) b cs
blankByteString (BlankData InText a b cs) | isEndTag a b = mkNext _space InCloseTag b cs
blankByteString (BlankData InText _ b cs) | b == _less = mkNext _space InXml b cs
blankByteString (BlankData InText a b cs) | isSpace a = mkNext a InText b cs
blankByteString (BlankData InText _ b cs) = mkNext _space InText b cs
blankByteString (BlankData InMeta a b cs) | a == _exclam = mkNext _space InMeta b cs
blankByteString (BlankData InMeta a b cs) | a == _hyphen = mkNext _space (InRem 0) b cs
blankByteString (BlankData InMeta a b cs) | a == _bracketleft = mkNext _space InCdataTag b cs
blankByteString (BlankData InMeta a b cs) | a == _greater = mkNext _bracketright InXml b cs
blankByteString (BlankData InMeta a b cs) | isSpace a = mkNext a (InBang 1) b cs
blankByteString (BlankData InMeta _ b cs) = mkNext _space (InBang 1) b cs
blankByteString (BlankData InCdataTag a b cs) | a == _bracketleft = mkNext _space (InCdata 0) b cs
blankByteString (BlankData InCdataTag a b cs) | isSpace a = mkNext a InCdataTag b cs
blankByteString (BlankData InCdataTag _ b cs) = mkNext _space InCdataTag b cs
blankByteString (BlankData (InCdata n ) a b cs) | a == _greater && n >= 2 = mkNext _bracketright InXml b cs
blankByteString (BlankData (InCdata n ) a b cs) | isCdataEnd a b && n > 0 = mkNext _space (InCdata (n+1)) b cs
blankByteString (BlankData (InCdata n ) a b cs) | a == _bracketright = mkNext _space (InCdata (n+1)) b cs
blankByteString (BlankData (InCdata _ ) a b cs) | isSpace a = mkNext a (InCdata 0) b cs
blankByteString (BlankData (InCdata _ ) _ b cs) = mkNext _space (InCdata 0) b cs
blankByteString (BlankData (InRem n ) a b cs) | a == _greater && n >= 2 = mkNext _bracketright InXml b cs
blankByteString (BlankData (InRem n ) a b cs) | a == _hyphen = mkNext _space (InRem (n+1)) b cs
blankByteString (BlankData (InRem _ ) a b cs) | isSpace a = mkNext a (InRem 0) b cs
blankByteString (BlankData (InRem _ ) _ b cs) = mkNext _space (InRem 0) b cs
blankByteString (BlankData (InBang n ) a b cs) | a == _less = mkNext _bracketleft (InBang (n+1)) b cs
blankByteString (BlankData (InBang n ) a b cs) | a == _greater && n == 1 = mkNext _bracketright InXml b cs
blankByteString (BlankData (InBang n ) a b cs) | a == _greater = mkNext _bracketright (InBang (n-1)) b cs
blankByteString (BlankData (InBang n ) a b cs) | isSpace a = mkNext a (InBang n) b cs
blankByteString (BlankData (InBang n ) _ b cs) = mkNext _space (InBang n) b cs
{-# INLINE blankByteString #-}
isEndTag :: Word8 -> Word8 -> Bool
isEndTag a b = a == _less && b == _slash
{-# INLINE isEndTag #-}
isTagClose :: Word8 -> Word8 -> Bool
isTagClose a b = a == _slash || ((a == _slash || a == _question) && b == _greater)
{-# INLINE isTagClose #-}
isMetaStart :: Word8 -> Word8 -> Bool
isMetaStart a b = a == _less && b == _exclam
{-# INLINE isMetaStart #-}
isCdataEnd :: Word8 -> Word8 -> Bool
isCdataEnd a b = a == _bracketright && b == _greater
{-# INLINE isCdataEnd #-}