{-# LANGUAGE FlexibleInstances    #-}

{-# LANGUAGE OverloadedStrings    #-}

{-# LANGUAGE TypeFamilies         #-}

{-# LANGUAGE TypeSynonymInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}



module ChatWork.Types (

      JsonResponse'

    , jsonResponse'

    -- * type synonym of Response Json

    , ChatWorkResponse

    -- * Helper type class for constructing Request paramater

    , ToReqParam(..)



    , module Types

    ) where



import           ChatWork.Types.Base             as Types

import           ChatWork.Types.Contacts         as Types

import           ChatWork.Types.Error            as Types

import           ChatWork.Types.IncomingRequests as Types

import           ChatWork.Types.Me               as Types

import           ChatWork.Types.My               as Types

import           ChatWork.Types.Rooms            as Types



import           ChatWork.Types.Base             (IconPreset, TaskStatus)

import           ChatWork.Types.Error            (ChatWorkErrors)

import           Control.Applicative             ((<|>))

import           Control.Exception               (throwIO)

import           Data.Aeson                      (FromJSON (..), eitherDecode)

import qualified Data.ByteString.Lazy            as BL

import           Data.Monoid                     (Monoid)

import           Data.Proxy                      (Proxy (..))

import           Data.Text                       (Text, pack)

import qualified Network.HTTP.Client             as L

import           Network.HTTP.Req                (HttpException (..),

                                                  HttpResponse (..), QueryParam,

                                                  (=:))



newtype JsonResponse' a = JsonResponse' (L.Response a)



instance FromJSON a => HttpResponse (JsonResponse' a) where

  type HttpResponseBody (JsonResponse' a) = a

  toVanillaResponse (JsonResponse' r) = r

  getHttpResponse r = do

    chunks <- L.brConsume (L.responseBody r)

    let

      body = if null chunks then "[]" else BL.fromChunks chunks

    case eitherDecode body of

      Left  e -> throwIO (JsonHttpException e)

      Right x -> return $ JsonResponse' (x <$ r)



jsonResponse' :: Proxy (JsonResponse' a)

jsonResponse' = Proxy



-- |

-- Wrapper type synonym of 'JsonResponse' and 'ChatWorkErrors'

type ChatWorkResponse a = JsonResponse' (Either ChatWorkErrors a)



instance {-# OVERLAPS #-} (FromJSON a) => FromJSON (Either ChatWorkErrors a) where

  parseJSON v = (Left <$> parseJSON v) <|> (Right <$> parseJSON v)



-- |

-- Helper Type Class of 'QueryParam'

-- use to construct request parameter from param type, e.g. 'CreateRoomParams'



class ToReqParam a where

  toReqParam :: (QueryParam param, Monoid param) => Text -> a -> param



instance ToReqParam Int where

  toReqParam = (=:)



instance ToReqParam Text where

  toReqParam = (=:)



instance ToReqParam a => ToReqParam (Maybe a) where

  toReqParam = maybe mempty . toReqParam



instance Show a => ToReqParam [a] where

  toReqParam name = toReqParam name . foldl1 (\acc txt -> mconcat [acc, ",", txt]) . fmap (pack . show)



instance ToReqParam IconPreset where

  toReqParam name = toReqParam name . pack . show



instance ToReqParam TaskStatus where

  toReqParam name = toReqParam name . pack . show