{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Orphan-less conversions to JSON (as JRD, by rfc6415).

module Data.XRD.JSON
  ( toByteString
  , toValue
    -- * Conversions for inner parts
  , subjectToValue
  , propertiesToValue
  , linkToValue
  ) where

import Data.Aeson (Value, encode, object, toJSON, (.=))
import Data.ByteString.Lazy (ByteString)
import Data.Maybe (fromMaybe, maybeToList)

import Data.XRD.Types
  ( XRD(..)
  , Subject(..)
  , Property(..)
  , Link(..), LinkType(..), Title(..)
  , uriText, linkRelText
  )

toByteString :: XRD -> ByteString
toByteString = encode . toValue

toValue :: XRD -> Value
toValue XRD{..} = object topLvl
  where
    topLvl = mconcat $ map maybeToList
      [ fmap
          (\e -> "expires" .= e)
          xrdExpires
      , fmap
          (\s -> "subject" .= subjectToValue s)
          xrdSubject
      , aliases
      , properties
      , links
      ]

    aliases
      | null xrdAliases = Nothing
      | otherwise = Just
        ( "aliases" .=
          [ uriText uri
          | Subject uri <- xrdAliases
          ]
        )

    properties
      | null xrdProperties = Nothing
      | otherwise = Just
        ( "properties" .= propertiesToValue xrdProperties
        )

    links
      | null xrdLinks = Nothing
      | otherwise = Just
        ( "links" .= map linkToValue xrdLinks
        )

subjectToValue :: Subject -> Value
subjectToValue (Subject uri) = toJSON (uriText uri)

propertiesToValue :: [Property] -> Value
propertiesToValue props = object
  [ uriText uri .= val
  | Property uri val <- props
  ]

linkToValue :: Link -> Value
linkToValue Link{..} = object . mconcat $ map maybeToList
  [ fmap
      (\r -> "rel" .= linkRelText r)
      linkRel
  , fmap
      (\(LinkType t) -> "type" .= t)
      linkType
  , fmap
      (\uri -> "href" .= uriText uri)
      linkHref
  , fmap
      (\t -> "template" .= t)
      linkTemplate
  , titles
  , properties
  ]
  where
    titles
      | null linkTitles = Nothing
      | otherwise = Just
        ( "titles" .= object
          [ fromMaybe "default" lang .= title
          | Title lang title <- linkTitles
          ]
        )
    properties
      | null linkProperties = Nothing
      | otherwise = Just
        ( "properties" .= propertiesToValue linkProperties
        )