module SimpleParser.Chunked
  ( Chunked (..)
  , TextualChunked (..)
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (toList)
import Data.List (uncons)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Word (Word8)
import Text.Builder (Builder)
import qualified Text.Builder as TB

-- | 'Chunked' captures the basic relationship between tokens and chunks of them.
-- Basically, these things behave like lists, sequences, text, etc.
class Monoid chunk => Chunked chunk token | chunk -> token where
  consChunk :: token -> chunk -> chunk
  unconsChunk :: chunk -> Maybe (token, chunk)
  tokenToChunk :: token -> chunk
  tokensToChunk :: [token] -> chunk
  chunkToTokens :: chunk -> [token]
  chunkLength :: chunk -> Int
  chunkEmpty :: chunk -> Bool

  -- | Some datatypes (like 'Seq') may admit a "better" implementation
  -- for building a chunk in reverse.
  revTokensToChunk :: [token] -> chunk
  revTokensToChunk = [token] -> chunk
forall chunk token. Chunked chunk token => [token] -> chunk
tokensToChunk ([token] -> chunk) -> ([token] -> [token]) -> [token] -> chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [token] -> [token]
forall a. [a] -> [a]
reverse

-- | Captures textual streams.
class Chunked chunk Char => TextualChunked chunk where
  buildChunk :: chunk -> Builder
  buildChunk = Text -> Builder
TB.text (Text -> Builder) -> (chunk -> Text) -> chunk -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chunk -> Text
forall chunk. TextualChunked chunk => chunk -> Text
packChunk
  packChunk :: chunk -> Text
  packChunk = Builder -> Text
TB.run (Builder -> Text) -> (chunk -> Builder) -> chunk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. chunk -> Builder
forall chunk. TextualChunked chunk => chunk -> Builder
buildChunk
  unpackChunk :: Text -> chunk
  {-# MINIMAL (buildChunk | packChunk), unpackChunk #-}

instance Chunked [a] a where
  consChunk :: a -> [a] -> [a]
consChunk = (:)
  unconsChunk :: [a] -> Maybe (a, [a])
unconsChunk = [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
uncons
  tokenToChunk :: a -> [a]
tokenToChunk a
a = [a
a]
  tokensToChunk :: [a] -> [a]
tokensToChunk = [a] -> [a]
forall a. a -> a
id
  chunkToTokens :: [a] -> [a]
chunkToTokens = [a] -> [a]
forall a. a -> a
id
  chunkLength :: [a] -> Int
chunkLength = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  chunkEmpty :: [a] -> Bool
chunkEmpty = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

instance (a ~ Char) => TextualChunked [a] where
  buildChunk :: [a] -> Builder
buildChunk = [a] -> Builder
String -> Builder
TB.string
  packChunk :: [a] -> Text
packChunk = [a] -> Text
String -> Text
T.pack
  unpackChunk :: Text -> [a]
unpackChunk = Text -> [a]
Text -> String
T.unpack

instance Chunked (Seq a) a where
  consChunk :: a -> Seq a -> Seq a
consChunk = a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
(:<|)
  unconsChunk :: Seq a -> Maybe (a, Seq a)
unconsChunk Seq a
s =
    case Seq a
s of
      Seq a
Empty -> Maybe (a, Seq a)
forall a. Maybe a
Nothing
      a
a :<| Seq a
b -> (a, Seq a) -> Maybe (a, Seq a)
forall a. a -> Maybe a
Just (a
a, Seq a
b)
  tokenToChunk :: a -> Seq a
tokenToChunk = a -> Seq a
forall a. a -> Seq a
Seq.singleton
  tokensToChunk :: [a] -> Seq a
tokensToChunk = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList
  chunkToTokens :: Seq a -> [a]
chunkToTokens = Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  chunkLength :: Seq a -> Int
chunkLength = Seq a -> Int
forall a. Seq a -> Int
Seq.length
  chunkEmpty :: Seq a -> Bool
chunkEmpty = Seq a -> Bool
forall a. Seq a -> Bool
Seq.null
  revTokensToChunk :: [a] -> Seq a
revTokensToChunk = (a -> Seq a -> Seq a) -> Seq a -> [a] -> Seq a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Seq a -> a -> Seq a) -> a -> Seq a -> Seq a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
(:|>)) Seq a
forall a. Seq a
Empty

instance (a ~ Char) => TextualChunked (Seq a) where
  buildChunk :: Seq a -> Builder
buildChunk = String -> Builder
TB.string (String -> Builder) -> (Seq Char -> String) -> Seq Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  packChunk :: Seq a -> Text
packChunk = String -> Text
T.pack (String -> Text) -> (Seq Char -> String) -> Seq Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  unpackChunk :: Text -> Seq a
unpackChunk = String -> Seq Char
forall a. [a] -> Seq a
Seq.fromList (String -> Seq Char) -> (Text -> String) -> Text -> Seq Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance Chunked Text Char where
  consChunk :: Char -> Text -> Text
consChunk = Char -> Text -> Text
T.cons
  unconsChunk :: Text -> Maybe (Char, Text)
unconsChunk = Text -> Maybe (Char, Text)
T.uncons
  tokenToChunk :: Char -> Text
tokenToChunk = Char -> Text
T.singleton
  tokensToChunk :: String -> Text
tokensToChunk = String -> Text
T.pack
  chunkToTokens :: Text -> String
chunkToTokens = Text -> String
T.unpack
  chunkLength :: Text -> Int
chunkLength = Text -> Int
T.length
  chunkEmpty :: Text -> Bool
chunkEmpty = Text -> Bool
T.null

instance TextualChunked Text where
  buildChunk :: Text -> Builder
buildChunk = Text -> Builder
TB.text
  packChunk :: Text -> Text
packChunk = Text -> Text
forall a. a -> a
id
  unpackChunk :: Text -> Text
unpackChunk = Text -> Text
forall a. a -> a
id

instance Chunked TL.Text Char where
  consChunk :: Char -> Text -> Text
consChunk = Char -> Text -> Text
TL.cons
  unconsChunk :: Text -> Maybe (Char, Text)
unconsChunk = Text -> Maybe (Char, Text)
TL.uncons
  tokenToChunk :: Char -> Text
tokenToChunk = Char -> Text
TL.singleton
  tokensToChunk :: String -> Text
tokensToChunk = String -> Text
TL.pack
  chunkToTokens :: Text -> String
chunkToTokens = Text -> String
TL.unpack
  chunkLength :: Text -> Int
chunkLength = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Text -> Int64) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
TL.length
  chunkEmpty :: Text -> Bool
chunkEmpty = Text -> Bool
TL.null

instance TextualChunked TL.Text where
  buildChunk :: Text -> Builder
buildChunk = Text -> Builder
TB.text (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
  packChunk :: Text -> Text
packChunk = Text -> Text
TL.toStrict
  unpackChunk :: Text -> Text
unpackChunk = Text -> Text
TL.fromStrict

instance Chunked ByteString Word8 where
  consChunk :: Word8 -> ByteString -> ByteString
consChunk = Word8 -> ByteString -> ByteString
BS.cons
  unconsChunk :: ByteString -> Maybe (Word8, ByteString)
unconsChunk = ByteString -> Maybe (Word8, ByteString)
BS.uncons
  tokenToChunk :: Word8 -> ByteString
tokenToChunk = Word8 -> ByteString
BS.singleton
  tokensToChunk :: [Word8] -> ByteString
tokensToChunk = [Word8] -> ByteString
BS.pack
  chunkToTokens :: ByteString -> [Word8]
chunkToTokens = ByteString -> [Word8]
BS.unpack
  chunkLength :: ByteString -> Int
chunkLength = ByteString -> Int
BS.length
  chunkEmpty :: ByteString -> Bool
chunkEmpty = ByteString -> Bool
BS.null

instance Chunked BSL.ByteString Word8 where
  consChunk :: Word8 -> ByteString -> ByteString
consChunk = Word8 -> ByteString -> ByteString
BSL.cons
  unconsChunk :: ByteString -> Maybe (Word8, ByteString)
unconsChunk = ByteString -> Maybe (Word8, ByteString)
BSL.uncons
  tokenToChunk :: Word8 -> ByteString
tokenToChunk = Word8 -> ByteString
BSL.singleton
  tokensToChunk :: [Word8] -> ByteString
tokensToChunk = [Word8] -> ByteString
BSL.pack
  chunkToTokens :: ByteString -> [Word8]
chunkToTokens = ByteString -> [Word8]
BSL.unpack
  chunkLength :: ByteString -> Int
chunkLength = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (ByteString -> Int64) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length
  chunkEmpty :: ByteString -> Bool
chunkEmpty = ByteString -> Bool
BSL.null