{-# 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 { unUserInfo :: Text } deriving (Eq, Lift) instance Show UserInfo where show userInfo = -- applications should not render as clear text anything after the first colon case T.split (==':') $ unUserInfo userInfo of [] -> "" [x] -> unpack x x:_ -> unpack x <> ":****" -- | The Host subcomponent of a URI Authority newtype Host = Host { unHost :: Text } deriving (Eq, Lift) instance IsString Host where fromString s = Host $ pack s instance Show Host where show host = unpack $ unHost host -- | The Authority component of a URI data Authority = Authority { authorityUserInfo :: Maybe UserInfo , authorityHost :: Host , authorityPort :: Maybe Int } deriving (Eq, Show, Lift) -- | The Fragment component of a URI newtype Fragment = Fragment { unFragment :: Text } deriving (Eq, Lift) instance IsString Fragment where fromString s = Fragment $ pack s instance Show Fragment where show fragment = unpack $ unFragment fragment data UriReferenceType = Absolute | Relative -- | The Path component of a URI, including a series of individual Path Segments newtype Path (ref :: UriReferenceType) = Path { unPath :: [PathSegment]} deriving (Eq, Lift) instance Show (Path ref) where show path = "[" <> L.intercalate "," (fmap show . unPath $ path) <> "]" -- | An individial Path segment of a URI newtype PathSegment = PathSegment { unPathSegment :: Text } deriving (Eq, Lift) instance IsString PathSegment where fromString s = PathSegment $ pack s instance Show PathSegment where show seg = unpack $ unPathSegment seg -- | The Query component of a URI newtype Query = Query { unQuery :: Text } deriving (Eq, Lift) instance IsString Query where fromString s = Query $ pack s instance Show Query where show query = unpack $ unQuery query -- | The Scheme component of a URI newtype Scheme = Scheme { unScheme :: Text } deriving (Eq, Lift) instance Show Scheme where show scheme = unpack . unScheme $ 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 (). data Uri = Uri { uriScheme :: Scheme , uriAuthority :: Maybe Authority , uriPath :: Path 'Absolute , uriQuery :: Maybe Query , uriFragment :: Maybe Fragment } deriving (Eq, Show, Lift) -- | The data associated with a URI Relative Reference data RelRef = RelRef { relRefAuthority :: Maybe Authority , relRefPath :: Path 'Relative , relRefQuery :: Maybe Query , relRefFragment :: Maybe Fragment } deriving (Eq, Show, 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 (Lift, Eq, Show)