{-# LANGUAGE DeriveDataTypeable, 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.
--    E.g. h-adr has both p-geo and p-latitude, p-longitude, p-altitude.
--    Adr only has an Embedded 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

import safe      Data.Typeable (Typeable)
import safe      Data.Text.Lazy (Text)
import safe      Data.Data (Data)
import           Data.Default
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 type that represents all the ways Microformats objects can be embedded inside one another.
data Embedded a = Here a | Somewhere (Link a) | Nowhere
  deriving (Eq, Show, Data, Typeable)

-- | Converts a Maybe <thing> to an Embedded wrapping the same <thing>.
hereFromMaybe :: Maybe a -> Embedded a
hereFromMaybe m = case m of
  Just thing -> Here thing
  Nothing -> Nowhere

-- | 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 Geo type, based on h-geo <http://microformats.org/wiki/h-geo>
data Geo = Geo
  { geoLatitude    :: Maybe Double
  , geoLongitude   :: Maybe Double
  , geoAltitude    :: Maybe Double }
  deriving (Eq, Show, Data, Typeable)

instance Default Geo where
  def = Geo
    { geoLatitude    = Nothing
    , geoLongitude   = Nothing
    , geoAltitude    = Nothing }

-- | An Adr type, based on h-adr <http://microformats.org/wiki/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 }
  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 }

-- | A Card type, based on h-card <http://microformats.org/wiki/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 }
  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
    , cardCategory          = []
    , cardAdr               = Nowhere
    , cardTel               = Nothing
    , cardNote              = Nothing
    , cardBday              = Nothing
    , cardKey               = Nothing
    , cardOrg               = Nowhere
    , cardJobTitle          = Nothing
    , cardRole              = Nothing
    , cardImpp              = []
    , cardSex               = Nothing
    , cardGenderIdentity    = Nothing
    , cardAnniversary       = Nothing }

-- | A Cite type, based on h-cite <http://microformats.org/wiki/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 }
  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

-- | An Entry type, based on h-entry <http://microformats.org/wiki/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 }
  deriving (Eq, Show, Data, Typeable)

instance Default Entry where
  def = Entry
    { entryName           = Nothing
    , entrySummary        = Nothing
    , entryContent        = Nothing
    , entryPublished      = Nothing
    , entryUpdated        = Nothing
    , entryAuthor         = Nowhere
    , entryCategory       = []
    , entryUrl            = Nothing
    , entryUid            = Nothing
    , entryLocation       = Nothing
    , entryComments       = []
    , entrySyndication    = []
    , entryInReplyTo      = Nothing
    , entryLikeOf         = Nothing
    , entryRepostOf       = Nothing }