Internal.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}

module Web.Twitter.Conduit.Parameters.Internal
       ( Parameters(..)
       , readShow
       , booleanQuery
       , integerArrayQuery
       , wrappedParam
       ) where

import qualified Network.HTTP.Types as HT
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import Data.Maybe
import Control.Lens

class Parameters a where
    params :: Lens' a HT.SimpleQuery

-- | This 'Prism' convert from a 'ByteString' to some value based on 'Read' and 'Show'
--
-- >>> readShow # 2
-- "2"
-- >>> "1024" ^? readShow :: Maybe Integer
-- Just 1024
readShow :: (Read a, Show a) => Prism' S.ByteString a
readShow = prism' (S8.pack . show) (readMaybe . S8.unpack)
  where
    readMaybe str = case [x | (x, t) <- reads str, ("", "") <- lex t] of
        [x] -> Just x
        _ -> Nothing

-- | This 'Prism' convert from a 'ByteString' to 'Bool' value.
--
-- >>> booleanQuery # True
-- "true"
-- >>> booleanQuery # False
-- "false"
-- >>> "true" ^? booleanQuery
-- Just True
-- >>> "1" ^? booleanQuery
-- Just True
-- >>> "t" ^? booleanQuery
-- Just True
-- >>> "test" ^? booleanQuery
-- Just False
booleanQuery :: Prism' S.ByteString Bool
booleanQuery = prism' bs sb
  where
    bs True = "true"
    bs False = "false"
    sb "true" = Just True
    sb "1" = Just True
    sb "t" = Just True
    sb _ = Just False

-- | This 'Prism' convert from a 'ByteString' to the array of 'Integer' value.
--
-- This is not a valid Prism, for example:
--
-- @
-- "1, 2" ^? integerArrayQuery == Just [1,2]
-- integerArrayQuery # [1,2] != "1, 2"
-- @
--
-- >>> integerArrayQuery # [1]
-- "1"
-- >>> integerArrayQuery # [1,2234,3]
-- "1,2234,3"
-- >>> "1,2234,3" ^? integerArrayQuery
-- Just [1,2234,3]
-- >>> "" ^? integerArrayQuery
-- Just []
-- >>> "hoge,2" ^? integerArrayQuery
-- Nothing
integerArrayQuery :: Prism' S.ByteString [Integer]
integerArrayQuery = prism' bs_arr arr_bs
  where
    bs_arr xs = S8.intercalate "," $ xs ^.. traversed . re readShow
    arr_bs str = chkValid $ map (^? readShow) $ S8.split ',' str
    chkValid arr =
        if all isJust arr
        then Just (catMaybes arr)
        else Nothing

wrappedParam :: Parameters p => S.ByteString -> Prism' S.ByteString a -> Lens' p (Maybe a)
wrappedParam key aSBS = lens getter setter
   where
     getter = preview $ params . to (lookup key) . _Just . aSBS
     setter = flip (over params . replace key)
     replace k (Just v) = ((k, aSBS # v):) . dropAssoc k
     replace k Nothing = dropAssoc k
     dropAssoc k = filter ((/= k) . fst)