diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -28,7 +28,27 @@ Right details -> print details Left pinboardError -> print pinboardError ``` + +output: +``` +Posts{postsDate = 2015 - 10 - 24 16 : 17 : 12 UTC, + postsUser = "jonschoning", + postsPosts = + [Post{postHref = "http://www.reddit.com/r/haskell/comments/25vj62/adventure_with_types_in_haskell_simon_peyton/", + postDescription = "Adventure with Types in Haskell - Simon Peyton Jones [1:33:36] : haskell", + postExtended = "", + postMeta = "3fe9fb05c7c37f7bb66be7b9d85599eb", + postHash = "c46b717604ef8b126dabeba97b27a36f", + postTime = 2014 - 5 - 19 3 : 35 : 55 UTC, + postShared = True, + postToread = False, + postTags = ["spj", "video", "haskell", "typetheory"]}]} +``` ## Modules + +[Pinboard.Types](https://hackage.haskell.org/package/pinboard/docs/Pinboard-Types.html) + + Pinboard typeclasses and type aliases [Pinboard.Client](https://hackage.haskell.org/package/pinboard/docs/Pinboard-Client.html) diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +__v0.9.0__ + +refactored Client.hs to simplify parameters +promote types under .Client subtree to top-level + __v0.8.5__ replace Pinboard stack with PinboardT transfomer (use mtl style constraints instead of a fixed monad transformer stack) diff --git a/pinboard.cabal b/pinboard.cabal --- a/pinboard.cabal +++ b/pinboard.cabal @@ -1,5 +1,5 @@ name: pinboard -version: 0.8.10 +version: 0.9.0 synopsis: Access to the Pinboard API license: MIT license-file: LICENSE @@ -18,18 +18,6 @@ library wraps the API exposing functions and data structures suitable for usage in Haskell programs. . - Example: - . - > import Pinboard - > - > main :: IO () - > main = do - > let config = fromApiToken "api token" - > result <- runPinboard config $ getPostsRecent Nothing Nothing - > case result of - > Right details -> print details - > Left pinboardError -> print pinboardError - . Extra-Source-Files: README.md changelog.md library @@ -60,9 +48,9 @@ Pinboard.ApiRequest Pinboard.ApiTypes Pinboard.Client - Pinboard.Client.Error - Pinboard.Client.Types - Pinboard.Client.Util + Pinboard.Error + Pinboard.Types + Pinboard.Util ghc-options: -Wall -rtsopts source-repository head diff --git a/src/Pinboard/Api.hs b/src/Pinboard/Api.hs --- a/src/Pinboard/Api.hs +++ b/src/Pinboard/Api.hs @@ -42,7 +42,7 @@ import Pinboard.Client (pinboardJson) import Data.Text (Text) import Data.Time (UTCTime) -import Pinboard.Client.Types (MonadPinboard, ResultFormatType (..)) +import Pinboard.Types (MonadPinboard, ResultFormatType (..)) import Pinboard.ApiTypes import Pinboard.ApiRequest diff --git a/src/Pinboard/ApiRequest.hs b/src/Pinboard/ApiRequest.hs --- a/src/Pinboard/ApiRequest.hs +++ b/src/Pinboard/ApiRequest.hs @@ -37,12 +37,12 @@ getNoteRequest, ) where -import Pinboard.Client.Types (PinboardRequest (..), Param (..)) -import Pinboard.Client.Util (()) +import Pinboard.Types (PinboardRequest (..), Param (..)) +import Pinboard.Util (()) import Data.Text (unwords) import Data.Maybe (catMaybes) import Pinboard.ApiTypes -import Pinboard.Client.Types (ResultFormatType (..)) +import Pinboard.Types (ResultFormatType (..)) import Control.Applicative import Prelude hiding (unwords) diff --git a/src/Pinboard/Client.hs b/src/Pinboard/Client.hs --- a/src/Pinboard/Client.hs +++ b/src/Pinboard/Client.hs @@ -30,8 +30,7 @@ -- * Sending , sendPinboardRequest -- * Manager (http-client) - , mgrOpenRaw - , mgrOpen + , newMgr , mgrFail -- * JSON Handling ,parseJSONResponse @@ -44,13 +43,13 @@ ,createParserErr ,httpStatusPinboardError -- * Client Dependencies - , module Pinboard.Client.Error - , module Pinboard.Client.Types - , module Pinboard.Client.Util + , module Pinboard.Error + , module Pinboard.Types + , module Pinboard.Util ) where -import Control.Exception (catch, SomeException, try) +import Control.Exception (catch, SomeException) import Control.Monad.IO.Class import Control.Monad.Reader import Control.Monad.Except @@ -68,9 +67,9 @@ import Network.HTTP.Client.TLS -import Pinboard.Client.Types -import Pinboard.Client.Error -import Pinboard.Client.Util +import Pinboard.Types +import Pinboard.Error +import Pinboard.Util import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T @@ -91,16 +90,19 @@ => PinboardConfig -> PinboardT m a -> m (Either PinboardError a) -runPinboard config f = mgrOpenRaw >>= go +runPinboard config f = newMgr >>= go where go mgr = runPinboardT (config, mgr) f -- | Create a Pinboard value from a PinboardRequest w/ json deserialization -pinboardJson :: (MonadPinboard m, FromJSON a) => PinboardRequest -> m a +pinboardJson + :: (MonadPinboard m, FromJSON a) + => PinboardRequest + -> m a pinboardJson req = do env <- ask - res <- sendPinboardRequest env (ensureResultFormatType FormatJson req) parseJSONResponse - res + res <- sendPinboardRequest env (ensureResultFormatType FormatJson req) + parseJSONResponse res -------------------------------------------------------------------------------- @@ -108,10 +110,9 @@ :: MonadIO m => PinboardConfig -> PinboardRequest - -> (Response LBS.ByteString -> a) - -> m (Either PinboardError a) -runPinboardSingleRaw config req handler = liftIO $ mgrOpenRaw >>= go - where go mgr = (Right <$> sendPinboardRequest (config, mgr) req handler) + -> m (Either PinboardError (Response LBS.ByteString)) +runPinboardSingleRaw config req = liftIO $ newMgr >>= go + where go mgr = (Right <$> sendPinboardRequest (config, mgr) req) `catch` mgrFail UnknownErrorType runPinboardSingleRawBS @@ -120,7 +121,7 @@ -> PinboardRequest -> m (Either PinboardError LBS.ByteString) runPinboardSingleRawBS config req = do - res <- runPinboardSingleRaw config req id + res <- runPinboardSingleRaw config req return $ do r <- res responseBody r <$ checkStatusCodeResponse r @@ -139,15 +140,14 @@ :: MonadIO m => PinboardEnv -> PinboardRequest - -> (Response LBS.ByteString -> a) - -> m a -sendPinboardRequest (PinboardConfig{..}, man) PinboardRequest{..} handler = do + -> m (Response LBS.ByteString) +sendPinboardRequest (PinboardConfig{..}, mgr) PinboardRequest{..} = do let url = T.concat [ requestPath , "?" , T.decodeUtf8 $ paramsToByteString $ ("auth_token", urlEncode False apiToken) : encodeParams requestParams ] req <- buildReq $ T.unpack url - res <- liftIO $ httpLbs req man - return $ handler res + res <- liftIO $ httpLbs req mgr + return res -------------------------------------------------------------------------------- @@ -155,7 +155,7 @@ buildReq url = do req <- liftIO $ parseUrl $ "https://api.pinboard.in/v1/" <> url return $ req - { requestHeaders = [("User-Agent","pinboard.hs/0.8.10")] + { requestHeaders = [("User-Agent","pinboard.hs/0.9.0")] , checkStatus = \_ _ _ -> Nothing } @@ -212,12 +212,9 @@ -------------------------------------------------------------------------------- -mgrOpenRaw :: MonadIO m => m Manager -mgrOpenRaw = liftIO $ withSocketsDo . newManager +newMgr :: MonadIO m => m Manager +newMgr = liftIO $ withSocketsDo . newManager $ managerSetProxy (proxyEnvironment Nothing) tlsManagerSettings - -mgrOpen :: MonadIO m => m (Either SomeException Manager) -mgrOpen = liftIO $ try mgrOpenRaw mgrFail :: MonadIO m => PinboardErrorType -> SomeException -> m (Either PinboardError b) mgrFail e msg = return $ Left $ PinboardError e (toText msg) Nothing Nothing Nothing diff --git a/src/Pinboard/Client/Error.hs b/src/Pinboard/Client/Error.hs deleted file mode 100644 --- a/src/Pinboard/Client/Error.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | --- Module : Pinboard.Client.Error --- Copyright : (c) Jon Schoning, 2015 --- Maintainer : jonschoning@gmail.com --- Stability : experimental --- Portability : POSIX -module Pinboard.Client.Error - ( defaultPinboardError - , PinboardErrorHTTPCode (..) - , PinboardErrorType (..) - , PinboardErrorCode (..) - , PinboardError (..) - ) where - -import Data.Text (Text) - -import Data.Monoid -import Prelude - ------------------------------------------------------------------------------- -data PinboardErrorHTTPCode = - BadRequest -- ^ 400 - | UnAuthorized -- ^ 401 - | RequestFailed -- ^ 402 - | Forbidden -- ^ 403 - | NotFound -- ^ 404 - | TooManyRequests -- ^ 429 - | PinboardServerError -- ^ (>=500) - | UnknownHTTPCode -- ^ All other codes - deriving Show - ------------------------------------------------------------------------------- -data PinboardErrorType = - ConnectionFailure - | HttpStatusFailure - | ParseFailure - | UnknownErrorType - deriving Show - ------------------------------------------------------------------------------- -data PinboardErrorCode = - UnknownError - deriving Show - ------------------------------------------------------------------------------- -data PinboardError = PinboardError { - errorType :: PinboardErrorType - , errorMsg :: Text - , errorCode :: Maybe PinboardErrorCode - , errorParam :: Maybe Text - , errorHTTP :: Maybe PinboardErrorHTTPCode - } deriving Show - -defaultPinboardError :: PinboardError -defaultPinboardError = PinboardError UnknownErrorType mempty Nothing Nothing Nothing diff --git a/src/Pinboard/Client/Types.hs b/src/Pinboard/Client/Types.hs deleted file mode 100644 --- a/src/Pinboard/Client/Types.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE OverloadedStrings #-} - --- | --- Module : Pinboard.Client.Types --- Copyright : (c) Jon Schoning, 2015 --- Maintainer : jonschoning@gmail.com --- Stability : experimental --- Portability : POSIX -module Pinboard.Client.Types - ( PinboardEnv - , PinboardT - , runPinboardT - , MonadPinboard - , PinboardRequest (..) - , PinboardConfig (..) - , ResultFormatType (..) - , Param (..) - , ParamsBS - ) where - -import Control.Monad.Reader (ReaderT) -import Control.Monad.Reader.Class (MonadReader) -import Control.Monad.Trans.Except (ExceptT, runExceptT) -import Control.Monad.Trans.Reader (runReaderT) -import Control.Monad.Error.Class (MonadError) -import Control.Monad.IO.Class (MonadIO) - -import Data.ByteString (ByteString) -import Data.Text (Text) -import Data.Time.Calendar(Day) -import Data.Time.Clock(UTCTime) -import Network.HTTP.Client (Manager) - -import Pinboard.Client.Error (PinboardError (..)) - -import Control.Applicative -import Prelude - ------------------------------------------------------------------------------- - -type PinboardEnv = (PinboardConfig, Manager) - -type PinboardT m a = ReaderT PinboardEnv (ExceptT PinboardError m) a - -runPinboardT - :: PinboardEnv - -> PinboardT m a - -> m (Either PinboardError a) -runPinboardT e f = runExceptT (runReaderT f e) - --- |Typeclass alias for the return type of the API functions (keeps the --- signatures less verbose) -type MonadPinboard m = - ( Functor m - , Applicative m - , Monad m - , MonadIO m - , MonadIO m - , MonadReader PinboardEnv m - , MonadError PinboardError m - ) - ------------------------------------------------------------------------------- - -data PinboardRequest = PinboardRequest - { requestPath :: Text -- ^ url path of PinboardRequest - , requestParams :: [Param] -- ^ Query Parameters of PinboardRequest - } deriving Show - ------------------------------------------------------------------------------- -data PinboardConfig = PinboardConfig - { apiToken :: ByteString - , debug :: Bool - } 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) - diff --git a/src/Pinboard/Client/Util.hs b/src/Pinboard/Client/Util.hs deleted file mode 100644 --- a/src/Pinboard/Client/Util.hs +++ /dev/null @@ -1,111 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} --- | --- Module : Pinboard.Client.Util --- Copyright : (c) Jon Schoning, 2015 --- Maintainer : jonschoning@gmail.com --- Stability : experimental --- Portability : POSIX -module Pinboard.Client.Util - ( - mkConfig - , paramsToByteString - , toText - , toTextLower - , () - , paramToName - , paramToText - , encodeParams - , ensureResultFormatType - ) where - -import Data.String (IsString) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Pinboard.Client.Types (PinboardRequest (..), PinboardConfig (..), ResultFormatType (..), Param (..), ParamsBS) -import Network.HTTP.Types(urlEncode) - -import Data.Monoid -import Prelude - ------------------------------------------------------------------------------- - -mkConfig :: PinboardConfig -mkConfig = PinboardConfig { debug = False, apiToken = mempty } - ------------------------------------------------------------------------------- --- | Conversion from a `Show` constrained type to `Text` -toText - :: Show a - => a - -> Text -toText = T.pack . show - ------------------------------------------------------------------------------- --- | Conversion from a `Show` constrained type to lowercase `Text` -toTextLower - :: Show a - => a - -> Text -toTextLower = T.toLower . T.pack . show - ------------------------------------------------------------------------------- --- | Conversion of a key value pair to a query parameterized string -paramsToByteString - :: (Monoid m, IsString m) - => [(m, m)] - -> m -paramsToByteString [] = mempty -paramsToByteString [(x,y)] = x <> "=" <> y -paramsToByteString ((x,y) : xs) = - mconcat [ x, "=", y, "&" ] <> paramsToByteString xs - --- | Retrieve and encode the optional parameters -encodeParams :: [Param] -> ParamsBS -encodeParams xs = do - x <- xs - let (k, v) = paramToText x - return ( T.encodeUtf8 k - , (urlEncode True . T.encodeUtf8 ) v - ) -ensureResultFormatType :: ResultFormatType -> PinboardRequest -> PinboardRequest -ensureResultFormatType fmt req = - if hasFormat then req else req { requestParams = Format fmt : params } - where params = requestParams req - hasFormat = Format fmt `elem` params - - -paramToText :: Param -> (Text, Text) -paramToText (Tag a) = ("tag", a) -paramToText (Tags a) = ("tags", a) -paramToText (Old a) = ("old", a) -paramToText (New a) = ("new", a) -paramToText (Format FormatJson) = ("format", "json") -paramToText (Format FormatXml) = ("format", "xml") -paramToText (Count a) = ("count", toText a) -paramToText (Start a) = ("start", toText a) -paramToText (Results a) = ("results", toText a) -paramToText (Url a) = ("url", a) -paramToText (Date a) = ("dt", toText a) -paramToText (DateTime a) = ("dt", toText a) -paramToText (FromDateTime a) = ("fromdt", toText a) -paramToText (ToDateTime a) = ("todt", toText a) -paramToText (Replace a) = ("replace", if a then "yes" else "no") -paramToText (Shared a) = ("shared", if a then "yes" else "no") -paramToText (ToRead a) = ("toread", if a then "yes" else "no") -paramToText (Description a) = ("description", a) -paramToText (Extended a) = ("extended", a) -paramToText (Meta a) = ("meta", toText a) - -paramToName :: Param -> Text -paramToName = fst . paramToText ------------------------------------------------------------------------------- --- | Forward slash interspersion on `Monoid` and `IsString` --- constrained types -() - :: (Monoid m, IsString m) - => m - -> m - -> m -m1 m2 = m1 <> "/" <> m2 diff --git a/src/Pinboard/Error.hs b/src/Pinboard/Error.hs new file mode 100644 --- /dev/null +++ b/src/Pinboard/Error.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Pinboard.Error +-- Copyright : (c) Jon Schoning, 2015 +-- Maintainer : jonschoning@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Pinboard.Error + ( defaultPinboardError + , PinboardErrorHTTPCode (..) + , PinboardErrorType (..) + , PinboardErrorCode (..) + , PinboardError (..) + ) where + +import Data.Text (Text) + +import Data.Monoid +import Prelude + +------------------------------------------------------------------------------ +data PinboardErrorHTTPCode = + BadRequest -- ^ 400 + | UnAuthorized -- ^ 401 + | RequestFailed -- ^ 402 + | Forbidden -- ^ 403 + | NotFound -- ^ 404 + | TooManyRequests -- ^ 429 + | PinboardServerError -- ^ (>=500) + | UnknownHTTPCode -- ^ All other codes + deriving Show + +------------------------------------------------------------------------------ +data PinboardErrorType = + ConnectionFailure + | HttpStatusFailure + | ParseFailure + | UnknownErrorType + deriving Show + +------------------------------------------------------------------------------ +data PinboardErrorCode = + UnknownError + deriving Show + +------------------------------------------------------------------------------ +data PinboardError = PinboardError { + errorType :: PinboardErrorType + , errorMsg :: Text + , errorCode :: Maybe PinboardErrorCode + , errorParam :: Maybe Text + , errorHTTP :: Maybe PinboardErrorHTTPCode + } deriving Show + +defaultPinboardError :: PinboardError +defaultPinboardError = PinboardError UnknownErrorType mempty Nothing Nothing Nothing diff --git a/src/Pinboard/Types.hs b/src/Pinboard/Types.hs new file mode 100644 --- /dev/null +++ b/src/Pinboard/Types.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Pinboard.Types +-- Copyright : (c) Jon Schoning, 2015 +-- Maintainer : jonschoning@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Pinboard.Types + ( PinboardEnv + , PinboardT + , runPinboardT + , MonadPinboard + , PinboardRequest (..) + , PinboardConfig (..) + , ResultFormatType (..) + , Param (..) + , ParamsBS + ) where + +import Control.Monad.Reader (ReaderT) +import Control.Monad.Reader.Class (MonadReader) +import Control.Monad.Trans.Except (ExceptT, runExceptT) +import Control.Monad.Trans.Reader (runReaderT) +import Control.Monad.Error.Class (MonadError) +import Control.Monad.IO.Class (MonadIO) + +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Time.Calendar(Day) +import Data.Time.Clock(UTCTime) +import Network.HTTP.Client (Manager) + +import Pinboard.Error (PinboardError (..)) + +import Control.Applicative +import Prelude + +------------------------------------------------------------------------------ + +type PinboardEnv = (PinboardConfig, Manager) + +type PinboardT m a = ReaderT PinboardEnv (ExceptT PinboardError m) a + +runPinboardT + :: PinboardEnv + -> PinboardT m a + -> m (Either PinboardError a) +runPinboardT e f = runExceptT (runReaderT f e) + +-- |Typeclass alias for the return type of the API functions (keeps the +-- signatures less verbose) +type MonadPinboard m = + ( Functor m + , Applicative m + , Monad m + , MonadIO m + , MonadReader PinboardEnv m + , MonadError PinboardError m + ) + +------------------------------------------------------------------------------ + +data PinboardRequest = PinboardRequest + { requestPath :: Text -- ^ url path of PinboardRequest + , requestParams :: [Param] -- ^ Query Parameters of PinboardRequest + } deriving Show + +------------------------------------------------------------------------------ +data PinboardConfig = PinboardConfig + { apiToken :: ByteString + , debug :: Bool + } 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) + diff --git a/src/Pinboard/Util.hs b/src/Pinboard/Util.hs new file mode 100644 --- /dev/null +++ b/src/Pinboard/Util.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} +-- | +-- Module : Pinboard.Util +-- Copyright : (c) Jon Schoning, 2015 +-- Maintainer : jonschoning@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Pinboard.Util + ( + mkConfig + , paramsToByteString + , toText + , toTextLower + , () + , paramToName + , paramToText + , encodeParams + , ensureResultFormatType + ) where + +import Data.String (IsString) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Pinboard.Types (PinboardRequest (..), PinboardConfig (..), ResultFormatType (..), Param (..), ParamsBS) +import Network.HTTP.Types(urlEncode) + +import Data.Monoid +import Prelude + +------------------------------------------------------------------------------ + +mkConfig :: PinboardConfig +mkConfig = PinboardConfig { debug = False, apiToken = mempty } + +------------------------------------------------------------------------------ +-- | Conversion from a `Show` constrained type to `Text` +toText + :: Show a + => a + -> Text +toText = T.pack . show + +------------------------------------------------------------------------------ +-- | Conversion from a `Show` constrained type to lowercase `Text` +toTextLower + :: Show a + => a + -> Text +toTextLower = T.toLower . T.pack . show + +------------------------------------------------------------------------------ +-- | Conversion of a key value pair to a query parameterized string +paramsToByteString + :: (Monoid m, IsString m) + => [(m, m)] + -> m +paramsToByteString [] = mempty +paramsToByteString [(x,y)] = x <> "=" <> y +paramsToByteString ((x,y) : xs) = + mconcat [ x, "=", y, "&" ] <> paramsToByteString xs + +-- | Retrieve and encode the optional parameters +encodeParams :: [Param] -> ParamsBS +encodeParams xs = do + x <- xs + let (k, v) = paramToText x + return ( T.encodeUtf8 k + , (urlEncode True . T.encodeUtf8 ) v + ) +ensureResultFormatType :: ResultFormatType -> PinboardRequest -> PinboardRequest +ensureResultFormatType fmt req = + if hasFormat then req else req { requestParams = Format fmt : params } + where params = requestParams req + hasFormat = Format fmt `elem` params + + +paramToText :: Param -> (Text, Text) +paramToText (Tag a) = ("tag", a) +paramToText (Tags a) = ("tags", a) +paramToText (Old a) = ("old", a) +paramToText (New a) = ("new", a) +paramToText (Format FormatJson) = ("format", "json") +paramToText (Format FormatXml) = ("format", "xml") +paramToText (Count a) = ("count", toText a) +paramToText (Start a) = ("start", toText a) +paramToText (Results a) = ("results", toText a) +paramToText (Url a) = ("url", a) +paramToText (Date a) = ("dt", toText a) +paramToText (DateTime a) = ("dt", toText a) +paramToText (FromDateTime a) = ("fromdt", toText a) +paramToText (ToDateTime a) = ("todt", toText a) +paramToText (Replace a) = ("replace", if a then "yes" else "no") +paramToText (Shared a) = ("shared", if a then "yes" else "no") +paramToText (ToRead a) = ("toread", if a then "yes" else "no") +paramToText (Description a) = ("description", a) +paramToText (Extended a) = ("extended", a) +paramToText (Meta a) = ("meta", toText a) + +paramToName :: Param -> Text +paramToName = fst . paramToText +------------------------------------------------------------------------------ +-- | Forward slash interspersion on `Monoid` and `IsString` +-- constrained types +() + :: (Monoid m, IsString m) + => m + -> m + -> m +m1 m2 = m1 <> "/" <> m2