{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}

module HaskellWorks.Data.Xml.Succinct.Cursor.Internal
  ( XmlCursor(..)
  , xmlCursorPos
  ) where

import Control.DeepSeq                                    (NFData (..))
import Data.String
import Data.Word
import Foreign.ForeignPtr
import GHC.Generics
import HaskellWorks.Data.Bits.BitShown
import HaskellWorks.Data.FromByteString
import HaskellWorks.Data.FromForeignRegion
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.RankSelect.Poppy512
import HaskellWorks.Data.TreeCursor
import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
import HaskellWorks.Data.Xml.Succinct.Cursor.InterestBits

import qualified Data.ByteString                                      as BS
import qualified Data.ByteString.Char8                                as BSC
import qualified Data.ByteString.Internal                             as BSI
import qualified Data.Vector.Storable                                 as DVS
import qualified HaskellWorks.Data.BalancedParens                     as BP
import qualified HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParens as CBP

data XmlCursor t v w = XmlCursor
  { XmlCursor t v w -> t
cursorText     :: !t
  , XmlCursor t v w -> v
interests      :: !v
  , XmlCursor t v w -> w
balancedParens :: !w
  , XmlCursor t v w -> Count
cursorRank     :: !Count
  }
  deriving (XmlCursor t v w -> XmlCursor t v w -> Bool
(XmlCursor t v w -> XmlCursor t v w -> Bool)
-> (XmlCursor t v w -> XmlCursor t v w -> Bool)
-> Eq (XmlCursor t v w)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t v w.
(Eq t, Eq v, Eq w) =>
XmlCursor t v w -> XmlCursor t v w -> Bool
/= :: XmlCursor t v w -> XmlCursor t v w -> Bool
$c/= :: forall t v w.
(Eq t, Eq v, Eq w) =>
XmlCursor t v w -> XmlCursor t v w -> Bool
== :: XmlCursor t v w -> XmlCursor t v w -> Bool
$c== :: forall t v w.
(Eq t, Eq v, Eq w) =>
XmlCursor t v w -> XmlCursor t v w -> Bool
Eq, Int -> XmlCursor t v w -> ShowS
[XmlCursor t v w] -> ShowS
XmlCursor t v w -> String
(Int -> XmlCursor t v w -> ShowS)
-> (XmlCursor t v w -> String)
-> ([XmlCursor t v w] -> ShowS)
-> Show (XmlCursor t v w)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t v w.
(Show t, Show v, Show w) =>
Int -> XmlCursor t v w -> ShowS
forall t v w.
(Show t, Show v, Show w) =>
[XmlCursor t v w] -> ShowS
forall t v w. (Show t, Show v, Show w) => XmlCursor t v w -> String
showList :: [XmlCursor t v w] -> ShowS
$cshowList :: forall t v w.
(Show t, Show v, Show w) =>
[XmlCursor t v w] -> ShowS
show :: XmlCursor t v w -> String
$cshow :: forall t v w. (Show t, Show v, Show w) => XmlCursor t v w -> String
showsPrec :: Int -> XmlCursor t v w -> ShowS
$cshowsPrec :: forall t v w.
(Show t, Show v, Show w) =>
Int -> XmlCursor t v w -> ShowS
Show, (forall x. XmlCursor t v w -> Rep (XmlCursor t v w) x)
-> (forall x. Rep (XmlCursor t v w) x -> XmlCursor t v w)
-> Generic (XmlCursor t v w)
forall x. Rep (XmlCursor t v w) x -> XmlCursor t v w
forall x. XmlCursor t v w -> Rep (XmlCursor t v w) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t v w x. Rep (XmlCursor t v w) x -> XmlCursor t v w
forall t v w x. XmlCursor t v w -> Rep (XmlCursor t v w) x
$cto :: forall t v w x. Rep (XmlCursor t v w) x -> XmlCursor t v w
$cfrom :: forall t v w x. XmlCursor t v w -> Rep (XmlCursor t v w) x
Generic)

instance (NFData t, NFData v, NFData w) => NFData (XmlCursor t v w) where
  rnf :: XmlCursor t v w -> ()
rnf (XmlCursor t
a v
b w
c Count
d) = (t, v, w, Count) -> ()
forall a. NFData a => a -> ()
rnf (t
a, v
b, w
c, Count
d)

instance  (FromBlankedXml (XmlInterestBits a), FromBlankedXml (CBP.XmlBalancedParens b))
          => FromByteString (XmlCursor BS.ByteString a b) where
  fromByteString :: ByteString -> XmlCursor ByteString a b
fromByteString ByteString
bs   = XmlCursor :: forall t v w. t -> v -> w -> Count -> XmlCursor t v w
XmlCursor
    { cursorText :: ByteString
cursorText      = ByteString
bs
    , interests :: a
interests       = XmlInterestBits a -> a
forall a. XmlInterestBits a -> a
getXmlInterestBits (BlankedXml -> XmlInterestBits a
forall a. FromBlankedXml a => BlankedXml -> a
fromBlankedXml BlankedXml
blankedXml)
    , balancedParens :: b
balancedParens  = XmlBalancedParens b -> b
forall a. XmlBalancedParens a -> a
CBP.getXmlBalancedParens (BlankedXml -> XmlBalancedParens b
forall a. FromBlankedXml a => BlankedXml -> a
fromBlankedXml BlankedXml
blankedXml)
    , cursorRank :: Count
cursorRank      = Count
1
    }
    where blankedXml :: BlankedXml
          blankedXml :: BlankedXml
blankedXml = ByteString -> BlankedXml
bsToBlankedXml ByteString
bs

instance IsString (XmlCursor BS.ByteString (BitShown (DVS.Vector Word8)) (BP.SimpleBalancedParens (DVS.Vector Word8))) where
  fromString :: String
-> XmlCursor
     ByteString
     (BitShown (Vector Word8))
     (SimpleBalancedParens (Vector Word8))
fromString = ByteString
-> XmlCursor
     ByteString
     (BitShown (Vector Word8))
     (SimpleBalancedParens (Vector Word8))
forall a. FromByteString a => ByteString -> a
fromByteString (ByteString
 -> XmlCursor
      ByteString
      (BitShown (Vector Word8))
      (SimpleBalancedParens (Vector Word8)))
-> (String -> ByteString)
-> String
-> XmlCursor
     ByteString
     (BitShown (Vector Word8))
     (SimpleBalancedParens (Vector Word8))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack

instance IsString (XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (BP.SimpleBalancedParens (DVS.Vector Word16))) where
  fromString :: String
-> XmlCursor
     ByteString
     (BitShown (Vector Word16))
     (SimpleBalancedParens (Vector Word16))
fromString = ByteString
-> XmlCursor
     ByteString
     (BitShown (Vector Word16))
     (SimpleBalancedParens (Vector Word16))
forall a. FromByteString a => ByteString -> a
fromByteString (ByteString
 -> XmlCursor
      ByteString
      (BitShown (Vector Word16))
      (SimpleBalancedParens (Vector Word16)))
-> (String -> ByteString)
-> String
-> XmlCursor
     ByteString
     (BitShown (Vector Word16))
     (SimpleBalancedParens (Vector Word16))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack

instance IsString (XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (BP.SimpleBalancedParens (DVS.Vector Word32))) where
  fromString :: String
-> XmlCursor
     ByteString
     (BitShown (Vector Word32))
     (SimpleBalancedParens (Vector Word32))
fromString = ByteString
-> XmlCursor
     ByteString
     (BitShown (Vector Word32))
     (SimpleBalancedParens (Vector Word32))
forall a. FromByteString a => ByteString -> a
fromByteString (ByteString
 -> XmlCursor
      ByteString
      (BitShown (Vector Word32))
      (SimpleBalancedParens (Vector Word32)))
-> (String -> ByteString)
-> String
-> XmlCursor
     ByteString
     (BitShown (Vector Word32))
     (SimpleBalancedParens (Vector Word32))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack

instance IsString (XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (BP.SimpleBalancedParens (DVS.Vector Word64))) where
  fromString :: String
-> XmlCursor
     ByteString
     (BitShown (Vector Count))
     (SimpleBalancedParens (Vector Count))
fromString = ByteString
-> XmlCursor
     ByteString
     (BitShown (Vector Count))
     (SimpleBalancedParens (Vector Count))
forall a. FromByteString a => ByteString -> a
fromByteString (ByteString
 -> XmlCursor
      ByteString
      (BitShown (Vector Count))
      (SimpleBalancedParens (Vector Count)))
-> (String -> ByteString)
-> String
-> XmlCursor
     ByteString
     (BitShown (Vector Count))
     (SimpleBalancedParens (Vector Count))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack

instance IsString (XmlCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where
  fromString :: String
-> XmlCursor
     ByteString Poppy512 (SimpleBalancedParens (Vector Count))
fromString = ByteString
-> XmlCursor
     ByteString Poppy512 (SimpleBalancedParens (Vector Count))
forall a. FromByteString a => ByteString -> a
fromByteString (ByteString
 -> XmlCursor
      ByteString Poppy512 (SimpleBalancedParens (Vector Count)))
-> (String -> ByteString)
-> String
-> XmlCursor
     ByteString Poppy512 (SimpleBalancedParens (Vector Count))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack

instance FromForeignRegion (XmlCursor BS.ByteString (BitShown (DVS.Vector Word8)) (BP.SimpleBalancedParens (DVS.Vector Word8))) where
  fromForeignRegion :: ForeignRegion
-> XmlCursor
     ByteString
     (BitShown (Vector Word8))
     (SimpleBalancedParens (Vector Word8))
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ByteString
-> XmlCursor
     ByteString
     (BitShown (Vector Word8))
     (SimpleBalancedParens (Vector Word8))
forall a. FromByteString a => ByteString -> a
fromByteString (ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset Int
size)

instance FromForeignRegion (XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (BP.SimpleBalancedParens (DVS.Vector Word16))) where
  fromForeignRegion :: ForeignRegion
-> XmlCursor
     ByteString
     (BitShown (Vector Word16))
     (SimpleBalancedParens (Vector Word16))
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ByteString
-> XmlCursor
     ByteString
     (BitShown (Vector Word16))
     (SimpleBalancedParens (Vector Word16))
forall a. FromByteString a => ByteString -> a
fromByteString (ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset Int
size)

instance FromForeignRegion (XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (BP.SimpleBalancedParens (DVS.Vector Word32))) where
  fromForeignRegion :: ForeignRegion
-> XmlCursor
     ByteString
     (BitShown (Vector Word32))
     (SimpleBalancedParens (Vector Word32))
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ByteString
-> XmlCursor
     ByteString
     (BitShown (Vector Word32))
     (SimpleBalancedParens (Vector Word32))
forall a. FromByteString a => ByteString -> a
fromByteString (ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset Int
size)

instance FromForeignRegion (XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (BP.SimpleBalancedParens (DVS.Vector Word64))) where
  fromForeignRegion :: ForeignRegion
-> XmlCursor
     ByteString
     (BitShown (Vector Count))
     (SimpleBalancedParens (Vector Count))
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ByteString
-> XmlCursor
     ByteString
     (BitShown (Vector Count))
     (SimpleBalancedParens (Vector Count))
forall a. FromByteString a => ByteString -> a
fromByteString (ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset Int
size)

instance FromForeignRegion (XmlCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where
  fromForeignRegion :: ForeignRegion
-> XmlCursor
     ByteString Poppy512 (SimpleBalancedParens (Vector Count))
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ByteString
-> XmlCursor
     ByteString Poppy512 (SimpleBalancedParens (Vector Count))
forall a. FromByteString a => ByteString -> a
fromByteString (ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset Int
size)

instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (XmlCursor t v u) where
  firstChild :: XmlCursor t v u -> Maybe (XmlCursor t v u)
  firstChild :: XmlCursor t v u -> Maybe (XmlCursor t v u)
firstChild XmlCursor t v u
k = let mq :: Maybe Count
mq = u -> Count -> Maybe Count
forall v. BalancedParens v => v -> Count -> Maybe Count
BP.firstChild (XmlCursor t v u -> u
forall t v w. XmlCursor t v w -> w
balancedParens XmlCursor t v u
k) (XmlCursor t v u -> Count
forall t v w. XmlCursor t v w -> Count
cursorRank XmlCursor t v u
k) in (\Count
q -> XmlCursor t v u
k { cursorRank :: Count
cursorRank = Count
q }) (Count -> XmlCursor t v u)
-> Maybe Count -> Maybe (XmlCursor t v u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Count
mq

  nextSibling :: XmlCursor t v u -> Maybe (XmlCursor t v u)
  nextSibling :: XmlCursor t v u -> Maybe (XmlCursor t v u)
nextSibling XmlCursor t v u
k = (\Count
q -> XmlCursor t v u
k { cursorRank :: Count
cursorRank = Count
q }) (Count -> XmlCursor t v u)
-> Maybe Count -> Maybe (XmlCursor t v u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> Count -> Maybe Count
forall v. BalancedParens v => v -> Count -> Maybe Count
BP.nextSibling (XmlCursor t v u -> u
forall t v w. XmlCursor t v w -> w
balancedParens XmlCursor t v u
k) (XmlCursor t v u -> Count
forall t v w. XmlCursor t v w -> Count
cursorRank XmlCursor t v u
k)

  parent :: XmlCursor t v u -> Maybe (XmlCursor t v u)
  parent :: XmlCursor t v u -> Maybe (XmlCursor t v u)
parent XmlCursor t v u
k = let mq :: Maybe Count
mq = u -> Count -> Maybe Count
forall v. BalancedParens v => v -> Count -> Maybe Count
BP.parent (XmlCursor t v u -> u
forall t v w. XmlCursor t v w -> w
balancedParens XmlCursor t v u
k) (XmlCursor t v u -> Count
forall t v w. XmlCursor t v w -> Count
cursorRank XmlCursor t v u
k) in (\Count
q -> XmlCursor t v u
k { cursorRank :: Count
cursorRank = Count
q }) (Count -> XmlCursor t v u)
-> Maybe Count -> Maybe (XmlCursor t v u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Count
mq

  depth :: XmlCursor t v u -> Maybe Count
  depth :: XmlCursor t v u -> Maybe Count
depth XmlCursor t v u
k = u -> Count -> Maybe Count
forall v.
(BalancedParens v, Rank0 v, Rank1 v) =>
v -> Count -> Maybe Count
BP.depth (XmlCursor t v u -> u
forall t v w. XmlCursor t v w -> w
balancedParens XmlCursor t v u
k) (XmlCursor t v u -> Count
forall t v w. XmlCursor t v w -> Count
cursorRank XmlCursor t v u
k)

  subtreeSize :: XmlCursor t v u -> Maybe Count
  subtreeSize :: XmlCursor t v u -> Maybe Count
subtreeSize XmlCursor t v u
k = u -> Count -> Maybe Count
forall v. BalancedParens v => v -> Count -> Maybe Count
BP.subtreeSize (XmlCursor t v u -> u
forall t v w. XmlCursor t v w -> w
balancedParens XmlCursor t v u
k) (XmlCursor t v u -> Count
forall t v w. XmlCursor t v w -> Count
cursorRank XmlCursor t v u
k)

xmlCursorPos :: (Rank1 w, Select1 v) => XmlCursor s v w -> Position
xmlCursorPos :: XmlCursor s v w -> Position
xmlCursorPos XmlCursor s v w
k = Count -> Position
forall a. ToPosition a => a -> Position
toPosition (v -> Count -> Count
forall v. Select1 v => v -> Count -> Count
select1 v
ik (w -> Count -> Count
forall v. Rank1 v => v -> Count -> Count
rank1 w
bpk (XmlCursor s v w -> Count
forall t v w. XmlCursor t v w -> Count
cursorRank XmlCursor s v w
k)) Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
1)
  where ik :: v
ik  = XmlCursor s v w -> v
forall t v w. XmlCursor t v w -> v
interests XmlCursor s v w
k
        bpk :: w
bpk = XmlCursor s v w -> w
forall t v w. XmlCursor t v w -> w
balancedParens XmlCursor s v w
k