{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Pinboard.Util
( 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 Network.HTTP.Types (urlEncode)
import Data.Monoid
import Prelude
import Pinboard.Types
toText
:: Show a
=> a -> Text
toText = T.pack . show
toTextLower
:: Show a
=> a -> Text
toTextLower = T.toLower . T.pack . show
paramsToByteString
:: (Monoid m, IsString m)
=> [(m, m)] -> m
paramsToByteString [] = mempty
paramsToByteString [(x, y)] = x <> "=" <> y
paramsToByteString ((x, y):xs) =
mconcat [x, "=", y, "&"] <> paramsToByteString xs
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
(</>)
:: (Monoid m, IsString m)
=> m -> m -> m
m1 </> m2 = m1 <> "/" <> m2