--------------------------------------------------------------------
-- |
-- Module    : Text.Atom.Feed.Link
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
--------------------------------------------------------------------
module Text.Atom.Feed.Link
  ( LinkRelation(..)
  , showLinkRelation
  , showLinkAttr
  ) where

import Prelude.Compat

-- | Atom feeds uses typed IRI links to represent
-- information \/ metadata that is of interest to the
-- consumers (software, in the main) of feeds. For instance,
-- the edit link relation attached to an atom:entry element
-- points to the IRI to use to update\/edit it.
--
-- The Atom standard encourages that such typed links to
-- be registered with IANA if they have wider applicability,
-- and the 'LinkRelation' data type encodes the currently
-- registered link types (derived from:
--  http:\/\/www.iana.org\/assignments\/link-relations.html
-- on 2007-10-28]
--
data LinkRelation -- relevant RFC:
  = LinkAlternate -- http://www.rfc-editor.org/rfc/rfc4287.txt
  | LinkCurrent -- http://www.rfc-editor.org/rfc/rfc5005.txt
  | LinkEnclosure -- http://www.rfc-editor.org/rfc/rfc4287.txt
  | LinkEdit -- http://www.rfc-editor.org/rfc/rfc5023.txt
  | LinkEditMedia -- http://www.rfc-editor.org/rfc/rfc5023.txt
  | LinkFirst -- http://www.iana.org/assignments/link-relations/first
  | LinkLast -- http://www.iana.org/assignments/link-relations/last
  | LinkLicense -- http://www.rfc-editor.org/rfc/rfc4946.txt
  | LinkNext -- http://www.rfc-editor.org/rfc/rfc5005.txt
  | LinkNextArchive -- http://www.rfc-editor.org/rfc/rfc5005.txt
  | LinkPayment -- http://www.iana.org/assignments/link-relations/payment
  | LinkPrevArchive -- http://www.rfc-editor.org/rfc/rfc5005.txt
  | LinkPrevious -- http://www.rfc-editor.org/rfc/rfc5005.txt
  | LinkRelated -- http://www.rfc-editor.org/rfc/rfc4287.txt
  | LinkReplies -- http://www.rfc-editor.org/rfc/rfc4685.txt
  | LinkSelf -- http://www.rfc-editor.org/rfc/rfc4287.txt
  | LinkVia -- http://www.rfc-editor.org/rfc/rfc4287.txt
  | LinkOther String
  deriving (LinkRelation -> LinkRelation -> Bool
(LinkRelation -> LinkRelation -> Bool)
-> (LinkRelation -> LinkRelation -> Bool) -> Eq LinkRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkRelation -> LinkRelation -> Bool
$c/= :: LinkRelation -> LinkRelation -> Bool
== :: LinkRelation -> LinkRelation -> Bool
$c== :: LinkRelation -> LinkRelation -> Bool
Eq, Int -> LinkRelation -> ShowS
[LinkRelation] -> ShowS
LinkRelation -> String
(Int -> LinkRelation -> ShowS)
-> (LinkRelation -> String)
-> ([LinkRelation] -> ShowS)
-> Show LinkRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkRelation] -> ShowS
$cshowList :: [LinkRelation] -> ShowS
show :: LinkRelation -> String
$cshow :: LinkRelation -> String
showsPrec :: Int -> LinkRelation -> ShowS
$cshowsPrec :: Int -> LinkRelation -> ShowS
Show)

showLinkRelation :: LinkRelation -> String
showLinkRelation :: LinkRelation -> String
showLinkRelation LinkRelation
lr =
  case LinkRelation
lr of
    LinkRelation
LinkAlternate -> String
"alternate"
    LinkRelation
LinkCurrent -> String
"current"
    LinkRelation
LinkEnclosure -> String
"enclosure"
    LinkRelation
LinkEdit -> String
"edit"
    LinkRelation
LinkEditMedia -> String
"edit-media"
    LinkRelation
LinkFirst -> String
"first"
    LinkRelation
LinkLast -> String
"last"
    LinkRelation
LinkLicense -> String
"license"
    LinkRelation
LinkNext -> String
"next"
    LinkRelation
LinkNextArchive -> String
"next-archive"
    LinkRelation
LinkPayment -> String
"payment"
    LinkRelation
LinkPrevArchive -> String
"prev-archive"
    LinkRelation
LinkPrevious -> String
"previous"
    LinkRelation
LinkRelated -> String
"related"
    LinkRelation
LinkReplies -> String
"replies"
    LinkRelation
LinkSelf -> String
"self"
    LinkRelation
LinkVia -> String
"via"
    LinkOther String
s -> String
s

showLinkAttr :: LinkRelation -> String -> String {-URI-}
showLinkAttr :: LinkRelation -> ShowS
showLinkAttr LinkRelation
lr String
s = LinkRelation -> String
showLinkRelation LinkRelation
lr String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escQ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
  where
    escQ :: Char -> String
escQ Char
'"' = String
"&dquot;"
    escQ Char
x = [Char
x]