{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module TwoChSo.Parsers
    ( threadsList
    , thread
    , post
    , limits
    , boardInfo
    , apiError
    , withError
    ) where
import Data.Aeson
import Data.Aeson.Types
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Vector as V
import Data.Vector (Vector)
import Data.Maybe (isJust, fromJust, fromMaybe)
import Control.Applicative
import Control.Monad ((>=>), when, ap)
import Control.Failure (Failure(..))
import TwoChSo.Types
import TwoChSo.Types.Exceptions
import TwoChSo.Parsers.Coerce


limits :: Value -> Parser Limits
limits = toObject >=> \v ->
    Limits
        <$> v .: "query_interval"
        <*> v .: "query_limit"
        <*> v .: "ban_time"

threadsList :: Value -> Parser (Vector (ThreadHeader, Post))
threadsList =
    toObject >=> "type" ==: "threads" >=> (.: "threads") >=> toArray >=> V.mapM (toObject >=> step)
    --                      ^^ this is not a typo, specs says "getthreads", but server does "threads"
    where
    step :: Object -> Parser (ThreadHeader, Post)
    step v = (,) <$> header' v <*> post' v

thread :: Value -> Parser (ThreadHeader, Vector Post)
thread = toObject >=> "type" ==: "getthread" >=> (.: "thread") >=> toArray >=> \posts ->
    (,) <$> (toObject (V.head posts) >>= header') <*> V.mapM (toObject >=> post') (V.tail posts)

post :: Value -> Parser (Post, ThreadId)
post =
    toObject >=> "type" ==: "getpost" >=> (.: "post") >=> toObject >=> post' /|\ parent


parent :: Object -> Parser ThreadId
parent v = do
-- because for OP posts it is "parent":"0"
    parentId <- v .: "parent" >>= str2int
    if parentId == 0
        then v .: "num" >>= str2int
        else return parentId

header' :: Object -> Parser ThreadHeader
header' v = ThreadHeader
    <$> (v .: "lasthit" >>= str2int)
    <*> (str2bool <$> v .: "sticky")
    <*> (str2bool <$> v .: "closed")

post' :: Object -> Parser Post
post' v = Post
    <$> (str2bool <$> v .: "banned")
    <*> (v .: "num" >>= str2int)
    <*> (maybeStr <$> v .: "email")
    <*> (v .: "timestamp" >>= str2int)
    <*> (maybeStr <$> v .: "trip")
    <*> (maybeStr <$> v .: "subject")
    <*> (maybeStr <$> v .: "name")
    <*> (maybeStr <$> v .: "comment")
    <*> (str2bool <$> v .: "op")
    <*> media v
    where
    media :: Object -> Parser (Maybe Media)
    media v = do
        video <- v .: "video"
        image <- (v .: "image" :: Parser (Maybe String))

        case (isJust video, isJust image) of
            (True, _) -> return $ Just $ Video $ fromJust video
            (_, True) -> Just <$> (
                ImageMedia
                    <$> (Image
                            <$> (v .: "width" >>= str2int)
                            <*> (v .: "height" >>= str2int)
                            <*> v .: "image")
                    <*> (v .: "size" >>= str2int)
                    <*> (Image
                            <$> (v .: "tn_width" >>= str2int)
                            <*> (v .: "tn_height" >>= str2int)
                            <*> v .: "thumbnail")
                    )
            otherwise -> return Nothing


boardInfo :: Value -> Parser BoardInfo
boardInfo = toObject >=> (.:"board") >=> \v ->
    BoardInfo
        <$> v .: "thumb_dir"
        <*> v .: "img_dir"
        <*> v .: "res_dir"
        <*> v .: "page_ext"
        <*> v .: "shortname"
        <*> v .: "name"
        <*> v .: "favicon"
        <*> v .: "charset"
        <*> (int2bool <$> v .: "enable_bbcode")
        <*> v .: "max_comment_length"
        <*> v .: "max_field_length"
        <*> v .: "imagesize"
        <*> v .: "image_w"
        <*> v .: "image_h"
        <*> v .: "threads_per_page"
        <*> v .: "wakaba_version"

apiError :: Value -> Parser ApiException
apiError = toObject >=> "type" ==: "error" >=> \v -> do
    errorCode <- v .: "code"
    case errorCode of
        0 -> return InvalidRequestCode
        1 -> return InternalServerError
        2 -> return ThreadNotFound
        3 -> return NoSuchPostInThread
        4 -> return NoPostsFound
        5 -> return OffsetTooBig
        6 -> return PostNotFound
        7 -> return Banned
        _ -> UnknownApiError errorCode <$> v .: "reason"

withError :: Failure ApiException f => (Value -> Parser a) -> Value -> Parser (f a)
withError p v = (failure <$> apiError v) <|> (return <$> p v)

(==:) :: Text -> Text -> Object -> Parser Object
(==:) k a v = do
    a' <- v .: k
    when (a' /= a) $
        fail $ "expected " ++ (T.unpack k) ++ "=" ++ show a ++ " but value is " ++ show a'
    return v

infix 6  /|\
(/|\) :: Monad m => (a -> m b) -> (a -> m c) -> a -> m (b, c)
(/|\) mb mc a = return (,) `ap` mb a `ap` mc a