{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.BEncode.Reader
-- Copyright   :  (c) 2015 Matthew Leon <ml@matthewleon.com>
-- License     :  BSD3
-- Maintainer  :  creichert07@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Reader monad and combinators for BEncoded data.
--
-- This is intended to replace the older "Data.BEncode.Parser" module.
--
-- Usage example:
--
-- >>> :set -XOverloadedStrings
-- >>> let bd = (BDict $ Map.fromList [("baz", BInt 1), ("foo", BString "bar")])
-- >>> :{
-- let bReader = do
--       baz <- dict "baz" bint
--       foo <- dict "foo" bstring
--       shouldBeNothing <- optional $ dict "optionalKey" bint
--       return (foo, baz, shouldBeNothing)
-- in runBReader bReader bd
-- :}
-- Right ("bar",1,Nothing)
-----------------------------------------------------------------------------

module Data.BEncode.Reader (
    -- * Reader Monad
    BReader, runBReader,
    -- * Combinators
    bint, bbytestring, bstring, optional, list, dict
    ) where

import           Control.Applicative
import           Control.Monad              (MonadPlus)
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.Except
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map                   as Map

import           Data.BEncode

-----------------------------------------------------------------------------
-----------------------------------------------------------------------------

newtype BReader a = BReader (ExceptT String (Reader BEncode) a)
    deriving (a -> BReader b -> BReader a
(a -> b) -> BReader a -> BReader b
(forall a b. (a -> b) -> BReader a -> BReader b)
-> (forall a b. a -> BReader b -> BReader a) -> Functor BReader
forall a b. a -> BReader b -> BReader a
forall a b. (a -> b) -> BReader a -> BReader b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BReader b -> BReader a
$c<$ :: forall a b. a -> BReader b -> BReader a
fmap :: (a -> b) -> BReader a -> BReader b
$cfmap :: forall a b. (a -> b) -> BReader a -> BReader b
Functor, Functor BReader
a -> BReader a
Functor BReader =>
(forall a. a -> BReader a)
-> (forall a b. BReader (a -> b) -> BReader a -> BReader b)
-> (forall a b c.
    (a -> b -> c) -> BReader a -> BReader b -> BReader c)
-> (forall a b. BReader a -> BReader b -> BReader b)
-> (forall a b. BReader a -> BReader b -> BReader a)
-> Applicative BReader
BReader a -> BReader b -> BReader b
BReader a -> BReader b -> BReader a
BReader (a -> b) -> BReader a -> BReader b
(a -> b -> c) -> BReader a -> BReader b -> BReader c
forall a. a -> BReader a
forall a b. BReader a -> BReader b -> BReader a
forall a b. BReader a -> BReader b -> BReader b
forall a b. BReader (a -> b) -> BReader a -> BReader b
forall a b c. (a -> b -> c) -> BReader a -> BReader b -> BReader c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: BReader a -> BReader b -> BReader a
$c<* :: forall a b. BReader a -> BReader b -> BReader a
*> :: BReader a -> BReader b -> BReader b
$c*> :: forall a b. BReader a -> BReader b -> BReader b
liftA2 :: (a -> b -> c) -> BReader a -> BReader b -> BReader c
$cliftA2 :: forall a b c. (a -> b -> c) -> BReader a -> BReader b -> BReader c
<*> :: BReader (a -> b) -> BReader a -> BReader b
$c<*> :: forall a b. BReader (a -> b) -> BReader a -> BReader b
pure :: a -> BReader a
$cpure :: forall a. a -> BReader a
$cp1Applicative :: Functor BReader
Applicative, Applicative BReader
BReader a
Applicative BReader =>
(forall a. BReader a)
-> (forall a. BReader a -> BReader a -> BReader a)
-> (forall a. BReader a -> BReader [a])
-> (forall a. BReader a -> BReader [a])
-> Alternative BReader
BReader a -> BReader a -> BReader a
BReader a -> BReader [a]
BReader a -> BReader [a]
forall a. BReader a
forall a. BReader a -> BReader [a]
forall a. BReader a -> BReader a -> BReader a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: BReader a -> BReader [a]
$cmany :: forall a. BReader a -> BReader [a]
some :: BReader a -> BReader [a]
$csome :: forall a. BReader a -> BReader [a]
<|> :: BReader a -> BReader a -> BReader a
$c<|> :: forall a. BReader a -> BReader a -> BReader a
empty :: BReader a
$cempty :: forall a. BReader a
$cp1Alternative :: Applicative BReader
Alternative, Applicative BReader
a -> BReader a
Applicative BReader =>
(forall a b. BReader a -> (a -> BReader b) -> BReader b)
-> (forall a b. BReader a -> BReader b -> BReader b)
-> (forall a. a -> BReader a)
-> Monad BReader
BReader a -> (a -> BReader b) -> BReader b
BReader a -> BReader b -> BReader b
forall a. a -> BReader a
forall a b. BReader a -> BReader b -> BReader b
forall a b. BReader a -> (a -> BReader b) -> BReader b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> BReader a
$creturn :: forall a. a -> BReader a
>> :: BReader a -> BReader b -> BReader b
$c>> :: forall a b. BReader a -> BReader b -> BReader b
>>= :: BReader a -> (a -> BReader b) -> BReader b
$c>>= :: forall a b. BReader a -> (a -> BReader b) -> BReader b
$cp1Monad :: Applicative BReader
Monad, Monad BReader
Alternative BReader
BReader a
(Alternative BReader, Monad BReader) =>
(forall a. BReader a)
-> (forall a. BReader a -> BReader a -> BReader a)
-> MonadPlus BReader
BReader a -> BReader a -> BReader a
forall a. BReader a
forall a. BReader a -> BReader a -> BReader a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
mplus :: BReader a -> BReader a -> BReader a
$cmplus :: forall a. BReader a -> BReader a -> BReader a
mzero :: BReader a
$cmzero :: forall a. BReader a
$cp2MonadPlus :: Monad BReader
$cp1MonadPlus :: Alternative BReader
MonadPlus)
-- ^Reader monad for extracting data from a BEncoded structure.

breader :: (BEncode -> (Either String a)) -> BReader a
breader :: (BEncode -> Either String a) -> BReader a
breader = ExceptT String (Reader BEncode) a -> BReader a
forall a. ExceptT String (Reader BEncode) a -> BReader a
BReader (ExceptT String (Reader BEncode) a -> BReader a)
-> ((BEncode -> Either String a)
    -> ExceptT String (Reader BEncode) a)
-> (BEncode -> Either String a)
-> BReader a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT BEncode Identity (Either String a)
-> ExceptT String (Reader BEncode) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (ReaderT BEncode Identity (Either String a)
 -> ExceptT String (Reader BEncode) a)
-> ((BEncode -> Either String a)
    -> ReaderT BEncode Identity (Either String a))
-> (BEncode -> Either String a)
-> ExceptT String (Reader BEncode) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BEncode -> Either String a)
-> ReaderT BEncode Identity (Either String a)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader
-- ^BReader constructor. Private.

runBReader :: BReader a -> BEncode -> Either String a
runBReader :: BReader a -> BEncode -> Either String a
runBReader (BReader br :: ExceptT String (Reader BEncode) a
br) = Reader BEncode (Either String a) -> BEncode -> Either String a
forall r a. Reader r a -> r -> a
runReader (Reader BEncode (Either String a) -> BEncode -> Either String a)
-> Reader BEncode (Either String a) -> BEncode -> Either String a
forall a b. (a -> b) -> a -> b
$ ExceptT String (Reader BEncode) a
-> Reader BEncode (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT String (Reader BEncode) a
br
-- ^Run a BReader. See usage examples elsewhere in this file.

-----------------------------------------------------------------------------
-----------------------------------------------------------------------------

bbytestring :: BReader L.ByteString
bbytestring :: BReader ByteString
bbytestring = (BEncode -> Either String ByteString) -> BReader ByteString
forall a. (BEncode -> Either String a) -> BReader a
breader ((BEncode -> Either String ByteString) -> BReader ByteString)
-> (BEncode -> Either String ByteString) -> BReader ByteString
forall a b. (a -> b) -> a -> b
$ \b :: BEncode
b -> case BEncode
b of
    BString str :: ByteString
str -> ByteString -> Either String ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
str
    _ -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ "Expected BString, found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BEncode -> String
forall a. Show a => a -> String
show BEncode
b
-- ^ Usage same as bstring, below.
-- (sadly, doctests for this cause errors on GHC 7.4)

bstring :: BReader String
bstring :: BReader String
bstring = (ByteString -> String) -> BReader ByteString -> BReader String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
L.unpack BReader ByteString
bbytestring
-- ^
-- >>> runBReader bstring (BString "foo")
-- Right "foo"
--

bint :: BReader Integer
bint :: BReader Integer
bint = (BEncode -> Either String Integer) -> BReader Integer
forall a. (BEncode -> Either String a) -> BReader a
breader ((BEncode -> Either String Integer) -> BReader Integer)
-> (BEncode -> Either String Integer) -> BReader Integer
forall a b. (a -> b) -> a -> b
$ \b :: BEncode
b -> case BEncode
b of
    BInt int :: Integer
int -> Integer -> Either String Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
int
    _ -> String -> Either String Integer
forall a b. a -> Either a b
Left (String -> Either String Integer)
-> String -> Either String Integer
forall a b. (a -> b) -> a -> b
$ "Expected BInt, found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BEncode -> String
forall a. Show a => a -> String
show BEncode
b
-- ^
-- >>> runBReader bint (BInt 42)
-- Right 42
--

list :: BReader a -> BReader [a]
list :: BReader a -> BReader [a]
list br :: BReader a
br = (BEncode -> Either String [a]) -> BReader [a]
forall a. (BEncode -> Either String a) -> BReader a
breader ((BEncode -> Either String [a]) -> BReader [a])
-> (BEncode -> Either String [a]) -> BReader [a]
forall a b. (a -> b) -> a -> b
$ \b :: BEncode
b -> case BEncode
b of
    BList bs :: [BEncode]
bs -> (BEncode -> Either String a) -> [BEncode] -> Either String [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (BReader a -> BEncode -> Either String a
forall a. BReader a -> BEncode -> Either String a
runBReader BReader a
br) [BEncode]
bs
    _ -> String -> Either String [a]
forall a b. a -> Either a b
Left (String -> Either String [a]) -> String -> Either String [a]
forall a b. (a -> b) -> a -> b
$ "Not a list: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BEncode -> String
forall a. Show a => a -> String
show BEncode
b
-- ^ Read a list of BEncoded data
--
-- >>> runBReader (list bint) (BList [BInt 1, BInt 2])
-- Right [1,2]
--
-- >>> runBReader (list bint) (BList [])
-- Right []
--
-- >>> let bs = (BList [BList [BString "foo", BString "bar"], BList []])
-- >>> runBReader (list $ list bstring) bs
-- Right [["foo","bar"],[]]

dict :: String -> BReader a -> BReader a
dict :: String -> BReader a -> BReader a
dict name :: String
name br :: BReader a
br = (BEncode -> Either String a) -> BReader a
forall a. (BEncode -> Either String a) -> BReader a
breader ((BEncode -> Either String a) -> BReader a)
-> (BEncode -> Either String a) -> BReader a
forall a b. (a -> b) -> a -> b
$ \b :: BEncode
b -> case BEncode
b of
    BDict bmap :: Map String BEncode
bmap | (Just code :: 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 -> BReader a -> BEncode -> Either String a
forall a. BReader a -> BEncode -> Either String a
runBReader BReader a
br BEncode
code
    BDict _ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ "Name not found in dictionary: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    _ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ "Not a dictionary: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BEncode -> String
forall a. Show a => a -> String
show BEncode
b
-- ^ Read the values of a BDict corresponding to a string key
--
-- >>> let bd = (BDict $ Map.fromList [("bar", BInt 2), ("foo", BInt 1)])
-- >>> runBReader (dict "foo" bint) bd
-- Right 1
--
--
-- >>> :{
-- let bs = (BList [BDict $ Map.fromList [("baz", BInt 2),
--                                        ("foo", BString "bar")],
--                  BDict $ Map.singleton "foo" (BString "bam")])
-- in runBReader (list $ dict "foo" bstring) bs
-- :}
-- Right ["bar","bam"]
--
-- >>> :{
-- let bd = (BDict $ Map.singleton "foo" (BList [
--             BString "foo", BString "bar"
--          ]))
-- in runBReader (dict "foo" $ list $ bstring) bd
-- :}
-- Right ["foo","bar"]