{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  BParser
-- Copyright   :  (c) 2005 Lemmih <lemmih@gmail.com>
-- License     :  BSD3
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  stable
-- Portability :  portable
--
-- A parsec style parser for BEncoded data
-----------------------------------------------------------------------------
module Data.BEncode.Parser {-#
    DEPRECATED "Use \"Data.BEncode.Reader\" instead" #-}
    ( BParser
    , runParser
    , token
    , dict
    , list
    , optional
    , bstring
    , bbytestring
    , bint
    , setInput
    , (<|>)
    ) where


import           Control.Applicative        hiding (optional)
import           Control.Monad
import           Data.BEncode
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map                   as Map

#if MIN_VERSION_base(4,13,0)
import qualified Control.Monad.Fail as Fail
#endif

data BParser a
    = BParser (BEncode -> Reply a)

instance Alternative BParser where
    <|> :: BParser a -> BParser a -> BParser a
(<|>) = BParser a -> BParser a -> BParser a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
    empty :: BParser a
empty = BParser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance MonadPlus BParser where
    mzero :: BParser a
mzero = (BEncode -> Reply a) -> BParser a
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply a) -> BParser a)
-> (BEncode -> Reply a) -> BParser a
forall a b. (a -> b) -> a -> b
$ \BEncode
_ -> String -> Reply a
forall a. String -> Reply a
Error String
"mzero"
    mplus :: BParser a -> BParser a -> BParser a
mplus (BParser BEncode -> Reply a
a) (BParser BEncode -> Reply a
b) = (BEncode -> Reply a) -> BParser a
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply a) -> BParser a)
-> (BEncode -> Reply a) -> BParser a
forall a b. (a -> b) -> a -> b
$ \BEncode
st -> case BEncode -> Reply a
a BEncode
st of
                                                       Error String
_err -> BEncode -> Reply a
b BEncode
st
                                                       Reply a
ok         -> Reply a
ok


runB :: BParser a -> BEncode -> Reply a
runB :: BParser a -> BEncode -> Reply a
runB (BParser BEncode -> Reply a
b) = BEncode -> Reply a
b

data Reply a
    = Ok a BEncode
    | Error String

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

instance Monad BParser where
    (BParser BEncode -> Reply a
p) >>= :: BParser a -> (a -> BParser b) -> BParser b
>>= a -> BParser b
f = (BEncode -> Reply b) -> BParser b
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply b) -> BParser b)
-> (BEncode -> Reply b) -> BParser b
forall a b. (a -> b) -> a -> b
$ \BEncode
b -> case BEncode -> Reply a
p BEncode
b of
                                          Ok a
a BEncode
b' -> BParser b -> BEncode -> Reply b
forall a. BParser a -> BEncode -> Reply a
runB (a -> BParser b
f a
a) BEncode
b'
                                          Error String
str -> String -> Reply b
forall a. String -> Reply a
Error String
str
    return :: a -> BParser a
return a
val = (BEncode -> Reply a) -> BParser a
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply a) -> BParser a)
-> (BEncode -> Reply a) -> BParser a
forall a b. (a -> b) -> a -> b
$ a -> BEncode -> Reply a
forall a. a -> BEncode -> Reply a
Ok a
val
#if MIN_VERSION_base(4,13,0)
instance Fail.MonadFail BParser where
#endif
    fail :: String -> BParser a
fail String
str = (BEncode -> Reply a) -> BParser a
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply a) -> BParser a)
-> (BEncode -> Reply a) -> BParser a
forall a b. (a -> b) -> a -> b
$ \BEncode
_ -> String -> Reply a
forall a. String -> Reply a
Error String
str

instance Functor BParser where
    fmap :: (a -> b) -> BParser a -> BParser b
fmap = (a -> b) -> BParser a -> BParser b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM


runParser :: BParser a -> BEncode -> Either String a
runParser :: BParser a -> BEncode -> Either String a
runParser BParser a
parser BEncode
b = case BParser a -> BEncode -> Reply a
forall a. BParser a -> BEncode -> Reply a
runB BParser a
parser BEncode
b of
                       Ok a
a BEncode
_ -> a -> Either String a
forall a b. b -> Either a b
Right a
a
                       Error String
str -> String -> Either String a
forall a b. a -> Either a b
Left String
str

token :: BParser BEncode
token :: BParser BEncode
token = (BEncode -> Reply BEncode) -> BParser BEncode
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply BEncode) -> BParser BEncode)
-> (BEncode -> Reply BEncode) -> BParser BEncode
forall a b. (a -> b) -> a -> b
$ \BEncode
b -> BEncode -> BEncode -> Reply BEncode
forall a. a -> BEncode -> Reply a
Ok BEncode
b BEncode
b

dict :: String -> BParser BEncode
dict :: String -> BParser BEncode
dict String
name = (BEncode -> Reply BEncode) -> BParser BEncode
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply BEncode) -> BParser BEncode)
-> (BEncode -> Reply BEncode) -> BParser BEncode
forall a b. (a -> b) -> a -> b
$ \BEncode
b -> case BEncode
b of
                              BDict Map String BEncode
bmap | Just BEncode
code <- String -> Map String BEncode -> Maybe BEncode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String BEncode
bmap
                                   -> BEncode -> BEncode -> Reply BEncode
forall a. a -> BEncode -> Reply a
Ok BEncode
code BEncode
b
                              BDict Map String BEncode
_ -> String -> Reply BEncode
forall a. String -> Reply a
Error (String -> Reply BEncode) -> String -> Reply BEncode
forall a b. (a -> b) -> a -> b
$ String
"Name not found in dictionary: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
                              BEncode
_ -> String -> Reply BEncode
forall a. String -> Reply a
Error (String -> Reply BEncode) -> String -> Reply BEncode
forall a b. (a -> b) -> a -> b
$ String
"Not a dictionary: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name

list :: String -> BParser a -> BParser [a]
list :: String -> BParser a -> BParser [a]
list String
name BParser a
p
    = String -> BParser BEncode
dict String
name BParser BEncode -> (BEncode -> BParser [a]) -> BParser [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \BEncode
lst ->
      (BEncode -> Reply [a]) -> BParser [a]
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply [a]) -> BParser [a])
-> (BEncode -> Reply [a]) -> BParser [a]
forall a b. (a -> b) -> a -> b
$ \BEncode
b -> case BEncode
lst of
                      BList [BEncode]
bs -> (BEncode -> Reply [a] -> Reply [a])
-> Reply [a] -> [BEncode] -> Reply [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Reply a -> Reply [a] -> Reply [a]
forall a. Reply a -> Reply [a] -> Reply [a]
cat (Reply a -> Reply [a] -> Reply [a])
-> (BEncode -> Reply a) -> BEncode -> Reply [a] -> Reply [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BParser a -> BEncode -> Reply a
forall a. BParser a -> BEncode -> Reply a
runB BParser a
p) ([a] -> BEncode -> Reply [a]
forall a. a -> BEncode -> Reply a
Ok [] BEncode
b) [BEncode]
bs
                      BEncode
_ -> String -> Reply [a]
forall a. String -> Reply a
Error (String -> Reply [a]) -> String -> Reply [a]
forall a b. (a -> b) -> a -> b
$ String
"Not a list: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    where cat :: Reply a -> Reply [a] -> Reply [a]
cat (Ok a
v BEncode
_) (Ok [a]
vs BEncode
b) = [a] -> BEncode -> Reply [a]
forall a. a -> BEncode -> Reply a
Ok (a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
vs) BEncode
b
          cat (Ok a
_ BEncode
_) (Error String
str) = String -> Reply [a]
forall a. String -> Reply a
Error String
str
          cat (Error String
str) Reply [a]
_ = String -> Reply [a]
forall a. String -> Reply a
Error String
str

optional :: BParser a -> BParser (Maybe a)
optional :: BParser a -> BParser (Maybe a)
optional BParser a
p = (a -> Maybe a) -> BParser a -> BParser (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just BParser a
p BParser (Maybe a) -> BParser (Maybe a) -> BParser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> BParser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

bstring :: BParser BEncode -> BParser String
bstring :: BParser BEncode -> BParser String
bstring BParser BEncode
p = do BEncode
b <- BParser BEncode
p
               case BEncode
b of
                 BString ByteString
str -> String -> BParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> String
L.unpack ByteString
str)
                 BEncode
_ -> String -> BParser String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BParser String) -> String -> BParser String
forall a b. (a -> b) -> a -> b
$ String
"Expected BString, found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BEncode -> String
forall a. Show a => a -> String
show BEncode
b

bbytestring :: BParser BEncode -> BParser L.ByteString
bbytestring :: BParser BEncode -> BParser ByteString
bbytestring BParser BEncode
p = do BEncode
b <- BParser BEncode
p
                   case BEncode
b of
                     BString ByteString
str -> ByteString -> BParser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
str
                     BEncode
_ -> String -> BParser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BParser ByteString) -> String -> BParser ByteString
forall a b. (a -> b) -> a -> b
$ String
"Expected BString, found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BEncode -> String
forall a. Show a => a -> String
show BEncode
b

bint :: BParser BEncode -> BParser Integer
bint :: BParser BEncode -> BParser Integer
bint BParser BEncode
p = do BEncode
b <- BParser BEncode
p
            case BEncode
b of
              BInt Integer
int -> Integer -> BParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
int
              BEncode
_ -> String -> BParser Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BParser Integer) -> String -> BParser Integer
forall a b. (a -> b) -> a -> b
$ String
"Expected BInt, found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BEncode -> String
forall a. Show a => a -> String
show BEncode
b

setInput :: BEncode -> BParser ()
setInput :: BEncode -> BParser ()
setInput BEncode
b = (BEncode -> Reply ()) -> BParser ()
forall a. (BEncode -> Reply a) -> BParser a
BParser ((BEncode -> Reply ()) -> BParser ())
-> (BEncode -> Reply ()) -> BParser ()
forall a b. (a -> b) -> a -> b
$ \BEncode
_ -> () -> BEncode -> Reply ()
forall a. a -> BEncode -> Reply a
Ok () BEncode
b