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

module HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParens
  ( XmlBalancedParens(..)
  , getXmlBalancedParens
  ) where

import Control.Applicative
import Control.DeepSeq
import Data.Word
import GHC.Generics
import HaskellWorks.Data.BalancedParens
import HaskellWorks.Data.Xml.Internal.BalancedParens
import HaskellWorks.Data.Xml.Internal.List
import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml

import qualified Data.ByteString      as BS
import qualified Data.Vector.Storable as DVS

newtype XmlBalancedParens a = XmlBalancedParens a deriving (XmlBalancedParens a -> XmlBalancedParens a -> Bool
(XmlBalancedParens a -> XmlBalancedParens a -> Bool)
-> (XmlBalancedParens a -> XmlBalancedParens a -> Bool)
-> Eq (XmlBalancedParens a)
forall a.
Eq a =>
XmlBalancedParens a -> XmlBalancedParens a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XmlBalancedParens a -> XmlBalancedParens a -> Bool
$c/= :: forall a.
Eq a =>
XmlBalancedParens a -> XmlBalancedParens a -> Bool
== :: XmlBalancedParens a -> XmlBalancedParens a -> Bool
$c== :: forall a.
Eq a =>
XmlBalancedParens a -> XmlBalancedParens a -> Bool
Eq, Int -> XmlBalancedParens a -> ShowS
[XmlBalancedParens a] -> ShowS
XmlBalancedParens a -> String
(Int -> XmlBalancedParens a -> ShowS)
-> (XmlBalancedParens a -> String)
-> ([XmlBalancedParens a] -> ShowS)
-> Show (XmlBalancedParens a)
forall a. Show a => Int -> XmlBalancedParens a -> ShowS
forall a. Show a => [XmlBalancedParens a] -> ShowS
forall a. Show a => XmlBalancedParens a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XmlBalancedParens a] -> ShowS
$cshowList :: forall a. Show a => [XmlBalancedParens a] -> ShowS
show :: XmlBalancedParens a -> String
$cshow :: forall a. Show a => XmlBalancedParens a -> String
showsPrec :: Int -> XmlBalancedParens a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> XmlBalancedParens a -> ShowS
Show, (forall x. XmlBalancedParens a -> Rep (XmlBalancedParens a) x)
-> (forall x. Rep (XmlBalancedParens a) x -> XmlBalancedParens a)
-> Generic (XmlBalancedParens a)
forall x. Rep (XmlBalancedParens a) x -> XmlBalancedParens a
forall x. XmlBalancedParens a -> Rep (XmlBalancedParens a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (XmlBalancedParens a) x -> XmlBalancedParens a
forall a x. XmlBalancedParens a -> Rep (XmlBalancedParens a) x
$cto :: forall a x. Rep (XmlBalancedParens a) x -> XmlBalancedParens a
$cfrom :: forall a x. XmlBalancedParens a -> Rep (XmlBalancedParens a) x
Generic, XmlBalancedParens a -> ()
(XmlBalancedParens a -> ()) -> NFData (XmlBalancedParens a)
forall a. NFData a => XmlBalancedParens a -> ()
forall a. (a -> ()) -> NFData a
rnf :: XmlBalancedParens a -> ()
$crnf :: forall a. NFData a => XmlBalancedParens a -> ()
NFData)

getXmlBalancedParens :: XmlBalancedParens a -> a
getXmlBalancedParens :: XmlBalancedParens a -> a
getXmlBalancedParens (XmlBalancedParens a
a) = a
a

genBitWordsForever :: BS.ByteString -> Maybe (Word8, BS.ByteString)
genBitWordsForever :: ByteString -> Maybe (Word8, ByteString)
genBitWordsForever ByteString
bs = ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs Maybe (Word8, ByteString)
-> Maybe (Word8, ByteString) -> Maybe (Word8, ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8
0, ByteString
bs)
{-# INLINABLE genBitWordsForever #-}

instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where
  fromBlankedXml :: BlankedXml
-> XmlBalancedParens (SimpleBalancedParens (Vector Word8))
fromBlankedXml BlankedXml
bj    = SimpleBalancedParens (Vector Word8)
-> XmlBalancedParens (SimpleBalancedParens (Vector Word8))
forall a. a -> XmlBalancedParens a
XmlBalancedParens (Vector Word8 -> SimpleBalancedParens (Vector Word8)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (Vector Word8 -> Vector Word8
forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast (Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Vector Word8
forall a b.
Storable a =>
Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVS.unfoldrN Int
newLen ByteString -> Maybe (Word8, ByteString)
genBitWordsForever ByteString
interestBS)))
    where interestBS :: ByteString
interestBS    = [ByteString] -> ByteString
BS.concat ([ByteString] -> [ByteString]
compressWordAsBit ([ByteString] -> [ByteString]
blankedXmlToBalancedParens (BlankedXml -> [ByteString]
getBlankedXml BlankedXml
bj)))
          newLen :: Int
newLen        = (ByteString -> Int
BS.length ByteString
interestBS Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8

instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where
  fromBlankedXml :: BlankedXml
-> XmlBalancedParens (SimpleBalancedParens (Vector Word16))
fromBlankedXml BlankedXml
bj    = SimpleBalancedParens (Vector Word16)
-> XmlBalancedParens (SimpleBalancedParens (Vector Word16))
forall a. a -> XmlBalancedParens a
XmlBalancedParens (Vector Word16 -> SimpleBalancedParens (Vector Word16)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (Vector Word8 -> Vector Word16
forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast (Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Vector Word8
forall a b.
Storable a =>
Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVS.unfoldrN Int
newLen ByteString -> Maybe (Word8, ByteString)
genBitWordsForever ByteString
interestBS)))
    where interestBS :: ByteString
interestBS    = [ByteString] -> ByteString
BS.concat ([ByteString] -> [ByteString]
compressWordAsBit ([ByteString] -> [ByteString]
blankedXmlToBalancedParens (BlankedXml -> [ByteString]
getBlankedXml BlankedXml
bj)))
          newLen :: Int
newLen        = (ByteString -> Int
BS.length ByteString
interestBS Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8

instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where
  fromBlankedXml :: BlankedXml
-> XmlBalancedParens (SimpleBalancedParens (Vector Word32))
fromBlankedXml BlankedXml
bj    = SimpleBalancedParens (Vector Word32)
-> XmlBalancedParens (SimpleBalancedParens (Vector Word32))
forall a. a -> XmlBalancedParens a
XmlBalancedParens (Vector Word32 -> SimpleBalancedParens (Vector Word32)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (Vector Word8 -> Vector Word32
forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast (Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Vector Word8
forall a b.
Storable a =>
Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVS.unfoldrN Int
newLen ByteString -> Maybe (Word8, ByteString)
genBitWordsForever ByteString
interestBS)))
    where interestBS :: ByteString
interestBS    = [ByteString] -> ByteString
BS.concat ([ByteString] -> [ByteString]
compressWordAsBit ([ByteString] -> [ByteString]
blankedXmlToBalancedParens (BlankedXml -> [ByteString]
getBlankedXml BlankedXml
bj)))
          newLen :: Int
newLen        = (ByteString -> Int
BS.length ByteString
interestBS Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8

instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where
  fromBlankedXml :: BlankedXml
-> XmlBalancedParens (SimpleBalancedParens (Vector Word64))
fromBlankedXml BlankedXml
bj    = SimpleBalancedParens (Vector Word64)
-> XmlBalancedParens (SimpleBalancedParens (Vector Word64))
forall a. a -> XmlBalancedParens a
XmlBalancedParens (Vector Word64 -> SimpleBalancedParens (Vector Word64)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (Vector Word8 -> Vector Word64
forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast (Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Vector Word8
forall a b.
Storable a =>
Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVS.unfoldrN Int
newLen ByteString -> Maybe (Word8, ByteString)
genBitWordsForever ByteString
interestBS)))
    where interestBS :: ByteString
interestBS    = [ByteString] -> ByteString
BS.concat ([ByteString] -> [ByteString]
compressWordAsBit ([ByteString] -> [ByteString]
blankedXmlToBalancedParens (BlankedXml -> [ByteString]
getBlankedXml BlankedXml
bj)))
          newLen :: Int
newLen        = (ByteString -> Int
BS.length ByteString
interestBS Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8