{-# 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 :: a -> Text
toText = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
toTextLower
:: Show a
=> a -> Text
toTextLower :: a -> Text
toTextLower = Text -> Text
T.toLower (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
paramsToByteString
:: (Monoid m, IsString m)
=> [(m, m)] -> m
paramsToByteString :: [(m, m)] -> m
paramsToByteString [] = m
forall a. Monoid a => a
mempty
paramsToByteString [(m
x, m
y)] = m
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
"=" m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
y
paramsToByteString ((m
x, m
y):[(m, m)]
xs) =
[m] -> m
forall a. Monoid a => [a] -> a
mconcat [m
x, m
"=", m
y, m
"&"] m -> m -> m
forall a. Semigroup a => a -> a -> a
<> [(m, m)] -> m
forall m. (Monoid m, IsString m) => [(m, m)] -> m
paramsToByteString [(m, m)]
xs
encodeParams :: [Param] -> ParamsBS
encodeParams :: [Param] -> ParamsBS
encodeParams [Param]
xs = do
Param
x <- [Param]
xs
let (Text
k, Text
v) = Param -> (Text, Text)
paramToText Param
x
(ByteString, ByteString) -> ParamsBS
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ByteString
T.encodeUtf8 Text
k, (Bool -> ByteString -> ByteString
urlEncode Bool
True (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8) Text
v)
ensureResultFormatType :: ResultFormatType -> PinboardRequest -> PinboardRequest
ensureResultFormatType :: ResultFormatType -> PinboardRequest -> PinboardRequest
ensureResultFormatType ResultFormatType
fmt PinboardRequest
req =
if Bool
hasFormat
then PinboardRequest
req
else PinboardRequest
req
{ requestParams :: [Param]
requestParams = ResultFormatType -> Param
Format ResultFormatType
fmt Param -> [Param] -> [Param]
forall a. a -> [a] -> [a]
: [Param]
params
}
where
params :: [Param]
params = PinboardRequest -> [Param]
requestParams PinboardRequest
req
hasFormat :: Bool
hasFormat = ResultFormatType -> Param
Format ResultFormatType
fmt Param -> [Param] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Param]
params
paramToText :: Param -> (Text, Text)
paramToText :: Param -> (Text, Text)
paramToText (Tag Text
a) = (Text
"tag", Text
a)
paramToText (Tags Text
a) = (Text
"tags", Text
a)
paramToText (Old Text
a) = (Text
"old", Text
a)
paramToText (New Text
a) = (Text
"new", Text
a)
paramToText (Format ResultFormatType
FormatJson) = (Text
"format", Text
"json")
paramToText (Format ResultFormatType
FormatXml) = (Text
"format", Text
"xml")
paramToText (Count Int
a) = (Text
"count", Int -> Text
forall a. Show a => a -> Text
toText Int
a)
paramToText (Start Int
a) = (Text
"start", Int -> Text
forall a. Show a => a -> Text
toText Int
a)
paramToText (Results Int
a) = (Text
"results", Int -> Text
forall a. Show a => a -> Text
toText Int
a)
paramToText (Url Text
a) = (Text
"url", Text
a)
paramToText (Date Day
a) = (Text
"dt", Day -> Text
forall a. Show a => a -> Text
toText Day
a)
paramToText (DateTime UTCTime
a) = (Text
"dt", UTCTime -> Text
forall a. Show a => a -> Text
toText UTCTime
a)
paramToText (FromDateTime UTCTime
a) = (Text
"fromdt", UTCTime -> Text
forall a. Show a => a -> Text
toText UTCTime
a)
paramToText (ToDateTime UTCTime
a) = (Text
"todt", UTCTime -> Text
forall a. Show a => a -> Text
toText UTCTime
a)
paramToText (Replace Bool
a) =
( Text
"replace"
, if Bool
a
then Text
"yes"
else Text
"no")
paramToText (Shared Bool
a) =
( Text
"shared"
, if Bool
a
then Text
"yes"
else Text
"no")
paramToText (ToRead Bool
a) =
( Text
"toread"
, if Bool
a
then Text
"yes"
else Text
"no")
paramToText (Description Text
a) = (Text
"description", Text
a)
paramToText (Extended Text
a) = (Text
"extended", Text
a)
paramToText (Meta Int
a) = (Text
"meta", Int -> Text
forall a. Show a => a -> Text
toText Int
a)
paramToName :: Param -> Text
paramToName :: Param -> Text
paramToName = (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Param -> (Text, Text)) -> Param -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param -> (Text, Text)
paramToText
(</>)
:: (Monoid m, IsString m)
=> m -> m -> m
m
m1 </> :: m -> m -> m
</> m
m2 = m
m1 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
"/" m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
m2