{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
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 Control.Monad.IO.Class (MonadIO)
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 env@(config, _) f =
runConfigLoggingT
config
(runReaderT f env)
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
{ apiToken :: !ByteString
, maxRequestRateMills :: !Int
, lastRequestTime :: IORef UTCTime
, doThreadDelay :: PinboardConfig -> IO ()
, execLoggingT :: ExecLoggingT
, filterLoggingT :: LogSource -> LogLevel -> Bool
}
instance Show PinboardConfig where
show (PinboardConfig a r _ _ _ _) =
"{ apiToken = " ++ show a ++ ", requestDelayMills = " ++ show r ++ " }"
runConfigLoggingT :: PinboardConfig -> ExecLoggingT
runConfigLoggingT config =
execLoggingT config . filterLogger (filterLoggingT config)
data PinboardRequest = PinboardRequest
{ requestPath :: !Text
, requestParams :: [Param]
} deriving (Show)
type ParamsBS = [(ByteString, ByteString)]
data ResultFormatType
= FormatJson
| FormatXml
deriving (Show, 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 (Show, Eq)