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

module Dormouse.Uri.Types
  ( UriReferenceType(..)
  , Authority(..)
  , Fragment(..)
  , Host(..)
  , Path(..)
  , PathSegment(..)
  , Query(..)
  , Scheme(..)
  , UserInfo(..)
  , Uri(..)
  , RelRef(..)
  , UriReference(..)
  ) where

import Data.String (IsString(..))
import qualified Data.List as L
import Data.Text (Text, unpack, pack)
import qualified Data.Text as T
import Language.Haskell.TH.Syntax (Lift(..))

-- | The UserInfo subcomponent of a URI Authority
newtype UserInfo = UserInfo 
  { UserInfo -> Text
unUserInfo :: Text
  } deriving (UserInfo -> UserInfo -> Bool
(UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool) -> Eq UserInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserInfo -> UserInfo -> Bool
== :: UserInfo -> UserInfo -> Bool
$c/= :: UserInfo -> UserInfo -> Bool
/= :: UserInfo -> UserInfo -> Bool
Eq, (forall (m :: * -> *). Quote m => UserInfo -> m Exp)
-> (forall (m :: * -> *). Quote m => UserInfo -> Code m UserInfo)
-> Lift UserInfo
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => UserInfo -> m Exp
forall (m :: * -> *). Quote m => UserInfo -> Code m UserInfo
$clift :: forall (m :: * -> *). Quote m => UserInfo -> m Exp
lift :: forall (m :: * -> *). Quote m => UserInfo -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => UserInfo -> Code m UserInfo
liftTyped :: forall (m :: * -> *). Quote m => UserInfo -> Code m UserInfo
Lift)

instance Show UserInfo where
  show :: UserInfo -> String
show UserInfo
userInfo = -- applications should not render as clear text anything after the first colon
    case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ UserInfo -> Text
unUserInfo UserInfo
userInfo of 
      [] -> String
""
      [Text
x] -> Text -> String
unpack Text
x
      Text
x:[Text]
_ -> Text -> String
unpack Text
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":****"

-- | The Host subcomponent of a URI Authority
newtype Host = Host { Host -> Text
unHost :: Text } deriving (Host -> Host -> Bool
(Host -> Host -> Bool) -> (Host -> Host -> Bool) -> Eq Host
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
/= :: Host -> Host -> Bool
Eq, (forall (m :: * -> *). Quote m => Host -> m Exp)
-> (forall (m :: * -> *). Quote m => Host -> Code m Host)
-> Lift Host
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Host -> m Exp
forall (m :: * -> *). Quote m => Host -> Code m Host
$clift :: forall (m :: * -> *). Quote m => Host -> m Exp
lift :: forall (m :: * -> *). Quote m => Host -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Host -> Code m Host
liftTyped :: forall (m :: * -> *). Quote m => Host -> Code m Host
Lift)

instance IsString Host where
  fromString :: String -> Host
fromString String
s = Text -> Host
Host (Text -> Host) -> Text -> Host
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s

instance Show Host where
  show :: Host -> String
show Host
host = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Host -> Text
unHost Host
host

-- | The Authority component of a URI
data Authority = Authority 
  { Authority -> Maybe UserInfo
authorityUserInfo :: Maybe UserInfo
  , Authority -> Host
authorityHost :: Host
  , Authority -> Maybe Int
authorityPort :: Maybe Int
  } deriving (Authority -> Authority -> Bool
(Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool) -> Eq Authority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Authority -> Authority -> Bool
== :: Authority -> Authority -> Bool
$c/= :: Authority -> Authority -> Bool
/= :: Authority -> Authority -> Bool
Eq, Int -> Authority -> ShowS
[Authority] -> ShowS
Authority -> String
(Int -> Authority -> ShowS)
-> (Authority -> String)
-> ([Authority] -> ShowS)
-> Show Authority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Authority -> ShowS
showsPrec :: Int -> Authority -> ShowS
$cshow :: Authority -> String
show :: Authority -> String
$cshowList :: [Authority] -> ShowS
showList :: [Authority] -> ShowS
Show, (forall (m :: * -> *). Quote m => Authority -> m Exp)
-> (forall (m :: * -> *). Quote m => Authority -> Code m Authority)
-> Lift Authority
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Authority -> m Exp
forall (m :: * -> *). Quote m => Authority -> Code m Authority
$clift :: forall (m :: * -> *). Quote m => Authority -> m Exp
lift :: forall (m :: * -> *). Quote m => Authority -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Authority -> Code m Authority
liftTyped :: forall (m :: * -> *). Quote m => Authority -> Code m Authority
Lift)

-- | The Fragment component of a URI
newtype Fragment = Fragment { Fragment -> Text
unFragment :: Text } deriving (Fragment -> Fragment -> Bool
(Fragment -> Fragment -> Bool)
-> (Fragment -> Fragment -> Bool) -> Eq Fragment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fragment -> Fragment -> Bool
== :: Fragment -> Fragment -> Bool
$c/= :: Fragment -> Fragment -> Bool
/= :: Fragment -> Fragment -> Bool
Eq, (forall (m :: * -> *). Quote m => Fragment -> m Exp)
-> (forall (m :: * -> *). Quote m => Fragment -> Code m Fragment)
-> Lift Fragment
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Fragment -> m Exp
forall (m :: * -> *). Quote m => Fragment -> Code m Fragment
$clift :: forall (m :: * -> *). Quote m => Fragment -> m Exp
lift :: forall (m :: * -> *). Quote m => Fragment -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Fragment -> Code m Fragment
liftTyped :: forall (m :: * -> *). Quote m => Fragment -> Code m Fragment
Lift)

instance IsString Fragment where
  fromString :: String -> Fragment
fromString String
s = Text -> Fragment
Fragment (Text -> Fragment) -> Text -> Fragment
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s

instance Show Fragment where
  show :: Fragment -> String
show Fragment
fragment = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Fragment -> Text
unFragment Fragment
fragment

data UriReferenceType = Absolute | Relative

-- | The Path component of a URI, including a series of individual Path Segments
newtype Path (ref :: UriReferenceType) = Path { forall (ref :: UriReferenceType). Path ref -> [PathSegment]
unPath :: [PathSegment]} deriving (Path ref -> Path ref -> Bool
(Path ref -> Path ref -> Bool)
-> (Path ref -> Path ref -> Bool) -> Eq (Path ref)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (ref :: UriReferenceType). Path ref -> Path ref -> Bool
$c== :: forall (ref :: UriReferenceType). Path ref -> Path ref -> Bool
== :: Path ref -> Path ref -> Bool
$c/= :: forall (ref :: UriReferenceType). Path ref -> Path ref -> Bool
/= :: Path ref -> Path ref -> Bool
Eq, (forall (m :: * -> *). Quote m => Path ref -> m Exp)
-> (forall (m :: * -> *). Quote m => Path ref -> Code m (Path ref))
-> Lift (Path ref)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (ref :: UriReferenceType) (m :: * -> *).
Quote m =>
Path ref -> m Exp
forall (ref :: UriReferenceType) (m :: * -> *).
Quote m =>
Path ref -> Code m (Path ref)
forall (m :: * -> *). Quote m => Path ref -> m Exp
forall (m :: * -> *). Quote m => Path ref -> Code m (Path ref)
$clift :: forall (ref :: UriReferenceType) (m :: * -> *).
Quote m =>
Path ref -> m Exp
lift :: forall (m :: * -> *). Quote m => Path ref -> m Exp
$cliftTyped :: forall (ref :: UriReferenceType) (m :: * -> *).
Quote m =>
Path ref -> Code m (Path ref)
liftTyped :: forall (m :: * -> *). Quote m => Path ref -> Code m (Path ref)
Lift)

instance Show (Path ref) where
  show :: Path ref -> String
show Path ref
path = String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"," ((PathSegment -> String) -> [PathSegment] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathSegment -> String
forall a. Show a => a -> String
show ([PathSegment] -> [String])
-> (Path ref -> [PathSegment]) -> Path ref -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path ref -> [PathSegment]
forall (ref :: UriReferenceType). Path ref -> [PathSegment]
unPath (Path ref -> [String]) -> Path ref -> [String]
forall a b. (a -> b) -> a -> b
$ Path ref
path) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"

-- | An individial Path segment of a URI
newtype PathSegment = PathSegment { PathSegment -> Text
unPathSegment :: Text } deriving (PathSegment -> PathSegment -> Bool
(PathSegment -> PathSegment -> Bool)
-> (PathSegment -> PathSegment -> Bool) -> Eq PathSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathSegment -> PathSegment -> Bool
== :: PathSegment -> PathSegment -> Bool
$c/= :: PathSegment -> PathSegment -> Bool
/= :: PathSegment -> PathSegment -> Bool
Eq, (forall (m :: * -> *). Quote m => PathSegment -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    PathSegment -> Code m PathSegment)
-> Lift PathSegment
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PathSegment -> m Exp
forall (m :: * -> *). Quote m => PathSegment -> Code m PathSegment
$clift :: forall (m :: * -> *). Quote m => PathSegment -> m Exp
lift :: forall (m :: * -> *). Quote m => PathSegment -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => PathSegment -> Code m PathSegment
liftTyped :: forall (m :: * -> *). Quote m => PathSegment -> Code m PathSegment
Lift)

instance IsString PathSegment where
  fromString :: String -> PathSegment
fromString String
s = Text -> PathSegment
PathSegment (Text -> PathSegment) -> Text -> PathSegment
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s

instance Show PathSegment where
  show :: PathSegment -> String
show PathSegment
seg = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ PathSegment -> Text
unPathSegment PathSegment
seg

-- | The Query component of a URI
newtype Query = Query { Query -> Text
unQuery :: Text } deriving (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
/= :: Query -> Query -> Bool
Eq, (forall (m :: * -> *). Quote m => Query -> m Exp)
-> (forall (m :: * -> *). Quote m => Query -> Code m Query)
-> Lift Query
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Query -> m Exp
forall (m :: * -> *). Quote m => Query -> Code m Query
$clift :: forall (m :: * -> *). Quote m => Query -> m Exp
lift :: forall (m :: * -> *). Quote m => Query -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Query -> Code m Query
liftTyped :: forall (m :: * -> *). Quote m => Query -> Code m Query
Lift)

instance IsString Query where
  fromString :: String -> Query
fromString String
s = Text -> Query
Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s

instance Show Query where
  show :: Query -> String
show Query
query = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Query -> Text
unQuery Query
query

-- | The Scheme component of a URI
newtype Scheme = Scheme { Scheme -> Text
unScheme :: Text } deriving (Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
/= :: Scheme -> Scheme -> Bool
Eq, (forall (m :: * -> *). Quote m => Scheme -> m Exp)
-> (forall (m :: * -> *). Quote m => Scheme -> Code m Scheme)
-> Lift Scheme
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Scheme -> m Exp
forall (m :: * -> *). Quote m => Scheme -> Code m Scheme
$clift :: forall (m :: * -> *). Quote m => Scheme -> m Exp
lift :: forall (m :: * -> *). Quote m => Scheme -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Scheme -> Code m Scheme
liftTyped :: forall (m :: * -> *). Quote m => Scheme -> Code m Scheme
Lift)

instance Show Scheme where
  show :: Scheme -> String
show Scheme
scheme = Text -> String
unpack (Text -> String) -> (Scheme -> Text) -> Scheme -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scheme -> Text
unScheme (Scheme -> String) -> Scheme -> String
forall a b. (a -> b) -> a -> b
$ Scheme
scheme

-- | A Uniform Resource Identifier (URI) is a compact sequence of characters that identifies an abstract or physical resource.
-- It is defined according to RFC 3986 (<https://tools.ietf.org/html/rfc3986>).
data Uri = Uri
  { Uri -> Scheme
uriScheme :: Scheme
  , Uri -> Maybe Authority
uriAuthority :: Maybe Authority
  , Uri -> Path 'Absolute
uriPath :: Path 'Absolute
  , Uri -> Maybe Query
uriQuery :: Maybe Query
  , Uri -> Maybe Fragment
uriFragment :: Maybe Fragment
  } deriving (Uri -> Uri -> Bool
(Uri -> Uri -> Bool) -> (Uri -> Uri -> Bool) -> Eq Uri
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Uri -> Uri -> Bool
== :: Uri -> Uri -> Bool
$c/= :: Uri -> Uri -> Bool
/= :: Uri -> Uri -> Bool
Eq, Int -> Uri -> ShowS
[Uri] -> ShowS
Uri -> String
(Int -> Uri -> ShowS)
-> (Uri -> String) -> ([Uri] -> ShowS) -> Show Uri
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Uri -> ShowS
showsPrec :: Int -> Uri -> ShowS
$cshow :: Uri -> String
show :: Uri -> String
$cshowList :: [Uri] -> ShowS
showList :: [Uri] -> ShowS
Show, (forall (m :: * -> *). Quote m => Uri -> m Exp)
-> (forall (m :: * -> *). Quote m => Uri -> Code m Uri) -> Lift Uri
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Uri -> m Exp
forall (m :: * -> *). Quote m => Uri -> Code m Uri
$clift :: forall (m :: * -> *). Quote m => Uri -> m Exp
lift :: forall (m :: * -> *). Quote m => Uri -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Uri -> Code m Uri
liftTyped :: forall (m :: * -> *). Quote m => Uri -> Code m Uri
Lift)

-- | The data associated with a URI Relative Reference
data RelRef = RelRef
  { RelRef -> Maybe Authority
relRefAuthority :: Maybe Authority
  , RelRef -> Path 'Relative
relRefPath :: Path 'Relative
  , RelRef -> Maybe Query
relRefQuery :: Maybe Query
  , RelRef -> Maybe Fragment
relRefFragment :: Maybe Fragment
  } deriving (RelRef -> RelRef -> Bool
(RelRef -> RelRef -> Bool)
-> (RelRef -> RelRef -> Bool) -> Eq RelRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelRef -> RelRef -> Bool
== :: RelRef -> RelRef -> Bool
$c/= :: RelRef -> RelRef -> Bool
/= :: RelRef -> RelRef -> Bool
Eq, Int -> RelRef -> ShowS
[RelRef] -> ShowS
RelRef -> String
(Int -> RelRef -> ShowS)
-> (RelRef -> String) -> ([RelRef] -> ShowS) -> Show RelRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelRef -> ShowS
showsPrec :: Int -> RelRef -> ShowS
$cshow :: RelRef -> String
show :: RelRef -> String
$cshowList :: [RelRef] -> ShowS
showList :: [RelRef] -> ShowS
Show, (forall (m :: * -> *). Quote m => RelRef -> m Exp)
-> (forall (m :: * -> *). Quote m => RelRef -> Code m RelRef)
-> Lift RelRef
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => RelRef -> m Exp
forall (m :: * -> *). Quote m => RelRef -> Code m RelRef
$clift :: forall (m :: * -> *). Quote m => RelRef -> m Exp
lift :: forall (m :: * -> *). Quote m => RelRef -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => RelRef -> Code m RelRef
liftTyped :: forall (m :: * -> *). Quote m => RelRef -> Code m RelRef
Lift)

-- | A URI-reference is either a URI or a relative reference.  If the URI-reference's prefix does not match the syntax of a scheme 
-- followed by its colon separator, then the URI-reference is a relative reference.
data UriReference 
  = AbsoluteUri Uri
  | RelativeRef RelRef
  deriving ((forall (m :: * -> *). Quote m => UriReference -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    UriReference -> Code m UriReference)
-> Lift UriReference
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => UriReference -> m Exp
forall (m :: * -> *).
Quote m =>
UriReference -> Code m UriReference
$clift :: forall (m :: * -> *). Quote m => UriReference -> m Exp
lift :: forall (m :: * -> *). Quote m => UriReference -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
UriReference -> Code m UriReference
liftTyped :: forall (m :: * -> *).
Quote m =>
UriReference -> Code m UriReference
Lift, UriReference -> UriReference -> Bool
(UriReference -> UriReference -> Bool)
-> (UriReference -> UriReference -> Bool) -> Eq UriReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UriReference -> UriReference -> Bool
== :: UriReference -> UriReference -> Bool
$c/= :: UriReference -> UriReference -> Bool
/= :: UriReference -> UriReference -> Bool
Eq, Int -> UriReference -> ShowS
[UriReference] -> ShowS
UriReference -> String
(Int -> UriReference -> ShowS)
-> (UriReference -> String)
-> ([UriReference] -> ShowS)
-> Show UriReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UriReference -> ShowS
showsPrec :: Int -> UriReference -> ShowS
$cshow :: UriReference -> String
show :: UriReference -> String
$cshowList :: [UriReference] -> ShowS
showList :: [UriReference] -> ShowS
Show)