{- This file is part of link-relations. - - Written in 2015 by fr33domlover . - Also includes parts generated from the IANA link relation registry. - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} {-# LANGUAGE OverloadedStrings #-} -- | A simple web link between two web resources, e.g. a hyperlink in a webpage -- referring to another page, suggests that the resources are somehow related, -- but it doesn't say /how/ they are related. For example, a blog post may link -- to the author's main page (relation: author of the post) but also link to -- the previous post (relation: previous post by chronological order). -- -- Link relations provide a way to express the relation between resources -- linked by a web link. -- -- A link relation type may be represented by a URI, or by a registered link -- relation name. IANA maintains a -- of link -- relations. This module provides access to them through a dedicated -- 'LinkRelation' datatype. -- -- This version of the package corresponds to the -- /2016-01-22/ -- version of the registry. module Web.LinkRelations ( -- * Types and Conversions LinkRelation , fromURI , fromURIStr , fromName , fromByteString , isURI , isName , toByteString -- * Link Relation Identifiers , relAbout , relAlternate , relAppendix , relArchives , relAuthor , relBlockedBy , relBookmark , relCanonical , relChapter , relCollection , relContents , relCopyright , relCreateForm , relCurrent , relDerivedfrom , relDescribedby , relDescribes , relDisclosure , relDuplicate , relEdit , relEditForm , relEditMedia , relEnclosure , relFirst , relGlossary , relHelp , relHosts , relHub , relIcon , relIndex , relItem , relLast , relLatestVersion , relLicense , relLrdd , relMemento , relMonitor , relMonitorGroup , relNext , relNextArchive , relNofollow , relNoreferrer , relOriginal , relPayment , relPredecessorVersion , relPrefetch , relPreload , relPrev , relPreview , relPrevious , relPrevArchive , relPrivacyPolicy , relProfile , relRelated , relReplies , relSearch , relSection , relSelf , relService , relStart , relStylesheet , relSubsection , relSuccessorVersion , relTag , relTermsOfService , relTimegate , relTimemap , relType , relUp , relVersionHistory , relVia , relWorkingCopy , relWorkingCopyOf ) where import Control.Applicative ((<|>)) import URI.ByteString import qualified Data.ByteString as B import qualified Data.HashMap.Strict as M -- | A web link relation type. Either a URI or a registered name. data LinkRelation = FromURI URI | RelAbout | RelAlternate | RelAppendix | RelArchives | RelAuthor | RelBlockedBy | RelBookmark | RelCanonical | RelChapter | RelCollection | RelContents | RelCopyright | RelCreateForm | RelCurrent | RelDerivedfrom | RelDescribedby | RelDescribes | RelDisclosure | RelDuplicate | RelEdit | RelEditForm | RelEditMedia | RelEnclosure | RelFirst | RelGlossary | RelHelp | RelHosts | RelHub | RelIcon | RelIndex | RelItem | RelLast | RelLatestVersion | RelLicense | RelLrdd | RelMemento | RelMonitor | RelMonitorGroup | RelNext | RelNextArchive | RelNofollow | RelNoreferrer | RelOriginal | RelPayment | RelPredecessorVersion | RelPrefetch | RelPreload | RelPrev | RelPreview | RelPrevious | RelPrevArchive | RelPrivacyPolicy | RelProfile | RelRelated | RelReplies | RelSearch | RelSection | RelSelf | RelService | RelStart | RelStylesheet | RelSubsection | RelSuccessorVersion | RelTag | RelTermsOfService | RelTimegate | RelTimemap | RelType | RelUp | RelVersionHistory | RelVia | RelWorkingCopy | RelWorkingCopyOf deriving (Eq, Show) -- | A mapping from name string to identifiers, for parsing a link relation -- name from a string. hashmap :: M.HashMap B.ByteString LinkRelation hashmap = M.fromList [ ("about", RelAbout) , ("alternate", RelAlternate) , ("appendix", RelAppendix) , ("archives", RelArchives) , ("author", RelAuthor) , ("blocked-by", RelBlockedBy) , ("bookmark", RelBookmark) , ("canonical", RelCanonical) , ("chapter", RelChapter) , ("collection", RelCollection) , ("contents", RelContents) , ("copyright", RelCopyright) , ("create-form", RelCreateForm) , ("current", RelCurrent) , ("derivedfrom", RelDerivedfrom) , ("describedby", RelDescribedby) , ("describes", RelDescribes) , ("disclosure", RelDisclosure) , ("duplicate", RelDuplicate) , ("edit", RelEdit) , ("edit-form", RelEditForm) , ("edit-media", RelEditMedia) , ("enclosure", RelEnclosure) , ("first", RelFirst) , ("glossary", RelGlossary) , ("help", RelHelp) , ("hosts", RelHosts) , ("hub", RelHub) , ("icon", RelIcon) , ("index", RelIndex) , ("item", RelItem) , ("last", RelLast) , ("latest-version", RelLatestVersion) , ("license", RelLicense) , ("lrdd", RelLrdd) , ("memento", RelMemento) , ("monitor", RelMonitor) , ("monitor-group", RelMonitorGroup) , ("next", RelNext) , ("next-archive", RelNextArchive) , ("nofollow", RelNofollow) , ("noreferrer", RelNoreferrer) , ("original", RelOriginal) , ("payment", RelPayment) , ("predecessor-version", RelPredecessorVersion) , ("prefetch", RelPrefetch) , ("preload", RelPreload) , ("prev", RelPrev) , ("preview", RelPreview) , ("previous", RelPrevious) , ("prev-archive", RelPrevArchive) , ("privacy-policy", RelPrivacyPolicy) , ("profile", RelProfile) , ("related", RelRelated) , ("replies", RelReplies) , ("search", RelSearch) , ("section", RelSection) , ("self", RelSelf) , ("service", RelService) , ("start", RelStart) , ("stylesheet", RelStylesheet) , ("subsection", RelSubsection) , ("successor-version", RelSuccessorVersion) , ("tag", RelTag) , ("terms-of-service", RelTermsOfService) , ("timegate", RelTimegate) , ("timemap", RelTimemap) , ("type", RelType) , ("up", RelUp) , ("version-history", RelVersionHistory) , ("via", RelVia) , ("working-copy", RelWorkingCopy) , ("working-copy-of", RelWorkingCopyOf) ] -- | Create a link relation type from a URI. fromURI :: URI -> LinkRelation fromURI = FromURI -- | Try to parse a string into a URI, returning a link relation if successful. fromURIStr :: B.ByteString -> Maybe LinkRelation fromURIStr s = case parseURI laxURIParserOptions s of Left _ -> Nothing Right u -> Just $ fromURI u -- | Try to match a given link relation name against the registered names. -- Return the matching link relation if successful. fromName :: B.ByteString -> Maybe LinkRelation fromName s = M.lookup s hashmap -- | Try to parse the given string as a link relation, either as a registered -- name or as a URI. If both fail, return 'Nothing'. fromByteString :: B.ByteString -> Maybe LinkRelation fromByteString s = fromName s <|> fromURIStr s -- | Get the official registered name of a link relation (if it's a name) or -- its URI string (if it's a URI). toByteString :: LinkRelation -> B.ByteString toByteString lr = case lr of FromURI u -> serializeURI' u RelAbout -> "about" RelAlternate -> "alternate" RelAppendix -> "appendix" RelArchives -> "archives" RelAuthor -> "author" RelBlockedBy -> "blocked-by" RelBookmark -> "bookmark" RelCanonical -> "canonical" RelChapter -> "chapter" RelCollection -> "collection" RelContents -> "contents" RelCopyright -> "copyright" RelCreateForm -> "create-form" RelCurrent -> "current" RelDerivedfrom -> "derivedfrom" RelDescribedby -> "describedby" RelDescribes -> "describes" RelDisclosure -> "disclosure" RelDuplicate -> "duplicate" RelEdit -> "edit" RelEditForm -> "edit-form" RelEditMedia -> "edit-media" RelEnclosure -> "enclosure" RelFirst -> "first" RelGlossary -> "glossary" RelHelp -> "help" RelHosts -> "hosts" RelHub -> "hub" RelIcon -> "icon" RelIndex -> "index" RelItem -> "item" RelLast -> "last" RelLatestVersion -> "latest-version" RelLicense -> "license" RelLrdd -> "lrdd" RelMemento -> "memento" RelMonitor -> "monitor" RelMonitorGroup -> "monitor-group" RelNext -> "next" RelNextArchive -> "next-archive" RelNofollow -> "nofollow" RelNoreferrer -> "noreferrer" RelOriginal -> "original" RelPayment -> "payment" RelPredecessorVersion -> "predecessor-version" RelPrefetch -> "prefetch" RelPreload -> "preload" RelPrev -> "prev" RelPreview -> "preview" RelPrevious -> "previous" RelPrevArchive -> "prev-archive" RelPrivacyPolicy -> "privacy-policy" RelProfile -> "profile" RelRelated -> "related" RelReplies -> "replies" RelSearch -> "search" RelSection -> "section" RelSelf -> "self" RelService -> "service" RelStart -> "start" RelStylesheet -> "stylesheet" RelSubsection -> "subsection" RelSuccessorVersion -> "successor-version" RelTag -> "tag" RelTermsOfService -> "terms-of-service" RelTimegate -> "timegate" RelTimemap -> "timemap" RelType -> "type" RelUp -> "up" RelVersionHistory -> "version-history" RelVia -> "via" RelWorkingCopy -> "working-copy" RelWorkingCopyOf -> "working-copy-of" -- | Check whether a link relation is represented by a URI, i.e. is not a link -- relation registered name. isURI :: LinkRelation -> Bool isURI (FromURI _) = True isURI _ = False -- | Check whether a link relation is represented by a registered name, i.e. is -- not a URI. isName :: LinkRelation -> Bool isName = not . isURI -- | Refers to a resource that is the subject of the link\'s context. -- -- Reference: , section 2 relAbout :: LinkRelation relAbout = RelAbout -- | Refers to a substitute for this context -- -- Reference: relAlternate :: LinkRelation relAlternate = RelAlternate -- | Refers to an appendix. -- -- Reference: relAppendix :: LinkRelation relAppendix = RelAppendix -- | Refers to a collection of records, documents, or other materials of -- historical interest. -- -- Reference: -- relArchives :: LinkRelation relArchives = RelArchives -- | Refers to the context\'s author. -- -- Reference: relAuthor :: LinkRelation relAuthor = RelAuthor -- | Identifies the entity blocking access to a resource folllowing on receipt -- of a legal demand. -- -- Reference: -- relBlockedBy :: LinkRelation relBlockedBy = RelBlockedBy -- | Gives a permanent link to use for bookmarking purposes. -- -- Reference: relBookmark :: LinkRelation relBookmark = RelBookmark -- | Designates the preferred version of a resource (the IRI and its contents). -- -- Reference: relCanonical :: LinkRelation relCanonical = RelCanonical -- | Refers to a chapter in a collection of resources. -- -- Reference: relChapter :: LinkRelation relChapter = RelChapter -- | The target IRI points to a resource which represents the collection -- resource for the context IRI. -- -- Reference: relCollection :: LinkRelation relCollection = RelCollection -- | Refers to a table of contents. -- -- Reference: relContents :: LinkRelation relContents = RelContents -- | Refers to a copyright statement that applies to the link\'s context. -- -- Reference: relCopyright :: LinkRelation relCopyright = RelCopyright -- | The target IRI points to a resource where a submission form can be -- obtained. -- -- Reference: relCreateForm :: LinkRelation relCreateForm = RelCreateForm -- | Refers to a resource containing the most recent item(s) in a collection of -- resources. -- -- Reference: relCurrent :: LinkRelation relCurrent = RelCurrent -- | The target IRI points to a resource from which this material was derived. -- -- Reference: -- relDerivedfrom :: LinkRelation relDerivedfrom = RelDerivedfrom -- | Refers to a resource providing information about the link\'s context. -- -- Reference: relDescribedby :: LinkRelation relDescribedby = RelDescribedby -- | The relationship A \'describes\' B asserts that resource A provides a -- description of resource B. There are no constraints on the format or -- representation of either A or B, neither are there any further constraints -- on either resource. -- -- Reference: -- -- Note: This link relation type is the inverse of the \'describedby\' relation -- type. While \'describedby\' establishes a relation from the described -- resource back to the resource that describes it, \'describes\' established a -- relation from the describing resource to the resource it describes. If B is -- \'describedby\' A, then A \'describes\' B. relDescribes :: LinkRelation relDescribes = RelDescribes -- | Refers to a list of patent disclosures made with respect to material for -- which \'disclosure\' relation is specified. -- -- Reference: relDisclosure :: LinkRelation relDisclosure = RelDisclosure -- | Refers to a resource whose available representations are byte-for-byte -- identical with the corresponding representations of the context IRI. -- -- Reference: -- -- Note: This relation is for static resources. That is, an HTTP GET request on -- any duplicate will return the same representation. It does not make sense -- for dynamic or POSTable resources and should not be used for them. relDuplicate :: LinkRelation relDuplicate = RelDuplicate -- | Refers to a resource that can be used to edit the link\'s context. -- -- Reference: relEdit :: LinkRelation relEdit = RelEdit -- | The target IRI points to a resource where a submission form for editing -- associated resource can be obtained. -- -- Reference: relEditForm :: LinkRelation relEditForm = RelEditForm -- | Refers to a resource that can be used to edit media associated with the -- link\'s context. -- -- Reference: relEditMedia :: LinkRelation relEditMedia = RelEditMedia -- | Identifies a related resource that is potentially large and might require -- special handling. -- -- Reference: relEnclosure :: LinkRelation relEnclosure = RelEnclosure -- | An IRI that refers to the furthest preceding resource in a series of -- resources. -- -- Reference: -- -- Note: This relation type registration did not indicate a reference. -- Originally requested by Mark Nottingham in December 2004. relFirst :: LinkRelation relFirst = RelFirst -- | Refers to a glossary of terms. -- -- Reference: relGlossary :: LinkRelation relGlossary = RelGlossary -- | Refers to context-sensitive help. -- -- Reference: relHelp :: LinkRelation relHelp = RelHelp -- | Refers to a resource hosted by the server indicated by the link context. -- -- Reference: -- -- Note: This relation is used in CoRE where links are retrieved as a -- \"\/.well-known\/core\" resource representation, and is the default relation -- type in the CoRE Link Format. relHosts :: LinkRelation relHosts = RelHosts -- | Refers to a hub that enables registration for notification of updates to -- the context. -- -- Reference: -- -- Note: This relation type was requested by Brett Slatkin. relHub :: LinkRelation relHub = RelHub -- | Refers to an icon representing the link\'s context. -- -- Reference: relIcon :: LinkRelation relIcon = RelIcon -- | Refers to an index. -- -- Reference: relIndex :: LinkRelation relIndex = RelIndex -- | The target IRI points to a resource that is a member of the collection -- represented by the context IRI. -- -- Reference: relItem :: LinkRelation relItem = RelItem -- | An IRI that refers to the furthest following resource in a series of -- resources. -- -- Reference: -- -- Note: This relation type registration did not indicate a reference. -- Originally requested by Mark Nottingham in December 2004. relLast :: LinkRelation relLast = RelLast -- | Points to a resource containing the latest (e.g., current) version of the -- context. -- -- Reference: relLatestVersion :: LinkRelation relLatestVersion = RelLatestVersion -- | Refers to a license associated with this context. -- -- Reference: -- -- Note: For implications of use in HTML, see: -- http:\/\/www.w3.org\/TR\/html5\/links.html#link-type-license relLicense :: LinkRelation relLicense = RelLicense -- | Refers to further information about the link\'s context, expressed as a -- LRDD (\"Link-based Resource Descriptor Document\") resource. See -- for information about processing -- this relation type in host-meta documents. When used elsewhere, it refers to -- additional links and other metadata. Multiple instances indicate additional -- LRDD resources. LRDD resources MUST have an \"application\/xrd+xml\" -- representation, and MAY have others. -- -- Reference: relLrdd :: LinkRelation relLrdd = RelLrdd -- | The Target IRI points to a Memento, a fixed resource that will not change -- state anymore. -- -- Reference: -- -- Note: A Memento for an Original Resource is a resource that encapsulates a -- prior state of the Original Resource. relMemento :: LinkRelation relMemento = RelMemento -- | Refers to a resource that can be used to monitor changes in an HTTP -- resource. -- -- Reference: relMonitor :: LinkRelation relMonitor = RelMonitor -- | Refers to a resource that can be used to monitor changes in a specified -- group of HTTP resources. -- -- Reference: relMonitorGroup :: LinkRelation relMonitorGroup = RelMonitorGroup -- | Indicates that the link\'s context is a part of a series, and that the -- next in the series is the link target. -- -- Reference: relNext :: LinkRelation relNext = RelNext -- | Refers to the immediately following archive resource. -- -- Reference: relNextArchive :: LinkRelation relNextArchive = RelNextArchive -- | Indicates that the context’s original author or publisher does not -- endorse the link target. -- -- Reference: relNofollow :: LinkRelation relNofollow = RelNofollow -- | Indicates that no referrer information is to be leaked when following the -- link. -- -- Reference: relNoreferrer :: LinkRelation relNoreferrer = RelNoreferrer -- | The Target IRI points to an Original Resource. -- -- Reference: -- -- Note: An Original Resource is a resource that exists or used to exist, and -- for which access to one of its prior states may be required. relOriginal :: LinkRelation relOriginal = RelOriginal -- | Indicates a resource where payment is accepted. -- -- Reference: -- -- Note: This relation type registration did not indicate a reference. -- Requested by Joshua Kinberg and Robert Sayre. It is meant as a general way -- to facilitate acts of payment, and thus this specification makes no -- assumptions on the type of payment or transaction protocol. Examples may -- include a web page where donations are accepted or where goods and services -- are available for purchase. rel=\"payment\" is not intended to initiate an -- automated transaction. In Atom documents, a link element with a -- rel=\"payment\" attribute may exist at the feed\/channel level and\/or the -- entry\/item level. For example, a rel=\"payment\" link at the feed\/channel -- level may point to a \"tip jar\" URI, whereas an entry\/ item containing a -- book review may include a rel=\"payment\" link that points to the location -- where the book may be purchased through an online retailer. relPayment :: LinkRelation relPayment = RelPayment -- | Points to a resource containing the predecessor version in the version -- history. -- -- Reference: relPredecessorVersion :: LinkRelation relPredecessorVersion = RelPredecessorVersion -- | Indicates that the link target should be preemptively cached. -- -- Reference: relPrefetch :: LinkRelation relPrefetch = RelPrefetch -- | Refers to a resource that should be loaded early in the processing of the -- link\'s context, without blocking rendering. -- -- Reference: -- -- Note: Additional target attributes establish the detailed fetch properties -- of the link. relPreload :: LinkRelation relPreload = RelPreload -- | Indicates that the link\'s context is a part of a series, and that the -- previous in the series is the link target. -- -- Reference: relPrev :: LinkRelation relPrev = RelPrev -- | Refers to a resource that provides a preview of the link\'s context. -- -- Reference: , section 3 relPreview :: LinkRelation relPreview = RelPreview -- | Refers to the previous resource in an ordered series of resources. Synonym -- for \"prev\". -- -- Reference: relPrevious :: LinkRelation relPrevious = RelPrevious -- | Refers to the immediately preceding archive resource. -- -- Reference: relPrevArchive :: LinkRelation relPrevArchive = RelPrevArchive -- | Refers to a privacy policy associated with the link\'s context. -- -- Reference: , section 4 relPrivacyPolicy :: LinkRelation relPrivacyPolicy = RelPrivacyPolicy -- | Identifying that a resource representation conforms to a certain profile, -- without affecting the non-profile semantics of the resource representation. -- -- Reference: -- -- Note: Profile URIs are primarily intended to be used as identifiers, and -- thus clients SHOULD NOT indiscriminately access profile URIs. relProfile :: LinkRelation relProfile = RelProfile -- | Identifies a related resource. -- -- Reference: relRelated :: LinkRelation relRelated = RelRelated -- | Identifies a resource that is a reply to the context of the link. -- -- Reference: relReplies :: LinkRelation relReplies = RelReplies -- | Refers to a resource that can be used to search through the link\'s -- context and related resources. -- -- Reference: relSearch :: LinkRelation relSearch = RelSearch -- | Refers to a section in a collection of resources. -- -- Reference: relSection :: LinkRelation relSection = RelSection -- | Conveys an identifier for the link\'s context. -- -- Reference: relSelf :: LinkRelation relSelf = RelSelf -- | Indicates a URI that can be used to retrieve a service document. -- -- Reference: -- -- Note: When used in an Atom document, this relation type specifies Atom -- Publishing Protocol service documents by default. Requested by James Snell. relService :: LinkRelation relService = RelService -- | Refers to the first resource in a collection of resources. -- -- Reference: relStart :: LinkRelation relStart = RelStart -- | Refers to a stylesheet. -- -- Reference: relStylesheet :: LinkRelation relStylesheet = RelStylesheet -- | Refers to a resource serving as a subsection in a collection of resources. -- -- Reference: relSubsection :: LinkRelation relSubsection = RelSubsection -- | Points to a resource containing the successor version in the version -- history. -- -- Reference: relSuccessorVersion :: LinkRelation relSuccessorVersion = RelSuccessorVersion -- | Gives a tag (identified by the given address) that applies to the current -- document. -- -- Reference: relTag :: LinkRelation relTag = RelTag -- | Refers to the terms of service associated with the link\'s context. -- -- Reference: , section 5 relTermsOfService :: LinkRelation relTermsOfService = RelTermsOfService -- | The Target IRI points to a TimeGate for an Original Resource. -- -- Reference: -- -- Note: A TimeGate for an Original Resource is a resource that is capable of -- datetime negotiation to support access to prior states of the Original -- Resource. relTimegate :: LinkRelation relTimegate = RelTimegate -- | The Target IRI points to a TimeMap for an Original Resource. -- -- Reference: -- -- Note: A TimeMap for an Original Resource is a resource from which a list of -- URIs of Mementos of the Original Resource is available. relTimemap :: LinkRelation relTimemap = RelTimemap -- | Refers to a resource identifying the abstract semantic type of which the -- link\'s context is considered to be an instance. -- -- Reference: , section 6 relType :: LinkRelation relType = RelType -- | Refers to a parent document in a hierarchy of documents. -- -- Reference: -- -- Note: This relation type registration did not indicate a reference. -- Requested by Noah Slater. relUp :: LinkRelation relUp = RelUp -- | Points to a resource containing the version history for the context. -- -- Reference: relVersionHistory :: LinkRelation relVersionHistory = RelVersionHistory -- | Identifies a resource that is the source of the information in the link\'s -- context. -- -- Reference: relVia :: LinkRelation relVia = RelVia -- | Points to a working copy for this resource. -- -- Reference: relWorkingCopy :: LinkRelation relWorkingCopy = RelWorkingCopy -- | Points to the versioned resource from which this working copy was -- obtained. -- -- Reference: relWorkingCopyOf :: LinkRelation relWorkingCopyOf = RelWorkingCopyOf