{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses, PackageImports, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}
module Debian.Control.ByteString
    ( Control'(..)
    , Paragraph'(..)
    , Field'(..)
    , Control
    , Paragraph
    , Field
    , ControlFunctions(..)
    -- * Helper Functions
    , mergeControls
    , fieldValue
    , removeField
    , prependFields
    , appendFields
    , renameField
    , modifyField
    , raiseFields
    ) where

-- Standard GHC modules

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..))
#endif
import Control.Applicative (Alternative(..))
import qualified Control.Exception as E
import "mtl" Control.Monad.State

import Data.Char(toLower, isSpace)
import Data.List

import Text.ParserCombinators.Parsec.Error
import Text.ParserCombinators.Parsec.Pos

-- Third Party Modules

import qualified Data.ByteString.Char8 as C

import Debian.Control.Common hiding (protectFieldText')

-- Local Modules

-- import ByteStreamParser

-- * Types
{-
newtype Control = Control [Paragraph]
newtype Paragraph = Paragraph [Field]
newtype Field = Field (C.ByteString, C.ByteString)
-}

type Control = Control' C.ByteString
type Paragraph = Paragraph' C.ByteString
type Field = Field'  C.ByteString
-- * Control Parser

type ControlParser a = Parser C.ByteString a

pKey :: ControlParser C.ByteString
pKey :: ControlParser ByteString
pKey = ControlParser ByteString -> ControlParser ByteString
forall st. Parser st ByteString -> Parser st ByteString
notEmpty (ControlParser ByteString -> ControlParser ByteString)
-> ControlParser ByteString -> ControlParser ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ControlParser ByteString
pTakeWhile (\Char
c -> (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Bool -> Bool -> Bool
&& (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))

pValue :: ControlParser C.ByteString
pValue :: ControlParser ByteString
pValue = (ByteString -> Result (ByteString, ByteString))
-> ControlParser ByteString
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((ByteString -> Result (ByteString, ByteString))
 -> ControlParser ByteString)
-> (ByteString -> Result (ByteString, ByteString))
-> ControlParser ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
    let newlines :: [Int]
newlines = Char -> ByteString -> [Int]
C.elemIndices Char
'\n' ByteString
bs
        rest :: [Int]
rest = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Int -> Bool
continuedAfter [Int]
newlines [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [ByteString -> Int
C.length ByteString
bs]
        continuedAfter :: Int -> Bool
continuedAfter Int
i = ByteString
bs ByteString -> Int -> Maybe Char
`safeIndex` (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Maybe Char -> [Maybe Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char -> Maybe Char) -> [Char] -> [Maybe Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Maybe Char
forall a. a -> Maybe a
Just [Char]
" \t#"
        (ByteString
text, ByteString
bs') = Int -> ByteString -> (ByteString, ByteString)
C.splitAt ([Int] -> Int
forall a. [a] -> a
head [Int]
rest) ByteString
bs
    in (ByteString, ByteString) -> Result (ByteString, ByteString)
forall a. a -> Result a
Ok (ByteString
text, ByteString
bs')

pField :: ControlParser Field
pField :: ControlParser Field
pField =
    do ByteString
k <- ControlParser ByteString
pKey
       Char
_ <- Char -> Parser ByteString Char
pChar Char
':'
       ByteString
v <- ControlParser ByteString
pValue
--       pChar '\n'
       (Char -> Parser ByteString Char
pChar Char
'\n' Parser ByteString Char
-> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ByteString ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
pEOF
       Field -> ControlParser Field
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString) -> Field
forall a. (a, a) -> Field' a
Field (ByteString
k,ByteString
v))

pComment :: ControlParser Field
pComment :: ControlParser Field
pComment = (ByteString -> Result (Field, ByteString)) -> ControlParser Field
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((ByteString -> Result (Field, ByteString)) -> ControlParser Field)
-> (ByteString -> Result (Field, ByteString))
-> ControlParser Field
forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
    let newlines :: [Int]
newlines = Char -> ByteString -> [Int]
C.elemIndices Char
'\n' ByteString
bs
        linestarts :: [Int]
linestarts = Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
newlines
        rest :: [Int]
rest = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Int -> Bool
commentAt [Int]
linestarts [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [ByteString -> Int
C.length ByteString
bs]
        commentAt :: Int -> Bool
commentAt Int
i = ByteString
bs ByteString -> Int -> Maybe Char
`safeIndex` Int
i Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'#'
        (ByteString
text, ByteString
bs') = Int -> ByteString -> (ByteString, ByteString)
C.splitAt ([Int] -> Int
forall a. [a] -> a
head [Int]
rest) ByteString
bs
    in if ByteString -> Bool
C.null ByteString
text
       then Result (Field, ByteString)
forall a. Result a
Empty
       else (Field, ByteString) -> Result (Field, ByteString)
forall a. a -> Result a
Ok (ByteString -> Field
forall a. a -> Field' a
Comment ByteString
text, ByteString
bs')

pParagraph :: ControlParser Paragraph
pParagraph :: ControlParser Paragraph
pParagraph =
    do [Field]
f <- ControlParser Field -> Parser ByteString [Field]
forall st a. Parser st a -> Parser st [a]
pMany1 (ControlParser Field
pComment ControlParser Field -> ControlParser Field -> ControlParser Field
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ControlParser Field
pField)
       Parser ByteString Char -> Parser ByteString ()
forall st a. Parser st a -> Parser st ()
pSkipMany (Char -> Parser ByteString Char
pChar Char
'\n')
       Paragraph -> ControlParser Paragraph
forall (m :: * -> *) a. Monad m => a -> m a
return ([Field] -> Paragraph
forall a. [Field' a] -> Paragraph' a
Paragraph [Field]
f)

pControl :: ControlParser Control
pControl :: ControlParser Control
pControl =
    do Parser ByteString Char -> Parser ByteString ()
forall st a. Parser st a -> Parser st ()
pSkipMany (Char -> Parser ByteString Char
pChar Char
'\n')
       [Paragraph]
c <- ControlParser Paragraph -> Parser ByteString [Paragraph]
forall st a. Parser st a -> Parser st [a]
pMany ControlParser Paragraph
pParagraph
       Control -> ControlParser Control
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Control
forall a. [Paragraph' a] -> Control' a
Control [Paragraph]
c)


-- parseControlFromFile :: FilePath -> IO (Either String Control)

instance ControlFunctions C.ByteString where
    parseControlFromFile :: [Char] -> IO (Either ParseError Control)
parseControlFromFile [Char]
fp =
        do ByteString
c <- [Char] -> IO ByteString
C.readFile [Char]
fp
           case ControlParser Control -> ByteString -> Maybe (Control, ByteString)
forall state a. Parser state a -> state -> Maybe (a, state)
parse ControlParser Control
pControl ByteString
c of
             Maybe (Control, ByteString)
Nothing -> Either ParseError Control -> IO (Either ParseError Control)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError -> Either ParseError Control
forall a b. a -> Either a b
Left (Message -> SourcePos -> ParseError
newErrorMessage ([Char] -> Message
Message ([Char]
"Failed to parse " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fp)) ([Char] -> Int -> Int -> SourcePos
newPos [Char]
fp Int
0 Int
0)))
             (Just (Control
cntl,ByteString
_)) -> Either ParseError Control -> IO (Either ParseError Control)
forall (m :: * -> *) a. Monad m => a -> m a
return (Control -> Either ParseError Control
forall a b. b -> Either a b
Right Control
cntl)
    parseControlFromHandle :: [Char] -> Handle -> IO (Either ParseError Control)
parseControlFromHandle [Char]
sourceName Handle
handle =
        IO ByteString -> IO (Either SomeException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (Handle -> IO ByteString
C.hGetContents Handle
handle) IO (Either SomeException ByteString)
-> (Either SomeException ByteString
    -> IO (Either ParseError Control))
-> IO (Either ParseError Control)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        (SomeException -> IO (Either ParseError Control))
-> (ByteString -> IO (Either ParseError Control))
-> Either SomeException ByteString
-> IO (Either ParseError Control)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
e :: E.SomeException) -> [Char] -> IO (Either ParseError Control)
forall a. HasCallStack => [Char] -> a
error ([Char]
"parseControlFromHandle ByteString: Failure parsing " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
sourceName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)) (Either ParseError Control -> IO (Either ParseError Control)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError Control -> IO (Either ParseError Control))
-> (ByteString -> Either ParseError Control)
-> ByteString
-> IO (Either ParseError Control)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString -> Either ParseError Control
forall a.
ControlFunctions a =>
[Char] -> a -> Either ParseError (Control' a)
parseControl [Char]
sourceName)
    parseControl :: [Char] -> ByteString -> Either ParseError Control
parseControl [Char]
sourceName ByteString
c =
        do case ControlParser Control -> ByteString -> Maybe (Control, ByteString)
forall state a. Parser state a -> state -> Maybe (a, state)
parse ControlParser Control
pControl ByteString
c of
             Maybe (Control, ByteString)
Nothing -> ParseError -> Either ParseError Control
forall a b. a -> Either a b
Left (Message -> SourcePos -> ParseError
newErrorMessage ([Char] -> Message
Message ([Char]
"Failed to parse " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
sourceName)) ([Char] -> Int -> Int -> SourcePos
newPos [Char]
sourceName Int
0 Int
0))
             Just (Control
cntl,ByteString
_) -> Control -> Either ParseError Control
forall a b. b -> Either a b
Right Control
cntl
    lookupP :: [Char] -> Paragraph -> Maybe Field
lookupP [Char]
fieldName (Paragraph [Field]
fields) =
        let pFieldName :: ByteString
pFieldName = [Char] -> ByteString
C.pack ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
fieldName) in
        (Field -> Bool) -> [Field] -> Maybe Field
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ (Field (ByteString
fieldName',ByteString
_)) -> (Char -> Char) -> ByteString -> ByteString
C.map Char -> Char
toLower ByteString
fieldName' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
pFieldName) [Field]
fields
    -- NOTE: probably inefficient
    stripWS :: ByteString -> ByteString
stripWS = ByteString -> ByteString
C.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
strip (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
C.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
strip
        where strip :: ByteString -> ByteString
strip = (Char -> Bool) -> ByteString -> ByteString
C.dropWhile ((Char -> [Char] -> Bool) -> [Char] -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char
' ', Char
'\t'])
    protectFieldText :: ByteString -> ByteString
protectFieldText = ByteString -> ByteString
protectFieldText'
    asString :: ByteString -> [Char]
asString = ByteString -> [Char]
C.unpack

protectFieldText' :: C.ByteString -> C.ByteString
protectFieldText' :: ByteString -> ByteString
protectFieldText' ByteString
s =
    case ByteString -> [ByteString]
C.lines ByteString
s of
      [] -> ByteString
forall a. Monoid a => a
mempty
      (ByteString
l : [ByteString]
ls) -> (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd Char -> Bool
isSpace (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
C.unlines ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
l ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
protect [ByteString]
ls
    where
      dropWhileEnd :: (Char -> Bool) -> C.ByteString -> C.ByteString
      dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd Char -> Bool
func = ByteString -> ByteString
C.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
C.dropWhile Char -> Bool
func (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
C.reverse
      protect :: C.ByteString -> C.ByteString
      protect :: ByteString -> ByteString
protect ByteString
l = ByteString -> (Char -> ByteString) -> Maybe Char -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
forall a. Monoid a => a
mempty (\ Char
c -> if Char -> Bool
isHorizSpace Char
c then ByteString
l else Char -> ByteString -> ByteString
C.cons Char
' ' ByteString
l) ((Char -> Bool) -> ByteString -> Maybe Char
C.find (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True :: Char -> Bool) ByteString
l)
      isHorizSpace :: Char -> Bool
isHorizSpace Char
c = Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c [Char]
" \t"

{-
main =
    do [fp] <- getArgs
       C.readFile fp >>= \c -> maybe (putStrLn "failed.") (print . length . fst) (parse pControl c)
-}
-- * Helper Functions

safeIndex :: C.ByteString -> Int -> Maybe Char
ByteString
bs safeIndex :: ByteString -> Int -> Maybe Char
`safeIndex` Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
C.length ByteString
bs then Char -> Maybe Char
forall a. a -> Maybe a
Just (ByteString
bs ByteString -> Int -> Char
`C.index` Int
i) else Maybe Char
forall a. Maybe a
Nothing

-- * Parser

data Result a
    = Ok a
    | Fail
    | Empty
      deriving Int -> Result a -> [Char] -> [Char]
[Result a] -> [Char] -> [Char]
Result a -> [Char]
(Int -> Result a -> [Char] -> [Char])
-> (Result a -> [Char])
-> ([Result a] -> [Char] -> [Char])
-> Show (Result a)
forall a. Show a => Int -> Result a -> [Char] -> [Char]
forall a. Show a => [Result a] -> [Char] -> [Char]
forall a. Show a => Result a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Result a] -> [Char] -> [Char]
$cshowList :: forall a. Show a => [Result a] -> [Char] -> [Char]
show :: Result a -> [Char]
$cshow :: forall a. Show a => Result a -> [Char]
showsPrec :: Int -> Result a -> [Char] -> [Char]
$cshowsPrec :: forall a. Show a => Int -> Result a -> [Char] -> [Char]
Show

-- m2r :: Maybe a -> Result a
-- m2r (Just a) = Ok a
-- m2r Nothing = Empty

r2m :: Result a -> Maybe a
r2m :: Result a -> Maybe a
r2m (Ok a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
r2m Result a
_ = Maybe a
forall a. Maybe a
Nothing

newtype Parser state a = Parser { Parser state a -> state -> Result (a, state)
unParser :: (state -> Result (a, state)) }

instance Functor (Parser state) where
    fmap :: (a -> b) -> Parser state a -> Parser state b
fmap a -> b
f Parser state a
m =
        (state -> Result (b, state)) -> Parser state b
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((state -> Result (b, state)) -> Parser state b)
-> (state -> Result (b, state)) -> Parser state b
forall a b. (a -> b) -> a -> b
$ \ state
state ->
            let r :: Result (a, state)
r = (Parser state a -> state -> Result (a, state)
forall state a. Parser state a -> state -> Result (a, state)
unParser Parser state a
m) state
state in
            case Result (a, state)
r of
              Ok (a
a,state
state') -> (b, state) -> Result (b, state)
forall a. a -> Result a
Ok (a -> b
f a
a,state
state')
              Result (a, state)
Empty -> Result (b, state)
forall a. Result a
Empty
              Result (a, state)
Fail -> Result (b, state)
forall a. Result a
Fail

instance Applicative (Parser state) where
    pure :: a -> Parser state a
pure = a -> Parser state a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: Parser state (a -> b) -> Parser state a -> Parser state b
(<*>) = Parser state (a -> b) -> Parser state a -> Parser state b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Alternative (Parser state) where
    empty :: Parser state a
empty =
        (state -> Result (a, state)) -> Parser state a
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((state -> Result (a, state)) -> Parser state a)
-> (state -> Result (a, state)) -> Parser state a
forall a b. (a -> b) -> a -> b
$ \state
state ->
            (Parser state a -> state -> Result (a, state)
forall state a. Parser state a -> state -> Result (a, state)
unParser Parser state a
forall (m :: * -> *) a. MonadPlus m => m a
mzero) state
state
    <|> :: Parser state a -> Parser state a -> Parser state a
(<|>) = Parser state a -> Parser state a -> Parser state a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monad (Parser state) where
    return :: a -> Parser state a
return a
a = (state -> Result (a, state)) -> Parser state a
forall state a. (state -> Result (a, state)) -> Parser state a
Parser (\state
s -> (a, state) -> Result (a, state)
forall a. a -> Result a
Ok (a
a,state
s))
    Parser state a
m >>= :: Parser state a -> (a -> Parser state b) -> Parser state b
>>= a -> Parser state b
f =
        (state -> Result (b, state)) -> Parser state b
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((state -> Result (b, state)) -> Parser state b)
-> (state -> Result (b, state)) -> Parser state b
forall a b. (a -> b) -> a -> b
$ \state
state ->
            let r :: Result (a, state)
r = (Parser state a -> state -> Result (a, state)
forall state a. Parser state a -> state -> Result (a, state)
unParser Parser state a
m) state
state in
            case Result (a, state)
r of
              Ok (a
a,state
state') ->
                  case Parser state b -> state -> Result (b, state)
forall state a. Parser state a -> state -> Result (a, state)
unParser (a -> Parser state b
f a
a) (state -> Result (b, state)) -> state -> Result (b, state)
forall a b. (a -> b) -> a -> b
$ state
state' of
                    Result (b, state)
Empty -> Result (b, state)
forall a. Result a
Fail
                    Result (b, state)
o -> Result (b, state)
o
              Result (a, state)
Empty -> Result (b, state)
forall a. Result a
Empty
              Result (a, state)
Fail -> Result (b, state)
forall a. Result a
Fail

instance MonadPlus (Parser state) where
    mzero :: Parser state a
mzero = (state -> Result (a, state)) -> Parser state a
forall state a. (state -> Result (a, state)) -> Parser state a
Parser (Result (a, state) -> state -> Result (a, state)
forall a b. a -> b -> a
const Result (a, state)
forall a. Result a
Empty)
    mplus :: Parser state a -> Parser state a -> Parser state a
mplus (Parser state -> Result (a, state)
p1) (Parser state -> Result (a, state)
p2) =
        (state -> Result (a, state)) -> Parser state a
forall state a. (state -> Result (a, state)) -> Parser state a
Parser (\state
s -> case state -> Result (a, state)
p1 state
s of
                        Result (a, state)
Empty -> state -> Result (a, state)
p2 state
s
                        Result (a, state)
o -> Result (a, state)
o
               )

--       Parser (\s -> maybe (p2 s) (Just) (p1 s))


_pSucceed :: a -> Parser state a
_pSucceed :: a -> Parser state a
_pSucceed = a -> Parser state a
forall (m :: * -> *) a. Monad m => a -> m a
return

_pFail :: Parser state a
_pFail :: Parser state a
_pFail = (state -> Result (a, state)) -> Parser state a
forall state a. (state -> Result (a, state)) -> Parser state a
Parser (Result (a, state) -> state -> Result (a, state)
forall a b. a -> b -> a
const Result (a, state)
forall a. Result a
Empty)


satisfy :: (Char -> Bool) -> Parser C.ByteString Char
satisfy :: (Char -> Bool) -> Parser ByteString Char
satisfy Char -> Bool
f =
    (ByteString -> Result (Char, ByteString)) -> Parser ByteString Char
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((ByteString -> Result (Char, ByteString))
 -> Parser ByteString Char)
-> (ByteString -> Result (Char, ByteString))
-> Parser ByteString Char
forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
        if ByteString -> Bool
C.null ByteString
bs
        then Result (Char, ByteString)
forall a. Result a
Empty
        else let (Char
s,ByteString
ss) = (ByteString -> Char
C.head ByteString
bs, ByteString -> ByteString
C.tail ByteString
bs) in
             if (Char -> Bool
f Char
s)
                then (Char, ByteString) -> Result (Char, ByteString)
forall a. a -> Result a
Ok (Char
s,ByteString
ss)
                else Result (Char, ByteString)
forall a. Result a
Empty

pChar :: Char -> Parser C.ByteString Char
pChar :: Char -> Parser ByteString Char
pChar Char
c = (Char -> Bool) -> Parser ByteString Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
c)


_try :: Parser state a -> Parser state a
_try :: Parser state a -> Parser state a
_try (Parser state -> Result (a, state)
p) =
    (state -> Result (a, state)) -> Parser state a
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((state -> Result (a, state)) -> Parser state a)
-> (state -> Result (a, state)) -> Parser state a
forall a b. (a -> b) -> a -> b
$ \state
bs -> case (state -> Result (a, state)
p state
bs) of
                      Result (a, state)
Fail -> Result (a, state)
forall a. Result a
Empty
                      Result (a, state)
o -> Result (a, state)
o

pEOF :: Parser C.ByteString ()
pEOF :: Parser ByteString ()
pEOF =
    (ByteString -> Result ((), ByteString)) -> Parser ByteString ()
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((ByteString -> Result ((), ByteString)) -> Parser ByteString ())
-> (ByteString -> Result ((), ByteString)) -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> if ByteString -> Bool
C.null ByteString
bs then ((), ByteString) -> Result ((), ByteString)
forall a. a -> Result a
Ok ((),ByteString
bs) else Result ((), ByteString)
forall a. Result a
Empty

pTakeWhile :: (Char -> Bool) -> Parser C.ByteString C.ByteString
pTakeWhile :: (Char -> Bool) -> ControlParser ByteString
pTakeWhile Char -> Bool
f =
    (ByteString -> Result (ByteString, ByteString))
-> ControlParser ByteString
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((ByteString -> Result (ByteString, ByteString))
 -> ControlParser ByteString)
-> (ByteString -> Result (ByteString, ByteString))
-> ControlParser ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> (ByteString, ByteString) -> Result (ByteString, ByteString)
forall a. a -> Result a
Ok ((Char -> Bool) -> ByteString -> (ByteString, ByteString)
C.span Char -> Bool
f ByteString
bs)

_pSkipWhile :: (Char -> Bool) -> Parser C.ByteString ()
_pSkipWhile :: (Char -> Bool) -> Parser ByteString ()
_pSkipWhile Char -> Bool
p =
    (ByteString -> Result ((), ByteString)) -> Parser ByteString ()
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((ByteString -> Result ((), ByteString)) -> Parser ByteString ())
-> (ByteString -> Result ((), ByteString)) -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> ((), ByteString) -> Result ((), ByteString)
forall a. a -> Result a
Ok ((), (Char -> Bool) -> ByteString -> ByteString
C.dropWhile Char -> Bool
p ByteString
bs)

pMany ::  Parser st a -> Parser st [a]
pMany :: Parser st a -> Parser st [a]
pMany Parser st a
p
    = ([a] -> [a]) -> Parser st [a]
forall a. ([a] -> a) -> Parser st a
scan [a] -> [a]
forall a. a -> a
id
    where
      scan :: ([a] -> a) -> Parser st a
scan [a] -> a
f = do a
x <- Parser st a
p
                  ([a] -> a) -> Parser st a
scan (\[a]
tail -> [a] -> a
f (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
tail))
               Parser st a -> Parser st a -> Parser st a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser st a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> a
f [])

notEmpty :: Parser st C.ByteString -> Parser st C.ByteString
notEmpty :: Parser st ByteString -> Parser st ByteString
notEmpty (Parser st -> Result (ByteString, st)
p) =
    (st -> Result (ByteString, st)) -> Parser st ByteString
forall state a. (state -> Result (a, state)) -> Parser state a
Parser ((st -> Result (ByteString, st)) -> Parser st ByteString)
-> (st -> Result (ByteString, st)) -> Parser st ByteString
forall a b. (a -> b) -> a -> b
$ \st
s -> case st -> Result (ByteString, st)
p st
s of
                     o :: Result (ByteString, st)
o@(Ok (ByteString
a, st
_s)) ->
                         if ByteString -> Bool
C.null ByteString
a
                         then Result (ByteString, st)
forall a. Result a
Empty
                         else Result (ByteString, st)
o
                     Result (ByteString, st)
x -> Result (ByteString, st)
x

pMany1 :: Parser st a -> Parser st [a]
pMany1 :: Parser st a -> Parser st [a]
pMany1 Parser st a
p =
    do a
x <- Parser st a
p
       [a]
xs <- Parser st a -> Parser st [a]
forall st a. Parser st a -> Parser st [a]
pMany Parser st a
p
       [a] -> Parser st [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

pSkipMany :: Parser st a -> Parser st ()
pSkipMany :: Parser st a -> Parser st ()
pSkipMany Parser st a
p = Parser st ()
scan
    where
      scan :: Parser st ()
scan = (Parser st a
p Parser st a -> Parser st () -> Parser st ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser st ()
scan) Parser st () -> Parser st () -> Parser st ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser st ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

_pSkipMany1 :: Parser st a -> Parser st ()
_pSkipMany1 :: Parser st a -> Parser st ()
_pSkipMany1 Parser st a
p = Parser st a
p Parser st a -> Parser st () -> Parser st ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser st a -> Parser st ()
forall st a. Parser st a -> Parser st ()
pSkipMany Parser st a
p

parse :: Parser state a -> state -> Maybe (a, state)
parse :: Parser state a -> state -> Maybe (a, state)
parse Parser state a
p state
s = Result (a, state) -> Maybe (a, state)
forall a. Result a -> Maybe a
r2m ((Parser state a -> state -> Result (a, state)
forall state a. Parser state a -> state -> Result (a, state)
unParser Parser state a
p) state
s)