-- | -- Module : Flowdock.Internal -- License : MIT License -- Maintainer : Gabriel McArthur -- Stability : experimental -- Portability : portable module Flowdock.Internal ( createUrl , underscoreCase , picosecondsToUTCTime ) where import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char.Utf8 import Data.ByteString (ByteString) import Data.Char (isUpper, toLower) import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (UTCTime, NominalDiffTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Maybe import Data.Monoid import Network.HTTP.Types.URI -- | Create a URL from a base URL and a list of relative paths, returning -- the full URL createUrl :: [Text] -- ^ Relative paths -> [(Text, Text)] -- ^ Query parameters -> ByteString createUrl relativePaths params = toByteString $ if null params then path else path <> queryString where stripSlashes txt = txt'' where txt' = if "/" `Text.isSuffixOf` txt then fromJust $ Text.stripSuffix "/" txt else txt txt'' = if "/" `Text.isPrefixOf` txt' then fromJust $ Text.stripPrefix "/" txt' else txt' path = foldr ((\p acc -> fromText "/" <> p <> acc) . fromText . stripSlashes) mempty relativePaths paramToQuery (k,v) = let k' = encodeUtf8 k in if Text.null v then (k', Nothing) else (k', Just $ encodeUtf8 v) queryString = renderQueryBuilder True $ map paramToQuery params underscoreCase :: String -> String underscoreCase = underscoreCase' True where underscoreCase' _ [] = [] underscoreCase' prev (x : xs) = if isUpper x then if prev then toLower x : underscoreCase' True xs else '_' : toLower x : underscoreCase' True xs else x : underscoreCase' False xs -- | Turns picoseconds into UTCTime picosecondsToUTCTime :: Integer -> UTCTime picosecondsToUTCTime pico = posixSecondsToUTCTime posixSeconds where posixSeconds :: NominalDiffTime posixSeconds = fromInteger $ pico `div` (1000000 :: Integer)