{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

module HaskellWorks.Data.Xml.Succinct.Index
( XmlIndex(..)
, XmlIndexAt(..)
)
where

import Control.Arrow
import Data.Text                                 (Text)
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Drop
import HaskellWorks.Data.Positioning
import HaskellWorks.Data.RankSelect.Base.Rank0
import HaskellWorks.Data.RankSelect.Base.Rank1
import HaskellWorks.Data.RankSelect.Base.Select1
import HaskellWorks.Data.TreeCursor
import HaskellWorks.Data.Uncons
import HaskellWorks.Data.Xml.CharLike
import HaskellWorks.Data.Xml.Grammar
import HaskellWorks.Data.Xml.Succinct
import Prelude                                   hiding (drop)

import qualified Data.Attoparsec.ByteString.Char8 as ABC
import qualified Data.ByteString                  as BS
import qualified Data.List                        as L
import qualified Data.Text                        as T
import qualified HaskellWorks.Data.BalancedParens as BP

data XmlIndex
  = XmlIndexDocument [XmlIndex]
  | XmlIndexElement Text [XmlIndex]
  | XmlIndexCData BS.ByteString
  | XmlIndexComment BS.ByteString
  | XmlIndexMeta Text [XmlIndex]
  | XmlIndexAttrList [XmlIndex]
  | XmlIndexValue BS.ByteString
  | XmlIndexAttrName BS.ByteString
  | XmlIndexAttrValue BS.ByteString
  | XmlIndexError Text
  deriving (XmlIndex -> XmlIndex -> Bool
(XmlIndex -> XmlIndex -> Bool)
-> (XmlIndex -> XmlIndex -> Bool) -> Eq XmlIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XmlIndex -> XmlIndex -> Bool
$c/= :: XmlIndex -> XmlIndex -> Bool
== :: XmlIndex -> XmlIndex -> Bool
$c== :: XmlIndex -> XmlIndex -> Bool
Eq, Int -> XmlIndex -> ShowS
[XmlIndex] -> ShowS
XmlIndex -> String
(Int -> XmlIndex -> ShowS)
-> (XmlIndex -> String) -> ([XmlIndex] -> ShowS) -> Show XmlIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XmlIndex] -> ShowS
$cshowList :: [XmlIndex] -> ShowS
show :: XmlIndex -> String
$cshow :: XmlIndex -> String
showsPrec :: Int -> XmlIndex -> ShowS
$cshowsPrec :: Int -> XmlIndex -> ShowS
Show)

data XmlIndexState
  = InAttrList
  | InElement
  | Unknown
  deriving (XmlIndexState -> XmlIndexState -> Bool
(XmlIndexState -> XmlIndexState -> Bool)
-> (XmlIndexState -> XmlIndexState -> Bool) -> Eq XmlIndexState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XmlIndexState -> XmlIndexState -> Bool
$c/= :: XmlIndexState -> XmlIndexState -> Bool
== :: XmlIndexState -> XmlIndexState -> Bool
$c== :: XmlIndexState -> XmlIndexState -> Bool
Eq, Int -> XmlIndexState -> ShowS
[XmlIndexState] -> ShowS
XmlIndexState -> String
(Int -> XmlIndexState -> ShowS)
-> (XmlIndexState -> String)
-> ([XmlIndexState] -> ShowS)
-> Show XmlIndexState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XmlIndexState] -> ShowS
$cshowList :: [XmlIndexState] -> ShowS
show :: XmlIndexState -> String
$cshow :: XmlIndexState -> String
showsPrec :: Int -> XmlIndexState -> ShowS
$cshowsPrec :: Int -> XmlIndexState -> ShowS
Show)

class XmlIndexAt a where
  xmlIndexAt :: a -> XmlIndex

pos :: (Select1 v, Rank1 w) => XmlCursor t v w -> Position
pos :: XmlCursor t v w -> Position
pos XmlCursor t v w
c = Count -> Position
lastPositionOf (v -> Count -> Count
forall v. Select1 v => v -> Count -> Count
select1 (XmlCursor t v w -> v
forall t v w. XmlCursor t v w -> v
interests XmlCursor t v w
c) (w -> Count -> Count
forall v. Rank1 v => v -> Count -> Count
rank1 (XmlCursor t v w -> w
forall t v w. XmlCursor t v w -> w
balancedParens XmlCursor t v w
c) (XmlCursor t v w -> Count
forall t v w. XmlCursor t v w -> Count
cursorRank XmlCursor t v w
c)))

remText :: (Drop v, Select1 v1, Rank1 w) => XmlCursor v v1 w -> v
remText :: XmlCursor v v1 w -> v
remText XmlCursor v v1 w
c = Count -> v -> v
forall v. Drop v => Count -> v -> v
drop (Position -> Count
forall a. ToCount a => a -> Count
toCount (XmlCursor v v1 w -> Position
forall v w t. (Select1 v, Rank1 w) => XmlCursor t v w -> Position
pos XmlCursor v v1 w
c)) (XmlCursor v v1 w -> v
forall t v w. XmlCursor t v w -> t
cursorText XmlCursor v v1 w
c)

instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => XmlIndexAt (XmlCursor BS.ByteString v w) where
  xmlIndexAt :: XmlCursor BS.ByteString v w -> XmlIndex
  xmlIndexAt :: XmlCursor ByteString v w -> XmlIndex
xmlIndexAt = XmlIndexState -> XmlCursor ByteString v w -> XmlIndex
forall w v.
(BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) =>
XmlIndexState -> XmlCursor ByteString v w -> XmlIndex
getIndexAt XmlIndexState
Unknown


getIndexAt :: (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => XmlIndexState -> XmlCursor BS.ByteString v w -> XmlIndex
getIndexAt :: XmlIndexState -> XmlCursor ByteString v w -> XmlIndex
getIndexAt XmlIndexState
state XmlCursor ByteString v w
k = case ByteString -> Maybe (Elem ByteString, ByteString)
forall v. Uncons v => v -> Maybe (Elem v, v)
uncons ByteString
remainder of
  Just (!Elem ByteString
c, ByteString
cs) | Word8 -> Bool
forall c. XmlCharLike c => c -> Bool
isElementStart Word8
Elem ByteString
c         -> ByteString -> XmlIndex
parseElem ByteString
cs
  Just (!Elem ByteString
c, ByteString
_ ) | Word8 -> Bool
forall c. XmlCharLike c => c -> Bool
isSpace Word8
Elem ByteString
c                -> [XmlIndex] -> XmlIndex
XmlIndexAttrList ([XmlIndex] -> XmlIndex) -> [XmlIndex] -> XmlIndex
forall a b. (a -> b) -> a -> b
$ XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
forall w v.
(BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) =>
XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
mapValuesFrom XmlIndexState
InAttrList (XmlCursor ByteString v w -> Maybe (XmlCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
firstChild XmlCursor ByteString v w
k)
  Just (!Elem ByteString
c, ByteString
_ ) | Bool
isAttribute Bool -> Bool -> Bool
&& Word8 -> Bool
forall c. XmlCharLike c => c -> Bool
isQuote Word8
Elem ByteString
c -> ByteString -> XmlIndex
XmlIndexAttrValue ByteString
remainder
  Just (Elem ByteString, ByteString)
_        | Bool
isAttribute              -> ByteString -> XmlIndex
XmlIndexAttrName ByteString
remainder
  Just (Elem ByteString, ByteString)
_                                   -> ByteString -> XmlIndex
XmlIndexValue ByteString
remainder
  Maybe (Elem ByteString, ByteString)
Nothing                                  -> Text -> XmlIndex
XmlIndexError Text
"End of data"
  where remainder :: ByteString
remainder         = XmlCursor ByteString v w -> ByteString
forall v v1 w.
(Drop v, Select1 v1, Rank1 w) =>
XmlCursor v v1 w -> v
remText XmlCursor ByteString v w
k
        mapValuesFrom :: XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
mapValuesFrom XmlIndexState
s   = (Maybe (XmlCursor ByteString v w)
 -> Maybe (XmlIndex, Maybe (XmlCursor ByteString v w)))
-> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr ((XmlCursor ByteString v w
 -> (XmlIndex, Maybe (XmlCursor ByteString v w)))
-> Maybe (XmlCursor ByteString v w)
-> Maybe (XmlIndex, Maybe (XmlCursor ByteString v w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XmlIndexState -> XmlCursor ByteString v w -> XmlIndex
forall w v.
(BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) =>
XmlIndexState -> XmlCursor ByteString v w -> XmlIndex
getIndexAt XmlIndexState
s (XmlCursor ByteString v w -> XmlIndex)
-> (XmlCursor ByteString v w -> Maybe (XmlCursor ByteString v w))
-> XmlCursor ByteString v w
-> (XmlIndex, Maybe (XmlCursor ByteString v w))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XmlCursor ByteString v w -> Maybe (XmlCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
nextSibling))
        isAttribute :: Bool
isAttribute = case XmlIndexState
state of
          XmlIndexState
InAttrList -> Bool
True
          XmlIndexState
InElement  -> Bool
False
          XmlIndexState
Unknown    -> case XmlCursor ByteString v w -> ByteString
forall v v1 w.
(Drop v, Select1 v1, Rank1 w) =>
XmlCursor v v1 w -> v
remText (XmlCursor ByteString v w -> ByteString)
-> Maybe (XmlCursor ByteString v w) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XmlCursor ByteString v w -> Maybe (XmlCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
parent XmlCursor ByteString v w
k Maybe ByteString
-> (ByteString -> Maybe (Word8, ByteString))
-> Maybe (Word8, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe (Word8, ByteString)
forall v. Uncons v => v -> Maybe (Elem v, v)
uncons of
            Just (!Word8
c, ByteString
_) | Word8 -> Bool
forall c. XmlCharLike c => c -> Bool
isSpace Word8
c -> Bool
True
            Maybe (Word8, ByteString)
_                        -> Bool
False

        parseElem :: ByteString -> XmlIndex
parseElem ByteString
bs =
          case Parser XmlElementType -> ByteString -> Result XmlElementType
forall a. Parser a -> ByteString -> Result a
ABC.parse Parser XmlElementType
forall t. (Parser t Word8, IsString t) => Parser t XmlElementType
parseXmlElement ByteString
bs of
            ABC.Fail {}    -> String -> ByteString -> XmlIndex
decodeErr String
"Unable to parse element name" ByteString
bs
            ABC.Partial ByteString -> Result XmlElementType
_  -> String -> ByteString -> XmlIndex
decodeErr String
"Unexpected end of string" ByteString
bs
            ABC.Done ByteString
i XmlElementType
r   -> case XmlElementType
r of
              XmlElementType
XmlElementTypeCData     -> ByteString -> XmlIndex
XmlIndexCData ByteString
i
              XmlElementType
XmlElementTypeComment   -> ByteString -> XmlIndex
XmlIndexComment ByteString
i
              XmlElementTypeMeta Text
s    -> Text -> [XmlIndex] -> XmlIndex
XmlIndexMeta Text
s    (XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
forall w v.
(BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) =>
XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
mapValuesFrom XmlIndexState
InElement (Maybe (XmlCursor ByteString v w) -> [XmlIndex])
-> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
forall a b. (a -> b) -> a -> b
$ XmlCursor ByteString v w -> Maybe (XmlCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
firstChild XmlCursor ByteString v w
k)
              XmlElementTypeElement Text
s -> Text -> [XmlIndex] -> XmlIndex
XmlIndexElement Text
s (XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
forall w v.
(BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) =>
XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
mapValuesFrom XmlIndexState
InElement (Maybe (XmlCursor ByteString v w) -> [XmlIndex])
-> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
forall a b. (a -> b) -> a -> b
$ XmlCursor ByteString v w -> Maybe (XmlCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
firstChild XmlCursor ByteString v w
k)
              XmlElementType
XmlElementTypeDocument  -> [XmlIndex] -> XmlIndex
XmlIndexDocument  (XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
forall w v.
(BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) =>
XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
mapValuesFrom XmlIndexState
InElement (XmlCursor ByteString v w -> Maybe (XmlCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
firstChild XmlCursor ByteString v w
k) [XmlIndex] -> [XmlIndex] -> [XmlIndex]
forall a. Semigroup a => a -> a -> a
<> XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
forall w v.
(BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) =>
XmlIndexState -> Maybe (XmlCursor ByteString v w) -> [XmlIndex]
mapValuesFrom XmlIndexState
InElement (XmlCursor ByteString v w -> Maybe (XmlCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
nextSibling XmlCursor ByteString v w
k))

decodeErr :: String -> BS.ByteString -> XmlIndex
decodeErr :: String -> ByteString -> XmlIndex
decodeErr String
reason ByteString
bs = Text -> XmlIndex
XmlIndexError (Text -> XmlIndex) -> (String -> Text) -> String -> XmlIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> XmlIndex) -> String -> XmlIndex
forall a b. (a -> b) -> a -> b
$ String
reason String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
bs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"...'"