{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
  
-- | Provides syntax for incrementally building Urls and components of Urls such as Query strings
module Dormouse.Url.Builder 
  ( QueryComponent(..)
  , QueryBuilder(..)
  , IsQueryVal(..)
  ,  (</>)
  , (?)
  , (&)
  , (=:)
  ) where

import Data.Foldable  
import Data.Text (Text)
import Dormouse.Uri.Types
import Dormouse.Url.Types

import qualified Data.Text as T
import qualified Data.Sequence as SQ

-- | An individual Query Parameter or Query Flag
data QueryComponent
  = QueryParam T.Text T.Text
  | QueryFlag T.Text
  deriving (QueryComponent -> QueryComponent -> Bool
(QueryComponent -> QueryComponent -> Bool)
-> (QueryComponent -> QueryComponent -> Bool) -> Eq QueryComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryComponent -> QueryComponent -> Bool
$c/= :: QueryComponent -> QueryComponent -> Bool
== :: QueryComponent -> QueryComponent -> Bool
$c== :: QueryComponent -> QueryComponent -> Bool
Eq, Int -> QueryComponent -> ShowS
[QueryComponent] -> ShowS
QueryComponent -> String
(Int -> QueryComponent -> ShowS)
-> (QueryComponent -> String)
-> ([QueryComponent] -> ShowS)
-> Show QueryComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryComponent] -> ShowS
$cshowList :: [QueryComponent] -> ShowS
show :: QueryComponent -> String
$cshow :: QueryComponent -> String
showsPrec :: Int -> QueryComponent -> ShowS
$cshowsPrec :: Int -> QueryComponent -> ShowS
Show)

-- | Stores a series of Query Parameters or Query Flags used for building the Query component of a URI/URL, for example in the format @?param1=2&param2=3&flag1@
newtype QueryBuilder = QueryBuilder { QueryBuilder -> Seq QueryComponent
unQueryBuilder :: SQ.Seq QueryComponent }
  deriving (QueryBuilder -> QueryBuilder -> Bool
(QueryBuilder -> QueryBuilder -> Bool)
-> (QueryBuilder -> QueryBuilder -> Bool) -> Eq QueryBuilder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryBuilder -> QueryBuilder -> Bool
$c/= :: QueryBuilder -> QueryBuilder -> Bool
== :: QueryBuilder -> QueryBuilder -> Bool
$c== :: QueryBuilder -> QueryBuilder -> Bool
Eq, Int -> QueryBuilder -> ShowS
[QueryBuilder] -> ShowS
QueryBuilder -> String
(Int -> QueryBuilder -> ShowS)
-> (QueryBuilder -> String)
-> ([QueryBuilder] -> ShowS)
-> Show QueryBuilder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryBuilder] -> ShowS
$cshowList :: [QueryBuilder] -> ShowS
show :: QueryBuilder -> String
$cshow :: QueryBuilder -> String
showsPrec :: Int -> QueryBuilder -> ShowS
$cshowsPrec :: Int -> QueryBuilder -> ShowS
Show)

instance Semigroup QueryBuilder where
  QueryBuilder
x1 <> :: QueryBuilder -> QueryBuilder -> QueryBuilder
<> QueryBuilder
x2 = Seq QueryComponent -> QueryBuilder
QueryBuilder (Seq QueryComponent -> QueryBuilder)
-> Seq QueryComponent -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ QueryBuilder -> Seq QueryComponent
unQueryBuilder QueryBuilder
x1 Seq QueryComponent -> Seq QueryComponent -> Seq QueryComponent
forall a. Semigroup a => a -> a -> a
<> QueryBuilder -> Seq QueryComponent
unQueryBuilder QueryBuilder
x2

instance Monoid QueryBuilder where
  mempty :: QueryBuilder
mempty = Seq QueryComponent -> QueryBuilder
QueryBuilder Seq QueryComponent
forall a. Seq a
SQ.empty

-- | Signifies a type that can be rendered as Query Parameter within a URI
class IsQueryVal a where
  toQueryVal :: a -> T.Text

instance IsQueryVal Bool where toQueryVal :: Bool -> Text
toQueryVal = String -> Text
T.pack (String -> Text) -> (Bool -> String) -> Bool -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show
instance IsQueryVal Char where toQueryVal :: Char -> Text
toQueryVal = String -> Text
T.pack (String -> Text) -> (Char -> String) -> Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. Show a => a -> String
show
instance IsQueryVal Double where toQueryVal :: Double -> Text
toQueryVal = String -> Text
T.pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show
instance IsQueryVal Float where toQueryVal :: Float -> Text
toQueryVal = String -> Text
T.pack (String -> Text) -> (Float -> String) -> Float -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. Show a => a -> String
show
instance IsQueryVal Int where toQueryVal :: Int -> Text
toQueryVal = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
instance IsQueryVal Integer where toQueryVal :: Integer -> Text
toQueryVal = String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
instance IsQueryVal String where toQueryVal :: String -> Text
toQueryVal = String -> Text
T.pack
instance IsQueryVal T.Text where toQueryVal :: Text -> Text
toQueryVal = Text -> Text
forall a. a -> a
id

-- | Combine a Url with a new text path component
(</>) :: Url scheme -> Text -> Url scheme
</> :: Url scheme -> Text -> Url scheme
(</>) (HttpUrl UrlComponents {$sel:urlPath:UrlComponents :: UrlComponents -> Path 'Absolute
urlPath = Path 'Absolute
path, Maybe Query
Maybe Fragment
Authority
$sel:urlFragment:UrlComponents :: UrlComponents -> Maybe Fragment
$sel:urlQuery:UrlComponents :: UrlComponents -> Maybe Query
$sel:urlAuthority:UrlComponents :: UrlComponents -> Authority
urlFragment :: Maybe Fragment
urlQuery :: Maybe Query
urlAuthority :: Authority
.. }) Text
text = UrlComponents -> Url "http"
HttpUrl (UrlComponents -> Url "http") -> UrlComponents -> Url "http"
forall a b. (a -> b) -> a -> b
$ UrlComponents :: Authority
-> Path 'Absolute -> Maybe Query -> Maybe Fragment -> UrlComponents
UrlComponents {$sel:urlPath:UrlComponents :: Path 'Absolute
urlPath = (Path :: forall (ref :: UriReference). [PathSegment] -> Path ref
Path {$sel:unPath:Path :: [PathSegment]
unPath = Path 'Absolute -> [PathSegment]
forall (ref :: UriReference). Path ref -> [PathSegment]
unPath Path 'Absolute
path [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. [a] -> [a] -> [a]
++ [Text -> PathSegment
PathSegment Text
text] }), Maybe Query
Maybe Fragment
Authority
$sel:urlFragment:UrlComponents :: Maybe Fragment
$sel:urlQuery:UrlComponents :: Maybe Query
$sel:urlAuthority:UrlComponents :: Authority
urlFragment :: Maybe Fragment
urlQuery :: Maybe Query
urlAuthority :: Authority
..}
(</>) (HttpsUrl UrlComponents {$sel:urlPath:UrlComponents :: UrlComponents -> Path 'Absolute
urlPath = Path 'Absolute
path, Maybe Query
Maybe Fragment
Authority
urlFragment :: Maybe Fragment
urlQuery :: Maybe Query
urlAuthority :: Authority
$sel:urlFragment:UrlComponents :: UrlComponents -> Maybe Fragment
$sel:urlQuery:UrlComponents :: UrlComponents -> Maybe Query
$sel:urlAuthority:UrlComponents :: UrlComponents -> Authority
.. }) Text
text = UrlComponents -> Url "https"
HttpsUrl (UrlComponents -> Url "https") -> UrlComponents -> Url "https"
forall a b. (a -> b) -> a -> b
$ UrlComponents :: Authority
-> Path 'Absolute -> Maybe Query -> Maybe Fragment -> UrlComponents
UrlComponents {$sel:urlPath:UrlComponents :: Path 'Absolute
urlPath = (Path :: forall (ref :: UriReference). [PathSegment] -> Path ref
Path {$sel:unPath:Path :: [PathSegment]
unPath = Path 'Absolute -> [PathSegment]
forall (ref :: UriReference). Path ref -> [PathSegment]
unPath Path 'Absolute
path [PathSegment] -> [PathSegment] -> [PathSegment]
forall a. [a] -> [a] -> [a]
++ [Text -> PathSegment
PathSegment Text
text] }), Maybe Query
Maybe Fragment
Authority
urlFragment :: Maybe Fragment
urlQuery :: Maybe Query
urlAuthority :: Authority
$sel:urlFragment:UrlComponents :: Maybe Fragment
$sel:urlQuery:UrlComponents :: Maybe Query
$sel:urlAuthority:UrlComponents :: Authority
..}

-- | Convenient alias for '<>' which allows for combining query parameters
(&) :: QueryBuilder -> QueryBuilder -> QueryBuilder
& :: QueryBuilder -> QueryBuilder -> QueryBuilder
(&) = QueryBuilder -> QueryBuilder -> QueryBuilder
forall a. Semigroup a => a -> a -> a
(<>)

-- | Combine a Url with a some supplied query parameters
(?) :: Url scheme -> QueryBuilder -> Url scheme
? :: Url scheme -> QueryBuilder -> Url scheme
(?) Url scheme
uri QueryBuilder
b = 
  case Url scheme
uri of 
    HttpUrl  UrlComponents { Maybe Query
Maybe Fragment
Path 'Absolute
Authority
urlFragment :: Maybe Fragment
urlQuery :: Maybe Query
urlPath :: Path 'Absolute
urlAuthority :: Authority
$sel:urlFragment:UrlComponents :: UrlComponents -> Maybe Fragment
$sel:urlQuery:UrlComponents :: UrlComponents -> Maybe Query
$sel:urlAuthority:UrlComponents :: UrlComponents -> Authority
$sel:urlPath:UrlComponents :: UrlComponents -> Path 'Absolute
.. } -> UrlComponents -> Url "http"
HttpUrl (UrlComponents -> Url "http") -> UrlComponents -> Url "http"
forall a b. (a -> b) -> a -> b
$ UrlComponents :: Authority
-> Path 'Absolute -> Maybe Query -> Maybe Fragment -> UrlComponents
UrlComponents { $sel:urlQuery:UrlComponents :: Maybe Query
urlQuery = Query -> Maybe Query
forall a. a -> Maybe a
Just (Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ (Query -> QueryComponent -> Query)
-> Query -> Seq QueryComponent -> Query
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Query -> QueryComponent -> Query
folder Query
"" (Seq QueryComponent -> Query) -> Seq QueryComponent -> Query
forall a b. (a -> b) -> a -> b
$ QueryBuilder -> Seq QueryComponent
unQueryBuilder QueryBuilder
b  , Maybe Fragment
Path 'Absolute
Authority
urlFragment :: Maybe Fragment
urlPath :: Path 'Absolute
urlAuthority :: Authority
$sel:urlFragment:UrlComponents :: Maybe Fragment
$sel:urlAuthority:UrlComponents :: Authority
$sel:urlPath:UrlComponents :: Path 'Absolute
.. }
    HttpsUrl UrlComponents { Maybe Query
Maybe Fragment
Path 'Absolute
Authority
urlFragment :: Maybe Fragment
urlQuery :: Maybe Query
urlPath :: Path 'Absolute
urlAuthority :: Authority
$sel:urlFragment:UrlComponents :: UrlComponents -> Maybe Fragment
$sel:urlQuery:UrlComponents :: UrlComponents -> Maybe Query
$sel:urlAuthority:UrlComponents :: UrlComponents -> Authority
$sel:urlPath:UrlComponents :: UrlComponents -> Path 'Absolute
.. } -> UrlComponents -> Url "https"
HttpsUrl (UrlComponents -> Url "https") -> UrlComponents -> Url "https"
forall a b. (a -> b) -> a -> b
$ UrlComponents :: Authority
-> Path 'Absolute -> Maybe Query -> Maybe Fragment -> UrlComponents
UrlComponents { $sel:urlQuery:UrlComponents :: Maybe Query
urlQuery = Query -> Maybe Query
forall a. a -> Maybe a
Just (Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ (Query -> QueryComponent -> Query)
-> Query -> Seq QueryComponent -> Query
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Query -> QueryComponent -> Query
folder Query
"" (Seq QueryComponent -> Query) -> Seq QueryComponent -> Query
forall a b. (a -> b) -> a -> b
$ QueryBuilder -> Seq QueryComponent
unQueryBuilder QueryBuilder
b  , Maybe Fragment
Path 'Absolute
Authority
urlFragment :: Maybe Fragment
urlPath :: Path 'Absolute
urlAuthority :: Authority
$sel:urlFragment:UrlComponents :: Maybe Fragment
$sel:urlAuthority:UrlComponents :: Authority
$sel:urlPath:UrlComponents :: Path 'Absolute
.. }
  where 
    folder :: Query -> QueryComponent -> Query
folder Query
"" (QueryFlag Text
val)       = Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
val
    folder Query
"" (QueryParam Text
key Text
val)  = Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
val
    folder Query
acc (QueryFlag Text
val)      = Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Query -> Text
unQuery Query
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
val
    folder Query
acc (QueryParam Text
key Text
val) = Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Query -> Text
unQuery Query
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
val

infixl 8 ?

-- | Generate a query paramter of the form @key=value@
(=:) :: IsQueryVal a => Text -> a -> QueryBuilder
=: :: Text -> a -> QueryBuilder
(=:) Text
key a
value = Seq QueryComponent -> QueryBuilder
QueryBuilder (Seq QueryComponent -> QueryBuilder)
-> (QueryComponent -> Seq QueryComponent)
-> QueryComponent
-> QueryBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryComponent -> Seq QueryComponent
forall a. a -> Seq a
SQ.singleton (QueryComponent -> QueryBuilder) -> QueryComponent -> QueryBuilder
forall a b. (a -> b) -> a -> b
$ Text -> Text -> QueryComponent
QueryParam Text
key (a -> Text
forall a. IsQueryVal a => a -> Text
toQueryVal a
value)