{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

-- |
-- Module      : Pinboard.Util
-- Copyright   : (c) Jon Schoning, 2015
-- Maintainer  : jonschoning@gmail.com
-- Stability   : experimental
-- Portability : POSIX
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

------------------------------------------------------------------------------
-- | Conversion from a `Show` constrained type to `Text`
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

------------------------------------------------------------------------------
-- | Conversion from a `Show` constrained type to lowercase `Text`
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

------------------------------------------------------------------------------
-- | Conversion of a key value pair to a query parameterized string
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

-- | Retrieve and encode the optional parameters
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

------------------------------------------------------------------------------
-- | Forward slash interspersion on `Monoid` and `IsString`
-- constrained types
(</>)
  :: (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