{-# 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 (Functor, Applicative, Alternative, Monad, MonadPlus)
-- ^Reader monad for extracting data from a BEncoded structure.

breader :: (BEncode -> (Either String a)) -> BReader a
breader = BReader . ExceptT . reader
-- ^BReader constructor. Private.

runBReader :: BReader a -> BEncode -> Either String a
runBReader (BReader br) = runReader $ runExceptT br
-- ^Run a BReader. See usage examples elsewhere in this file.

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

bbytestring :: BReader L.ByteString
bbytestring = breader $ \b -> case b of
    BString str -> return str
    _ -> Left $ "Expected BString, found: " ++ show b
-- ^ Usage same as bstring, below.
-- (sadly, doctests for this cause errors on GHC 7.4)

bstring :: BReader String
bstring = fmap L.unpack bbytestring
-- ^
-- >>> runBReader bstring (BString "foo")
-- Right "foo"
--

bint :: BReader Integer
bint = breader $ \b -> case b of
    BInt int -> return int
    _ -> Left $ "Expected BInt, found: " ++ show b
-- ^
-- >>> runBReader bint (BInt 42)
-- Right 42
--

list :: BReader a -> BReader [a]
list br = breader $ \b -> case b of
    BList bs -> mapM (runBReader br) bs
    _ -> Left $ "Not a list: " ++ show 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 name br = breader $ \b -> case b of
    BDict bmap | (Just code) <- Map.lookup name bmap -> runBReader br code
    BDict _ -> Left $ "Name not found in dictionary: " ++ name
    _ -> Left $ "Not a dictionary: " ++ show 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"]