{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}

-- |
-- Module      : Pinboard.Types
-- Copyright   : (c) Jon Schoning, 2015
-- Maintainer  : jonschoning@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Pinboard.Types
  ( PinboardEnv
  , PinboardT
  , runPinboardT
  , MonadPinboard
  , ExecLoggingT
  , PinboardConfig(..)
  , runConfigLoggingT
  , PinboardRequest(..)
  , ResultFormatType(..)
  , Param(..)
  , ParamsBS
  ) where

import Control.Monad.Reader (ReaderT)
import Control.Monad.Reader.Class (MonadReader)
import Control.Monad.Trans.Reader (runReaderT)

import UnliftIO

import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Time.Calendar (Day)
import Data.Time.Clock (UTCTime)
import Network.HTTP.Client (Manager)

import Control.Monad.Logger

import Prelude

------------------------------------------------------------------------------
type PinboardEnv = (PinboardConfig, Manager)

type PinboardT m a = ReaderT PinboardEnv (LoggingT m) a

runPinboardT
  :: MonadUnliftIO m
  => PinboardEnv -> PinboardT m a -> m a
runPinboardT :: PinboardEnv -> PinboardT m a -> m a
runPinboardT env :: PinboardEnv
env@(PinboardConfig
config, Manager
_) PinboardT m a
f =
  PinboardConfig -> LoggingT m a -> m a
PinboardConfig -> ExecLoggingT
runConfigLoggingT
    PinboardConfig
config
    (PinboardT m a -> PinboardEnv -> LoggingT m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT PinboardT m a
f PinboardEnv
env)

------------------------------------------------------------------------------
-- |Typeclass alias for the return type of the API functions (keeps the
-- signatures less verbose)
type MonadPinboard m = (MonadUnliftIO m, MonadReader PinboardEnv m, MonadLogger m)

------------------------------------------------------------------------------
type ExecLoggingT = forall m. MonadIO m =>
                              forall a. LoggingT m a -> m a

data PinboardConfig = PinboardConfig
  { PinboardConfig -> ByteString
apiToken :: !ByteString
  , PinboardConfig -> Int
maxRequestRateMills :: !Int
  , PinboardConfig -> IORef UTCTime
lastRequestTime :: IORef UTCTime
  , PinboardConfig -> PinboardConfig -> IO ()
doThreadDelay :: PinboardConfig -> IO ()
  , PinboardConfig -> ExecLoggingT
execLoggingT :: ExecLoggingT
  , PinboardConfig -> LogSource -> LogLevel -> Bool
filterLoggingT :: LogSource -> LogLevel -> Bool
  }

instance Show PinboardConfig where
  show :: PinboardConfig -> String
show (PinboardConfig ByteString
a Int
r IORef UTCTime
_ PinboardConfig -> IO ()
_ ExecLoggingT
_ LogSource -> LogLevel -> Bool
_) =
    String
"{ apiToken = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", requestDelayMills = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" }"

runConfigLoggingT :: PinboardConfig -> ExecLoggingT
runConfigLoggingT :: PinboardConfig -> ExecLoggingT
runConfigLoggingT PinboardConfig
config =
  PinboardConfig -> ExecLoggingT
execLoggingT PinboardConfig
config (LoggingT m a -> m a)
-> (LoggingT m a -> LoggingT m a) -> LoggingT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a.
(LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger (PinboardConfig -> LogSource -> LogLevel -> Bool
filterLoggingT PinboardConfig
config)

------------------------------------------------------------------------------
data PinboardRequest = PinboardRequest
  { PinboardRequest -> LogSource
requestPath :: !Text -- ^ url path of PinboardRequest
  , PinboardRequest -> [Param]
requestParams :: [Param] -- ^ Query Parameters of PinboardRequest
  } deriving (Int -> PinboardRequest -> ShowS
[PinboardRequest] -> ShowS
PinboardRequest -> String
(Int -> PinboardRequest -> ShowS)
-> (PinboardRequest -> String)
-> ([PinboardRequest] -> ShowS)
-> Show PinboardRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinboardRequest] -> ShowS
$cshowList :: [PinboardRequest] -> ShowS
show :: PinboardRequest -> String
$cshow :: PinboardRequest -> String
showsPrec :: Int -> PinboardRequest -> ShowS
$cshowsPrec :: Int -> PinboardRequest -> ShowS
Show)

------------------------------------------------------------------------------
type ParamsBS = [(ByteString, ByteString)]

------------------------------------------------------------------------------
data ResultFormatType
  = FormatJson
  | FormatXml
  deriving (Int -> ResultFormatType -> ShowS
[ResultFormatType] -> ShowS
ResultFormatType -> String
(Int -> ResultFormatType -> ShowS)
-> (ResultFormatType -> String)
-> ([ResultFormatType] -> ShowS)
-> Show ResultFormatType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultFormatType] -> ShowS
$cshowList :: [ResultFormatType] -> ShowS
show :: ResultFormatType -> String
$cshow :: ResultFormatType -> String
showsPrec :: Int -> ResultFormatType -> ShowS
$cshowsPrec :: Int -> ResultFormatType -> ShowS
Show, ResultFormatType -> ResultFormatType -> Bool
(ResultFormatType -> ResultFormatType -> Bool)
-> (ResultFormatType -> ResultFormatType -> Bool)
-> Eq ResultFormatType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultFormatType -> ResultFormatType -> Bool
$c/= :: ResultFormatType -> ResultFormatType -> Bool
== :: ResultFormatType -> ResultFormatType -> Bool
$c== :: ResultFormatType -> ResultFormatType -> Bool
Eq)

data Param
  = Format !ResultFormatType
  | Tag !Text
  | Tags !Text
  | Old !Text
  | New !Text
  | Count !Int
  | Start !Int
  | Results !Int
  | Url !Text
  | Date !Day
  | DateTime !UTCTime
  | FromDateTime !UTCTime
  | ToDateTime !UTCTime
  | Replace !Bool
  | Shared !Bool
  | ToRead !Bool
  | Description !Text
  | Extended !Text
  | Meta !Int
  deriving (Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
(Int -> Param -> ShowS)
-> (Param -> String) -> ([Param] -> ShowS) -> Show Param
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Param] -> ShowS
$cshowList :: [Param] -> ShowS
show :: Param -> String
$cshow :: Param -> String
showsPrec :: Int -> Param -> ShowS
$cshowsPrec :: Int -> Param -> ShowS
Show, Param -> Param -> Bool
(Param -> Param -> Bool) -> (Param -> Param -> Bool) -> Eq Param
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Param -> Param -> Bool
$c/= :: Param -> Param -> Bool
== :: Param -> Param -> Bool
$c== :: Param -> Param -> Bool
Eq)