{-# LANGUAGE DeriveGeneric #-}
module Data.XRD.Types
( XRD(..)
, emptyXRD
, Subject(..)
, subject
, Property(..)
, property
, property_
, Link(..)
, emptyLink
, LinkRel(..)
, linkRelURI
, linkRelText
, LinkType(..)
, Title(..)
, uri
, URIParseError(..)
, uriText
) where
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import URI.ByteString (URIParseError(..), URIRef, Absolute, laxURIParserOptions, parseURI, normalizeURIRef', aggressiveNormalization)
data XRD = XRD
{ xrdID :: Maybe Text
, xrdExpires :: Maybe UTCTime
, xrdSubject :: Maybe Subject
, xrdAliases :: [Subject]
, xrdProperties :: [Property]
, xrdLinks :: [Link]
} deriving (Eq, Show, Generic)
emptyXRD :: XRD
emptyXRD = XRD
{ xrdID = Nothing
, xrdExpires = Nothing
, xrdSubject = Nothing
, xrdAliases = []
, xrdProperties = []
, xrdLinks = []
}
newtype Subject = Subject (URIRef Absolute)
deriving (Eq, Ord, Show, Generic)
subject :: Text -> Either URIParseError Subject
subject = fmap Subject . uri
data Property = Property (URIRef Absolute) (Maybe Text)
deriving (Eq, Ord, Show, Generic)
property :: Text -> Maybe Text -> Either URIParseError Property
property typ body = Property
<$> uri typ
<*> pure body
property_ :: Text -> Either URIParseError Property
property_ typ = property typ Nothing
data Link = Link
{ linkRel :: Maybe LinkRel
, linkType :: Maybe LinkType
, linkHref :: Maybe (URIRef Absolute)
, linkTemplate :: Maybe Text
, linkTitles :: [Title]
, linkProperties :: [Property]
} deriving (Eq, Ord, Show, Generic)
emptyLink :: Link
emptyLink = Link
{ linkRel = Nothing
, linkType = Nothing
, linkHref = Nothing
, linkTemplate = Nothing
, linkTitles = mempty
, linkProperties = mempty
}
data LinkRel
= LinkRelURI (URIRef Absolute)
| LinkRelRegistered Text
deriving (Eq, Ord, Show, Generic)
linkRelURI :: Text -> Either URIParseError LinkRel
linkRelURI = fmap LinkRelURI . uri
linkRelText :: LinkRel -> Text
linkRelText lr = case lr of
LinkRelURI lrURI ->
uriText lrURI
LinkRelRegistered lrR ->
lrR
newtype LinkType = LinkType Text
deriving (Eq, Ord, Show, Generic)
data Title = Title (Maybe Text) Text
deriving (Eq, Ord, Show, Generic)
uri :: Text -> Either URIParseError (URIRef Absolute)
uri = parseURI laxURIParserOptions . encodeUtf8
uriText :: URIRef Absolute -> Text
uriText = decodeUtf8 . normalizeURIRef' aggressiveNormalization