diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,21 @@ # microformats2-types [![Hackage](https://img.shields.io/hackage/v/microformats2-types.svg?style=flat)](https://hackage.haskell.org/package/microformats2-types) [![ISC License](https://img.shields.io/badge/license-ISC-red.svg?style=flat)](https://tldrlegal.com/license/-isc-license) -[Microformats 2] types for Haskell, with [Aeson] instances. +[Microformats 2] types for Haskell! +- [Aeson] instances +- [Default] instances +- [Setters] instances +- [Pandoc] content for h-entry + +This package is not very interesting, check out [microformats2-parser] and [sweetroll] :-) + [Microformats 2]: http://microformats.org/wiki/microformats2 [Aeson]: https://hackage.haskell.org/package/aeson +[Default]: https://hackage.haskell.org/package/data-default +[Setters]: https://hackage.haskell.org/package/setters +[Pandoc]: https://hackage.haskell.org/package/pandoc +[microformats2-parser]: https://github.com/myfreeweb/microformats2-parser +[sweetroll]: https://github.com/myfreeweb/sweetroll ## License diff --git a/library/Data/Microformats2.hs b/library/Data/Microformats2.hs --- a/library/Data/Microformats2.hs +++ b/library/Data/Microformats2.hs @@ -1,208 +1,207 @@ -{-# LANGUAGE DeriveDataTypeable, Trustworthy #-} +{-# LANGUAGE DeriveDataTypeable, UnicodeSyntax, Trustworthy #-} -- | Microformats 2 types for Haskell. -- -- Notes: -- --- 1. Pretty much all properties in MF2 are optional -- this is why we use Maybe when lists don't make sense. --- --- 2. We don't duplicate sub-properties in parent types. +-- 1. We don't duplicate sub-properties in parent types. -- E.g. h-adr has both p-geo and p-latitude, p-longitude, p-altitude. --- Adr only has an Embedded Geo. +-- Adr only has a Geo. -- --- 3. Lazy Text is used for storing texts, because it's the format used in Scotty, Hastache and other popular web libraries. -module Data.Microformats2 (module Data.Microformats2) where +-- 2. Lazy Text is used for storing texts, because it's the format used in Scotty, Hastache and other popular web libraries. +-- +-- 3. Lists are used everywhere, because all properties might be multivalued, even though it doesn't always make sense. +-- Use 'headMay' from the safe package! +-- +-- 4. SomethingReference sum types are used for, well, references. +-- The spec always makes embedded microformats optional, so these types include Text options. +-- +module Data.Microformats2 where import safe Data.Typeable (Typeable) import safe Data.Text.Lazy (Text) import safe Data.Data (Data) -import Data.Default +import Data.Default.Class import Data.Time (UTCTime) import Text.Pandoc.Definition (Pandoc) --- | An alias for lazy Text as a phantom type for storing the type of linked data. -type Link a = Text +-- | A Geo reference. +data GeoReference = TextGeo Text | UrlGeo Text | GeoGeo Geo -- LOL + deriving (Eq, Show, Data, Typeable) --- | A type that represents all the ways Microformats objects can be embedded inside one another. -data Embedded a = Here a | Somewhere (Link a) | Nowhere +-- | An Adr reference. +data AdrReference = TextAdr Text | AdrAdr Adr deriving (Eq, Show, Data, Typeable) --- | Converts a Maybe to an Embedded wrapping the same . -hereFromMaybe :: Maybe a -> Embedded a -hereFromMaybe m = case m of - Just thing -> Here thing - Nothing -> Nowhere +-- | A location (Card/Adr/Geo) reference. +data LocationReference = TextLoc Text | CardLoc Card | AdrLoc Adr | GeoLoc Geo + deriving (Eq, Show, Data, Typeable) --- | Converts a Maybe Link to an Embedded referencing the same URL. -somewhereFromMaybe :: Maybe (Link a) -> Embedded a -somewhereFromMaybe m = case m of - Just lnk -> Somewhere lnk - Nothing -> Nowhere +-- | A Card reference. +data CardReference = TextCard Text | CardCard Card + deriving (Eq, Show, Data, Typeable) +-- | An Entry/Cite reference. +data EntryReference = TextEntry Text | UrlEntry Text | CiteEntry Cite | EntryEntry Entry + deriving (Eq, Show, Data, Typeable) + +-- | A content reference. +data ContentReference = TextContent Text | PandocContent Pandoc + deriving (Eq, Show, Data, Typeable) + -- | A Geo type, based on h-geo data Geo = Geo - { geoLatitude :: Maybe Double - , geoLongitude :: Maybe Double - , geoAltitude :: Maybe Double } + { geoLatitude ∷ [Double] + , geoLongitude ∷ [Double] + , geoAltitude ∷ [Double] } deriving (Eq, Show, Data, Typeable) instance Default Geo where def = Geo - { geoLatitude = Nothing - , geoLongitude = Nothing - , geoAltitude = Nothing } + { geoLatitude = [] + , geoLongitude = [] + , geoAltitude = [] } -- | An Adr type, based on h-adr data Adr = Adr - { adrStreetAddress :: Maybe Text - , adrExtendedAddress :: Maybe Text - , adrPostOfficeBox :: Maybe Text - , adrLocality :: Maybe Text - , adrRegion :: Maybe Text - , adrPostalCode :: Maybe Text - , adrCountryName :: Maybe Text - , adrLabel :: Maybe Text - , adrGeo :: Embedded Geo } + { adrStreetAddress ∷ [Text] + , adrExtendedAddress ∷ [Text] + , adrPostOfficeBox ∷ [Text] + , adrLocality ∷ [Text] + , adrRegion ∷ [Text] + , adrPostalCode ∷ [Text] + , adrCountryName ∷ [Text] + , adrLabel ∷ [Text] + , adrGeo ∷ [GeoReference] } deriving (Eq, Show, Data, Typeable) instance Default Adr where def = Adr - { adrStreetAddress = Nothing - , adrExtendedAddress = Nothing - , adrPostOfficeBox = Nothing - , adrLocality = Nothing - , adrRegion = Nothing - , adrPostalCode = Nothing - , adrCountryName = Nothing - , adrLabel = Nothing - , adrGeo = Nowhere } + { adrStreetAddress = [] + , adrExtendedAddress = [] + , adrPostOfficeBox = [] + , adrLocality = [] + , adrRegion = [] + , adrPostalCode = [] + , adrCountryName = [] + , adrLabel = [] + , adrGeo = [] } -- | A Card type, based on h-card data Card = Card - { cardName :: Maybe Text - , cardHonorificPrefix :: Maybe Text - , cardGivenName :: Maybe Text - , cardAdditionalName :: Maybe Text - , cardFamilyName :: Maybe Text - , cardSortString :: Maybe Text - , cardHonorificSuffix :: Maybe Text - , cardNickname :: Maybe Text - , cardEmail :: Maybe Text - , cardLogo :: Maybe Text - , cardPhoto :: Maybe Text - , cardUrl :: Maybe Text - , cardUid :: Maybe Text - , cardCategory :: [Text] - , cardAdr :: Embedded Adr - , cardTel :: Maybe Text - , cardNote :: Maybe Text - , cardBday :: Maybe UTCTime - , cardKey :: Maybe Text - , cardOrg :: Embedded Card - , cardJobTitle :: Maybe Text - , cardRole :: Maybe Text - , cardImpp :: [Text] - , cardSex :: Maybe Text - , cardGenderIdentity :: Maybe Text - , cardAnniversary :: Maybe UTCTime } + { cardName ∷ [Text] + , cardHonorificPrefix ∷ [Text] + , cardGivenName ∷ [Text] + , cardAdditionalName ∷ [Text] + , cardFamilyName ∷ [Text] + , cardSortString ∷ [Text] + , cardHonorificSuffix ∷ [Text] + , cardNickname ∷ [Text] + , cardEmail ∷ [Text] + , cardLogo ∷ [Text] + , cardPhoto ∷ [Text] + , cardUrl ∷ [Text] + , cardUid ∷ [Text] + , cardCategory ∷ [Text] + , cardAdr ∷ [AdrReference] + , cardTel ∷ [Text] + , cardNote ∷ [Text] + , cardBday ∷ [UTCTime] + , cardKey ∷ [Text] + , cardOrg ∷ [CardReference] + , cardJobTitle ∷ [Text] + , cardRole ∷ [Text] + , cardImpp ∷ [Text] + , cardSex ∷ [Text] + , cardGenderIdentity ∷ [Text] + , cardAnniversary ∷ [UTCTime] } deriving (Eq, Show, Data, Typeable) instance Default Card where def = Card - { cardName = Nothing - , cardHonorificPrefix = Nothing - , cardGivenName = Nothing - , cardAdditionalName = Nothing - , cardFamilyName = Nothing - , cardSortString = Nothing - , cardHonorificSuffix = Nothing - , cardNickname = Nothing - , cardEmail = Nothing - , cardLogo = Nothing - , cardPhoto = Nothing - , cardUrl = Nothing - , cardUid = Nothing + { cardName = [] + , cardHonorificPrefix = [] + , cardGivenName = [] + , cardAdditionalName = [] + , cardFamilyName = [] + , cardSortString = [] + , cardHonorificSuffix = [] + , cardNickname = [] + , cardEmail = [] + , cardLogo = [] + , cardPhoto = [] + , cardUrl = [] + , cardUid = [] , cardCategory = [] - , cardAdr = Nowhere - , cardTel = Nothing - , cardNote = Nothing - , cardBday = Nothing - , cardKey = Nothing - , cardOrg = Nowhere - , cardJobTitle = Nothing - , cardRole = Nothing + , cardAdr = [] + , cardTel = [] + , cardNote = [] + , cardBday = [] + , cardKey = [] + , cardOrg = [] + , cardJobTitle = [] + , cardRole = [] , cardImpp = [] - , cardSex = Nothing - , cardGenderIdentity = Nothing - , cardAnniversary = Nothing } + , cardSex = [] + , cardGenderIdentity = [] + , cardAnniversary = [] } -- | A Cite type, based on h-cite data Cite = Cite - { citeName :: Maybe Text - , citePublished :: Maybe UTCTime - , citeAuthor :: Embedded Card - , citeUrl :: Maybe Text - , citeUid :: Maybe Text - , citePublication :: Maybe Text - , citeAccessed :: Maybe UTCTime - , citeContent :: Maybe Text } + { citeName ∷ [Text] + , citePublished ∷ [UTCTime] + , citeAuthor ∷ [CardReference] + , citeUrl ∷ [Text] + , citeUid ∷ [Text] + , citePublication ∷ [Text] + , citeAccessed ∷ [UTCTime] + , citeContent ∷ [ContentReference] } deriving (Eq, Show, Data, Typeable) instance Default Cite where def = Cite - { citeName = Nothing - , citePublished = Nothing - , citeAuthor = Nowhere - , citeUrl = Nothing - , citeUid = Nothing - , citePublication = Nothing - , citeAccessed = Nothing - , citeContent = Nothing } - --- | A location reference. --- Left means a Card is used, which is often used for checkins. --- Right means an Adr is used. If you only have a Geo, wrap it in an Adr. -type LocationReference = Either (Embedded Card) (Embedded Adr) - --- | An Entry reference. -type EntryReference = Either (Embedded Cite) (Link Entry) - --- | A content reference. -type ContentReference = Either Pandoc Text + { citeName = [] + , citePublished = [] + , citeAuthor = [] + , citeUrl = [] + , citeUid = [] + , citePublication = [] + , citeAccessed = [] + , citeContent = [] } -- | An Entry type, based on h-entry with popular extensions. data Entry = Entry - { entryName :: Maybe Text - , entrySummary :: Maybe Text - , entryContent :: Maybe ContentReference - , entryPublished :: Maybe UTCTime - , entryUpdated :: Maybe UTCTime - , entryAuthor :: Embedded Card - , entryCategory :: [Text] - , entryUrl :: Maybe Text - , entryUid :: Maybe Text - , entryLocation :: Maybe LocationReference - , entryComments :: [EntryReference] - , entrySyndication :: [Text] - , entryInReplyTo :: Maybe EntryReference - , entryLikeOf :: Maybe EntryReference - , entryRepostOf :: Maybe EntryReference } + { entryName ∷ [Text] + , entrySummary ∷ [Text] + , entryContent ∷ [ContentReference] + , entryPublished ∷ [UTCTime] + , entryUpdated ∷ [UTCTime] + , entryAuthor ∷ [CardReference] + , entryCategory ∷ [Text] + , entryUrl ∷ [Text] + , entryUid ∷ [Text] + , entryLocation ∷ [LocationReference] + , entryComments ∷ [EntryReference] + , entrySyndication ∷ [Text] + , entryInReplyTo ∷ [EntryReference] + , entryLikeOf ∷ [EntryReference] + , entryRepostOf ∷ [EntryReference] } deriving (Eq, Show, Data, Typeable) instance Default Entry where def = Entry - { entryName = Nothing - , entrySummary = Nothing - , entryContent = Nothing - , entryPublished = Nothing - , entryUpdated = Nothing - , entryAuthor = Nowhere + { entryName = [] + , entrySummary = [] + , entryContent = [] + , entryPublished = [] + , entryUpdated = [] + , entryAuthor = [] , entryCategory = [] - , entryUrl = Nothing - , entryUid = Nothing - , entryLocation = Nothing + , entryUrl = [] + , entryUid = [] + , entryLocation = [] , entryComments = [] , entrySyndication = [] - , entryInReplyTo = Nothing - , entryLikeOf = Nothing - , entryRepostOf = Nothing } + , entryInReplyTo = [] + , entryLikeOf = [] + , entryRepostOf = [] } diff --git a/library/Data/Microformats2/Aeson.hs b/library/Data/Microformats2/Aeson.hs --- a/library/Data/Microformats2/Aeson.hs +++ b/library/Data/Microformats2/Aeson.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, Trustworthy #-} -- | TH-derived Aeson instances for Data.Microformats2. module Data.Microformats2.Aeson () where @@ -7,7 +7,14 @@ import Data.Microformats2 import Data.Aeson.TH -$(deriveJSON defaultOptions ''Embedded) +-- Using "t" and "c" like Pandoc + +$(deriveJSON defaultOptions{sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" }} ''GeoReference) +$(deriveJSON defaultOptions{sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" }} ''AdrReference) +$(deriveJSON defaultOptions{sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" }} ''LocationReference) +$(deriveJSON defaultOptions{sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" }} ''CardReference) +$(deriveJSON defaultOptions{sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" }} ''EntryReference) +$(deriveJSON defaultOptions{sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" }} ''ContentReference) $(deriveJSON defaultOptions{fieldLabelModifier = drop 3} ''Geo) $(deriveJSON defaultOptions{fieldLabelModifier = drop 3} ''Adr) $(deriveJSON defaultOptions{fieldLabelModifier = drop 4} ''Card) diff --git a/library/Data/Microformats2/Setters.hs b/library/Data/Microformats2/Setters.hs --- a/library/Data/Microformats2/Setters.hs +++ b/library/Data/Microformats2/Setters.hs @@ -1,15 +1,12 @@ {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-signatures #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, Trustworthy #-} -- | TH-derived Setters instances for Data.Microformats2. -module Data.Microformats2.Setters ( - module Data.Microformats2.Setters -) where +module Data.Microformats2.Setters where import Data.Microformats2 import Data.Setters -$(declareSetters ''Embedded) $(declareSetters ''Geo) $(declareSetters ''Adr) $(declareSetters ''Card) diff --git a/microformats2-types.cabal b/microformats2-types.cabal --- a/microformats2-types.cabal +++ b/microformats2-types.cabal @@ -1,5 +1,5 @@ name: microformats2-types -version: 0.3.0 +version: 0.4.0 synopsis: Microformats 2 types (with Aeson instances) category: Web homepage: https://github.com/myfreeweb/microformats2-types @@ -13,7 +13,7 @@ extra-source-files: README.md tested-with: - GHC == 7.8.2 + GHC == 7.8.3 source-repository head type: git @@ -24,10 +24,9 @@ base >= 4.0.0.0 && < 5 , text , time >= 1.4.0 && < 2 - , either , aeson , pandoc-types - , data-default + , data-default-class , setters default-language: Haskell2010 exposed-modules: