#if __GLASGOW_HASKELL__ >= 702
#endif

-- |
-- Module      :  Data.Attoparsec.ByteString.Lazy
-- Copyright   :  Bryan O'Sullivan 2007-2015
-- License     :  BSD3
--
-- Maintainer  :  bos@serpentine.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Simple, efficient combinator parsing that can consume lazy
-- 'ByteString' strings, loosely based on the Parsec library.
--
-- This is essentially the same code as in the 'Data.Attoparsec'
-- module, only with a 'parse' function that can consume a lazy
-- 'ByteString' incrementally, and a 'Result' type that does not allow
-- more input to be fed in.  Think of this as suitable for use with a
-- lazily read file, e.g. via 'L.readFile' or 'L.hGetContents'.
--
-- /Note:/ The various parser functions and combinators such as
-- 'string' still expect /strict/ 'B.ByteString' parameters, and
-- return strict 'B.ByteString' results.  Behind the scenes, strict
-- 'B.ByteString' values are still used internally to store parser
-- input and manipulate it efficiently.

module Data.Attoparsec.ByteString.Lazy
    (
      Result(..)
    , LbsParserCon
    , module Data.Attoparsec.ByteString
    -- * Running parsers
    , parse
    , parseOnly
    , parseTest
    , dirParse
    , dirParseOnly
    , dirParseTest
    , parseBack
    , parseOnlyBack
    , parseTestBack

    -- ** Result conversion
    , maybeResult
    , eitherResult
    ) where

import Control.DeepSeq (NFData(rnf))
import Data.ByteString.Lazy.Internal (ByteString(..), chunk)
import Data.List (intercalate)
import Data.Tagged
import qualified Data.ByteString as B
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString.Internal as I
import qualified Data.Attoparsec.Internal.Types as T
import Data.Attoparsec.ByteString
    hiding (IResult(..), Result, eitherResult, maybeResult,
            parse, parseOnly, parseWith, parseTest, dirParse, parseBack)
import Debug.TraceEmbrace

-- | The result of a parse.
data Result r = Fail ByteString [String] String
              -- ^ The parse failed.  The 'ByteString' is the input
              -- that had not yet been consumed when the failure
              -- occurred.  The @[@'String'@]@ is a list of contexts
              -- in which the error occurred.  The 'String' is the
              -- message describing the error, if any.
              | Done ByteString r
              -- ^ The parse succeeded.  The 'ByteString' is the
              -- input that had not yet been consumed (if any) when
              -- the parse succeeded.

instance NFData r => NFData (Result r) where
    rnf :: Result r -> ()
rnf (Fail ByteString
bs [String]
ctxs String
msg) = ByteString -> ()
rnfBS ByteString
bs () -> () -> ()
forall a b. a -> b -> b
`seq` [String] -> ()
forall a. NFData a => a -> ()
rnf [String]
ctxs () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
msg
    rnf (Done ByteString
bs r
r)        = ByteString -> ()
rnfBS ByteString
bs () -> () -> ()
forall a b. a -> b -> b
`seq` r -> ()
forall a. NFData a => a -> ()
rnf r
r
    {-# INLINE rnf #-}

rnfBS :: ByteString -> ()
rnfBS :: ByteString -> ()
rnfBS (Chunk StrictByteString
_ ByteString
xs) = ByteString -> ()
rnfBS ByteString
xs
rnfBS ByteString
Empty        = ()
{-# INLINE rnfBS #-}

instance Show r => Show (Result r) where
    show :: Result r -> String
show (Fail ByteString
bs [String]
stk String
msg) =
        String
"Fail " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
stk String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
msg
    show (Done ByteString
bs r
r)       = String
"Done " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> String
forall a. Show a => a -> String
show r
r

fmapR :: (a -> b) -> Result a -> Result b
fmapR :: forall a b. (a -> b) -> Result a -> Result b
fmapR a -> b
_ (Fail ByteString
st [String]
stk String
msg) = ByteString -> [String] -> String -> Result b
forall r. ByteString -> [String] -> String -> Result r
Fail ByteString
st [String]
stk String
msg
fmapR a -> b
f (Done ByteString
bs a
r)       = ByteString -> b -> Result b
forall r. ByteString -> r -> Result r
Done ByteString
bs (a -> b
f a
r)

instance Functor Result where
    fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap = (a -> b) -> Result a -> Result b
forall a b. (a -> b) -> Result a -> Result b
fmapR

class A.Directed d => LazyDirected d where
  orderChunks :: Tagged d ByteString -> ByteString

instance LazyDirected A.Forward where
  orderChunks :: Tagged 'Forward ByteString -> ByteString
orderChunks = Tagged 'Forward ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag
  {-# INLINE orderChunks #-}

instance LazyDirected A.Backward where
  {-# INLINE orderChunks #-}
  orderChunks :: Tagged 'Backward ByteString -> ByteString
orderChunks = $(tw' "/") (ByteString -> ByteString)
-> (Tagged 'Backward ByteString -> ByteString)
-> Tagged 'Backward ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> ByteString -> ByteString
go Maybe ByteString
forall a. Maybe a
Nothing (ByteString -> ByteString)
-> (Tagged 'Backward ByteString -> ByteString)
-> Tagged 'Backward ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged 'Backward ByteString -> ByteString
forall {k} (s :: k) b. Tagged s b -> b
untag
    where
      go :: Maybe ByteString -> ByteString -> ByteString
go Maybe ByteString
Nothing ByteString
Empty = ByteString
Empty
      go (Just ByteString
x) ByteString
Empty = ByteString
x
      go Maybe ByteString
Nothing (Chunk StrictByteString
x ByteString
xs) = Maybe ByteString -> ByteString -> ByteString
go (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
x ByteString
Empty)) ByteString
xs
      go (Just ByteString
p) (Chunk StrictByteString
x ByteString
xs) = Maybe ByteString -> ByteString -> ByteString
go (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (StrictByteString -> ByteString -> ByteString
Chunk StrictByteString
x ByteString
p)) ByteString
xs

type LbsParserCon d =
  ( I.BsParserCon d
  , LazyDirected d
  , I.DefaultDrift d
  )


-- | Run a parser and return its result.
dirParse :: forall a d. LbsParserCon d => A.DirParser d a -> ByteString -> Result a
dirParse :: forall a (d :: Dir).
LbsParserCon d =>
DirParser d a -> ByteString -> Result a
dirParse DirParser d a
p ByteString
s = case Tagged d ByteString -> ByteString
forall (d :: Dir).
LazyDirected d =>
Tagged d ByteString -> ByteString
orderChunks (Tagged d ByteString -> ByteString)
-> Tagged d ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) b. b -> Tagged s b
forall (s :: Dir) b. b -> Tagged s b
Tagged @d ByteString
s of
              Chunk StrictByteString
x ByteString
xs -> IResult StrictByteString a -> ByteString -> Result a
forall {r}. IResult StrictByteString r -> ByteString -> Result r
go (DirParser d a -> StrictByteString -> IResult StrictByteString a
forall (d :: Dir) a.
(DefaultDrift d, BsParserCon d) =>
DirParser d a -> StrictByteString -> Result a
A.dirParse DirParser d a
p StrictByteString
x) (ByteString -> Result a) -> ByteString -> Result a
forall a b. (a -> b) -> a -> b
$ $(tr "/x xs") ByteString
xs
              ByteString
empty      -> IResult StrictByteString a -> ByteString -> Result a
forall {r}. IResult StrictByteString r -> ByteString -> Result r
go (DirParser d a -> StrictByteString -> IResult StrictByteString a
forall (d :: Dir) a.
(DefaultDrift d, BsParserCon d) =>
DirParser d a -> StrictByteString -> Result a
A.dirParse DirParser d a
p StrictByteString
B.empty) (ByteString -> Result a) -> ByteString -> Result a
forall a b. (a -> b) -> a -> b
$ $(tr "empty chunk") ByteString
empty
  where
    go :: IResult StrictByteString r -> ByteString -> Result r
go (T.Fail StrictByteString
x [String]
stk String
msg) ByteString
ys      = ByteString -> [String] -> String -> Result r
forall r. ByteString -> [String] -> String -> Result r
Fail (StrictByteString -> ByteString -> ByteString
chunk StrictByteString
x ByteString
ys) [String]
stk String
msg
    go (T.Done StrictByteString
x r
r) ByteString
ys            = ByteString -> r -> Result r
forall r. ByteString -> r -> Result r
Done (StrictByteString -> ByteString -> ByteString
chunk StrictByteString
x ByteString
ys) r
r
    go (T.Partial StrictByteString -> IResult StrictByteString r
k) (Chunk StrictByteString
y ByteString
ys) = IResult StrictByteString r -> ByteString -> Result r
go (StrictByteString -> IResult StrictByteString r
k StrictByteString
y) ByteString
ys
    go (T.Partial StrictByteString -> IResult StrictByteString r
k) ByteString
empty        = IResult StrictByteString r -> ByteString -> Result r
go (StrictByteString -> IResult StrictByteString r
k StrictByteString
B.empty) ByteString
empty

parse :: A.Parser a -> ByteString -> Result a
parse :: forall a. Parser a -> ByteString -> Result a
parse = DirParser 'Forward a -> ByteString -> Result a
forall a (d :: Dir).
LbsParserCon d =>
DirParser d a -> ByteString -> Result a
dirParse

parseBack :: A.BackParser a -> ByteString -> Result a
parseBack :: forall a. BackParser a -> ByteString -> Result a
parseBack = DirParser 'Backward a -> ByteString -> Result a
forall a (d :: Dir).
LbsParserCon d =>
DirParser d a -> ByteString -> Result a
dirParse

-- | Run a parser and print its result to standard output.
dirParseTest :: (LbsParserCon d, Show a) => A.DirParser d a -> ByteString -> IO ()
dirParseTest :: forall (d :: Dir) a.
(LbsParserCon d, Show a) =>
DirParser d a -> ByteString -> IO ()
dirParseTest DirParser d a
p ByteString
s = Result a -> IO ()
forall a. Show a => a -> IO ()
print (DirParser d a -> ByteString -> Result a
forall a (d :: Dir).
LbsParserCon d =>
DirParser d a -> ByteString -> Result a
dirParse DirParser d a
p ByteString
s)

parseTest :: (Show a) => A.Parser a -> ByteString -> IO ()
parseTest :: forall a. Show a => Parser a -> ByteString -> IO ()
parseTest = DirParser 'Forward a -> ByteString -> IO ()
forall (d :: Dir) a.
(LbsParserCon d, Show a) =>
DirParser d a -> ByteString -> IO ()
dirParseTest

parseTestBack :: (Show a) => A.BackParser a -> ByteString -> IO ()
parseTestBack :: forall a. Show a => BackParser a -> ByteString -> IO ()
parseTestBack = DirParser 'Backward a -> ByteString -> IO ()
forall (d :: Dir) a.
(LbsParserCon d, Show a) =>
DirParser d a -> ByteString -> IO ()
dirParseTest

-- | Convert a 'Result' value to a 'Maybe' value.
maybeResult :: Result r -> Maybe r
maybeResult :: forall r. Result r -> Maybe r
maybeResult (Done ByteString
_ r
r) = r -> Maybe r
forall a. a -> Maybe a
Just r
r
maybeResult Result r
_          = Maybe r
forall a. Maybe a
Nothing

-- | Convert a 'Result' value to an 'Either' value.
eitherResult :: Result r -> Either String r
eitherResult :: forall r. Result r -> Either String r
eitherResult (Done ByteString
_ r
r)        = r -> Either String r
forall a b. b -> Either a b
Right r
r
eitherResult (Fail ByteString
_ [] String
msg)   = String -> Either String r
forall a b. a -> Either a b
Left String
msg
eitherResult (Fail ByteString
_ [String]
ctxs String
msg) = String -> Either String r
forall a b. a -> Either a b
Left (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" > " [String]
ctxs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)

-- | Run a parser that cannot be resupplied via a 'T.Partial' result.
--
-- This function does not force a parser to consume all of its input.
-- Instead, any residual input will be discarded.  To force a parser
-- to consume all of its input, use something like this:
--
-- @
--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
-- @
dirParseOnly :: LbsParserCon d => A.DirParser d a -> ByteString -> Either String a
dirParseOnly :: forall (d :: Dir) a.
LbsParserCon d =>
DirParser d a -> ByteString -> Either String a
dirParseOnly DirParser d a
p = Result a -> Either String a
forall r. Result r -> Either String r
eitherResult (Result a -> Either String a)
-> (ByteString -> Result a) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirParser d a -> ByteString -> Result a
forall a (d :: Dir).
LbsParserCon d =>
DirParser d a -> ByteString -> Result a
dirParse DirParser d a
p
{-# INLINE dirParseOnly #-}

parseOnly :: A.Parser a -> ByteString -> Either String a
parseOnly :: forall a. Parser a -> ByteString -> Either String a
parseOnly = DirParser 'Forward a -> ByteString -> Either String a
forall (d :: Dir) a.
LbsParserCon d =>
DirParser d a -> ByteString -> Either String a
dirParseOnly
{-# INLINE parseOnly #-}

parseOnlyBack :: A.BackParser a -> ByteString -> Either String a
parseOnlyBack :: forall a. BackParser a -> ByteString -> Either String a
parseOnlyBack = DirParser 'Backward a -> ByteString -> Either String a
forall (d :: Dir) a.
LbsParserCon d =>
DirParser d a -> ByteString -> Either String a
dirParseOnly
{-# INLINE parseOnlyBack #-}