{-# LANGUAGE DeriveGeneric #-}

module Data.XRD.Types
  ( XRD(..)
  , emptyXRD
  -- * Document fields
  , Subject(..)
  , subject
  , Property(..)
  , property
  , property_
  , Link(..)
  , emptyLink
  , LinkRel(..)
  , linkRelURI
  , linkRelText
  , LinkType(..)
  , Title(..)
  -- * URI building helper
  , 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