module Network.StackExchange.Response
(
SEException(..), askSE, render
, aeson
, field, fields
) where
import Control.Applicative ((<$>))
import Control.Exception (Exception, throwIO)
import Control.Category ((>>>))
import Control.Monad ((<=<))
import Data.Monoid (Monoid(..))
import Data.Typeable (Typeable)
import Data.ByteString.Lazy (ByteString, toStrict)
import Control.Lens
import Data.Aeson (FromJSON, Value, (.:), parseJSON)
import qualified Data.Aeson.Types as A
import Data.Default (Default(..))
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text.Lazy as T
import Data.Text.Lazy.Encoding (encodeUtf8)
import qualified Network.HTTP.Conduit as C
import Network.StackExchange.Request
data SEException = SEException
{ _data ∷ ByteString
, _error ∷ String
} deriving (Show, Typeable)
instance Exception SEException
askSE ∷ Request Ready n r → IO r
askSE (mappend def → q@Request {_method, _parse}) = do
r ← C.withManager $ \m → C.parseUrl (render q) >>= \url →
C.responseBody <$> C.httpLbs (url {C.method = toStrict $ encodeUtf8 _method}) m
case _parse of
Just f → return $ f r
Nothing → throwIO $
SEException r "libstackexchange.askSE: no parsing function registered"
render ∷ Request a n r → String
render Request {_host, _path, _query} = T.unpack $ mconcat [_host, "/", _path, "?", argie _query]
where
argie = T.intercalate "&" . M.foldrWithKey (\k v m → T.concat [k, "=", v] : m) mempty
aeson ∷ Monad m ⇒ (a → A.Parser b) → Action m a b
aeson p = act $ A.parse p >>> \case
A.Success v → return v
A.Error g → fail g
field ∷ (Monad m, FromJSON a) ⇒ Text → Action m (SE x) a
field xs = aeson ((.: xs) <=< parseJSON . unSE)
fields ∷ (Monad m, FromJSON a) ⇒ Text → Action m Value [a]
fields xs = aeson $ mapM (.: xs) <=< parseJSON