{-# LANGUAGE
    BangPatterns
  , ScopedTypeVariables
  , UnicodeSyntax
  #-}
-- |This is an auxiliary parser utilities. You usually don't have to
-- use this module directly.
module Network.HTTP.Lucu.Parser
    ( atMost
    , manyOctetsTill
    )
    where
import Blaze.ByteString.Builder (Builder, Write)
import qualified Blaze.ByteString.Builder as BB
import qualified Blaze.ByteString.Builder.Internal as BI
import Control.Applicative
import Control.Applicative.Unicode hiding ((∅))
import Control.Monad.Unicode
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LS
import Data.Monoid
import Data.Monoid.Unicode
import Data.Word
import Prelude.Unicode

-- |@'atMost' n v@ is like @'P.many' v@ but accumulates @v@ at most
-- @n@ times.
atMost ∷ Alternative f ⇒ Int → f a → f [a]
{-# INLINE atMost #-}
atMost 0 _ = pure []
atMost n v = ( (:) <$> v ⊛ atMost (n-1) v )
             <|>
             pure []

data OctetAccumState
    = OctetAccumState {
        casChunks    ∷ !Builder
      , casLastChunk ∷ !Write
      }

instance Monoid OctetAccumState where
    {-# INLINE mempty #-}
    mempty
        = OctetAccumState {
            casChunks    = (∅)
          , casLastChunk = (∅)
          }
    {-# INLINEABLE mappend #-}
    mappend !a !b
        = b {
            casChunks = casChunks a ⊕ lastChunk a ⊕ casChunks b
          }

lastChunk ∷ OctetAccumState → Builder
{-# INLINEABLE lastChunk #-}
lastChunk !s = case toChunk s of
                 c → BB.insertByteString c
    where
      toChunk ∷ OctetAccumState → BS.ByteString
      {-# INLINE toChunk #-}
      toChunk = BB.toByteString ∘ BB.fromWrite ∘ casLastChunk

snoc ∷ OctetAccumState → Word8 → OctetAccumState
{-# INLINEABLE snoc #-}
snoc !s !o
    | BI.getBound (casLastChunk s) ≥ BI.defaultBufferSize
        = s {
            casChunks    = casChunks s ⊕ lastChunk s
          , casLastChunk = BB.writeWord8 o
          }
    | otherwise
        = s {
            casLastChunk = casLastChunk s ⊕ BB.writeWord8 o
          }

finish ∷ OctetAccumState → LS.ByteString
{-# INLINEABLE finish #-}
finish = BB.toLazyByteString ∘ toChunks
    where
      toChunks ∷ OctetAccumState → Builder
      {-# INLINE toChunks #-}
      toChunks !s = casChunks s ⊕ lastChunk s

-- |@'manyOctetsTill' p end@ takes as many octets untill @p@ succeeds.
manyOctetsTill ∷ ∀m b. (Monad m, Alternative m)
              ⇒ m Word8
              → m b
              → m LS.ByteString
{-# INLINEABLE manyOctetsTill #-}
manyOctetsTill p end = scan (∅)
    where
      scan ∷ OctetAccumState → m LS.ByteString
      {-# INLINE scan #-}
      scan !s
          = (end *> pure (finish s))
            <|>
            (scan =≪ (snoc s <$> p))