{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE TemplateHaskell #-}

module Dormouse.Url.Types
  ( UrlComponents(..)
  , UrlScheme(..)
  , Url(..)
  , AnyUrl(..)
  ) where

import Dormouse.Uri.Types
import GHC.TypeLits
import Language.Haskell.TH.Syntax (Lift(..))

data UrlComponents = UrlComponents
  { UrlComponents -> Authority
urlAuthority :: Authority
  , UrlComponents -> Path 'Absolute
urlPath :: Path 'Absolute
  , UrlComponents -> Maybe Query
urlQuery :: Maybe Query
  , UrlComponents -> Maybe Fragment
urlFragment :: Maybe Fragment
  } deriving (UrlComponents -> UrlComponents -> Bool
(UrlComponents -> UrlComponents -> Bool)
-> (UrlComponents -> UrlComponents -> Bool) -> Eq UrlComponents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UrlComponents -> UrlComponents -> Bool
$c/= :: UrlComponents -> UrlComponents -> Bool
== :: UrlComponents -> UrlComponents -> Bool
$c== :: UrlComponents -> UrlComponents -> Bool
Eq, Int -> UrlComponents -> ShowS
[UrlComponents] -> ShowS
UrlComponents -> String
(Int -> UrlComponents -> ShowS)
-> (UrlComponents -> String)
-> ([UrlComponents] -> ShowS)
-> Show UrlComponents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UrlComponents] -> ShowS
$cshowList :: [UrlComponents] -> ShowS
show :: UrlComponents -> String
$cshow :: UrlComponents -> String
showsPrec :: Int -> UrlComponents -> ShowS
$cshowsPrec :: Int -> UrlComponents -> ShowS
Show, UrlComponents -> Q Exp
UrlComponents -> Q (TExp UrlComponents)
(UrlComponents -> Q Exp)
-> (UrlComponents -> Q (TExp UrlComponents)) -> Lift UrlComponents
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: UrlComponents -> Q (TExp UrlComponents)
$cliftTyped :: UrlComponents -> Q (TExp UrlComponents)
lift :: UrlComponents -> Q Exp
$clift :: UrlComponents -> Q Exp
Lift)

data UrlScheme
  = HttpScheme
  | HttpsScheme

-- | A 'Url' is defined here as an absolute URI in the @http@ or @https@ schemes.  Authority components are requried by the http / https
-- Uri schemes.
data Url (scheme :: Symbol) where
  HttpUrl  :: UrlComponents -> Url "http"
  HttpsUrl :: UrlComponents -> Url "https"

instance Eq (Url scheme) where
  == :: Url scheme -> Url scheme -> Bool
(==) (HttpUrl UrlComponents
u1)  (HttpUrl UrlComponents
u2)  = UrlComponents -> String
forall a. Show a => a -> String
show UrlComponents
u1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== UrlComponents -> String
forall a. Show a => a -> String
show UrlComponents
u2
  (==) (HttpsUrl UrlComponents
u1) (HttpsUrl UrlComponents
u2) = UrlComponents -> String
forall a. Show a => a -> String
show UrlComponents
u1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== UrlComponents -> String
forall a. Show a => a -> String
show UrlComponents
u2

instance Show (Url scheme) where
  show :: Url scheme -> String
show (HttpUrl UrlComponents
wu)  = String
"http " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UrlComponents -> String
forall a. Show a => a -> String
show UrlComponents
wu
  show (HttpsUrl UrlComponents
wu) = String
"https " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UrlComponents -> String
forall a. Show a => a -> String
show UrlComponents
wu

instance Lift (Url scheme) where
  lift :: Url scheme -> Q Exp
lift (HttpUrl UrlComponents
uc)  = [| HttpUrl uc |]
  lift (HttpsUrl UrlComponents
uc) = [| HttpsUrl uc |]

-- | `AnyUrl` is a wrapper aroud `Url` which allows either @http@ or @https@ urls.
data AnyUrl = forall scheme. AnyUrl (Url scheme)

instance Eq AnyUrl where
  == :: AnyUrl -> AnyUrl -> Bool
(==) (AnyUrl (HttpUrl UrlComponents
d1)) (AnyUrl (HttpUrl UrlComponents
d2))   = UrlComponents
d1 UrlComponents -> UrlComponents -> Bool
forall a. Eq a => a -> a -> Bool
== UrlComponents
d2
  (==) (AnyUrl (HttpsUrl UrlComponents
d1)) (AnyUrl (HttpsUrl UrlComponents
d2)) = UrlComponents
d1 UrlComponents -> UrlComponents -> Bool
forall a. Eq a => a -> a -> Bool
== UrlComponents
d2
  (==) AnyUrl
_  AnyUrl
_                                          = Bool
False

instance Show AnyUrl where
  show :: AnyUrl -> String
show (AnyUrl Url scheme
u) = Url scheme -> String
forall a. Show a => a -> String
show Url scheme
u

instance Lift AnyUrl where
  lift :: AnyUrl -> Q Exp
lift (AnyUrl Url scheme
u)  = [| AnyUrl u |]