darcsden :: pseudonymous -> 2chsotools -> blob

root / 2chso / src / TwoChSo.hs

{-# LANGUAGE FlexibleContexts #-}
module TwoChSo
    ( getLimits
    , getThreadsList
    , getThread
    , getPost
    , getBoardInfo
    , module TwoChSo.Types
    , module TwoChSo.Types.Exceptions
    , Query(..)
    ) where
import TwoChSo.Parsers
import TwoChSo.Types
import TwoChSo.Types.Exceptions
import TwoChSo.URI
import TwoChSo.Util
import Network.HTTP.Enumerator
import Data.Enumerator hiding (Error)
import Data.Attoparsec.Enumerator
import Data.Aeson (json)
import Data.Aeson.Types (Value, Parser, Result(..), parse)
import Data.Vector (Vector)
import Text.URI (URI)
import Control.Applicative
import Control.Failure (Failure(..))
import Control.Monad.IO.Class (MonadIO)
import Control.DeepSeq
import Prelude hiding (catch)


getAndParse ::
    ( Failure HttpException m
    , Failure ApiException m
    , Failure InvalidResponseException m
    , MonadIO m)
    => (Value -> Parser a)
    -> Manager
    -> URI
    -> m a
getAndParse parser manager uri = do
    req <- parseUrl (show uri)
    js <- run_ (httpRedirect req (\_ _ -> iterParser json) manager)
            `exception2failure` \(ParseError _ _) -> ResponseIsNotJson

    js `deepseq` case parse (withError parser) js of
                    Error str -> failure (ResponseParsingFailed str)
                    Success a -> a

-- | retrieve activity limits for a particular board
getLimits ::
    ( Failure HttpException m
    , Failure ApiException m
    , Failure InvalidResponseException m
    , MonadIO m)
    => Manager
    -> String -- ^ short board name
    -> m Limits
getLimits manager board =
    getAndParse limits manager (settingsJsonURI board)

-- | retrieve board miscellaneous information
getBoardInfo ::
    ( Failure HttpException m
    , Failure ApiException m
    , Failure InvalidResponseException m
    , MonadIO m)
    => Manager
    -> String -- ^ short board name
    -> m BoardInfo
getBoardInfo manager board =
    getAndParse boardInfo manager (settingsJsonURI board)

-- | retrieve list of board's threads
getThreadsList ::
    ( Failure HttpException m
    , Failure ApiException m
    , Failure InvalidResponseException m
    , MonadIO m)
    => Manager
    -> String    -- ^ short board name
    -> Maybe Int -- ^ pagination
    -> m (Vector (ThreadHeader, Post))
getThreadsList manager board pagination =
    getAndParse threadsList manager (listThreadsJsonURI board pagination)

-- | retrieve thread
getThread ::
    ( Failure HttpException m
    , Failure ApiException m
    , Failure InvalidResponseException m
    , MonadIO m)
    => Manager
    -> String   -- ^ short board name
    -> ThreadId -- ^ OP post id
    -> [Query]  -- ^ limits and offsets
    -> m (ThreadHeader, Vector Post)
getThread manager board threadId q = 
    getAndParse thread manager (threadJsonURI board threadId q)

-- | retrieve a single post
getPost ::
    ( Failure HttpException m
    , Failure ApiException m
    , Failure InvalidResponseException m
    , MonadIO m)
    => Manager
    -> String  -- ^ short board name
    -> PostId  -- ^ post id
    -> m (Post, ThreadId)
getPost manager board postId =
    getAndParse post manager (singlePostJsonURI board postId)