summaryrefslogtreecommitdiff
path: root/Text/OPML/Types.hs
blob: b4f222e6ad4b304b7d7139273b7cd744604e1f91 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE StandaloneDeriving    #-}
-- | OPML is an XML format for outlines.
--
-- Example:
--
-- > <opml version="2.0">
-- >   <head>
-- >     <title>OPML title</title>
-- >     <dateCreated>Mon, 31 Oct 2005 19:23:00 GMT</dateCreated>
-- >   </head>
-- >   <body>
-- >     <outline text="Outline 1" created="Mon, 31 Oct 2005 18:21:33 GMT"/>
-- >     <outline text="Outline 2" created="Mon, 31 Oct 2005 18:21:33 GMT"/>
-- >   </body>
-- > </opml>
module Text.OPML.Types
  ( -- * Top-level OPML structure
    Opml(..)
  , mkOpml
    -- * OPML header
  , OpmlHead(..)
  , mkOpmlHead
    -- * OPML outlines
  , OpmlOutline(..)
    -- ** Generic outlines
  , OutlineBase(..)
  , mkOutlineBase
    -- ** Subscription outlines
  , OutlineSubscription(..)
  , mkOutlineSubscription
    -- * Others
  , Null()
  ) where

-- {{{ Imports
import           Control.Monad
import           Data.List.NonEmpty
import           Data.Text           as Text
import           Data.Time.Clock
import           Data.Time.LocalTime ()
import           Data.Tree
import           Data.Typeable
import           Data.Version
import           GHC.Generics
import           Refined             hiding (NonEmpty)
import           URI.ByteString
-- }}}

-- | 'Predicate' on 'Text', true iff text is null.
data Null deriving(Typeable)

instance Predicate Null Text where
  validate p value = if not $ Text.null value
    then pure $ RefineOtherException (typeOf p) "Text is not null"
    else Nothing

data OpmlHead = OpmlHead
  { opmlTitle       :: Text
  , opmlCreated     :: Maybe UTCTime
  , modified        :: Maybe UTCTime
  , ownerName       :: Text
  , ownerEmail      :: Text
  , ownerId         :: Maybe URI
  , docs            :: Maybe URI
  , expansionState  :: [Int]
  , vertScrollState :: Maybe Int
  , windowBottom    :: Maybe Int
  , windowLeft      :: Maybe Int
  , windowRight     :: Maybe Int
  , windowTop       :: Maybe Int
  }

deriving instance Eq OpmlHead
deriving instance Generic OpmlHead
deriving instance Show OpmlHead

-- | Bare 'OpmlHead', all fields are set to 'mempty'.
mkOpmlHead :: OpmlHead
mkOpmlHead = OpmlHead mempty mzero mzero mempty mempty mzero mzero mzero mzero mzero mzero mzero mzero

data OutlineBase = OutlineBase
  { text           :: Refined (Not Null) Text
  , isComment      :: Maybe Bool
  , isBreakpoint   :: Maybe Bool
  , outlineCreated :: Maybe UTCTime
  , categories     :: [NonEmpty (Refined (Not Null) Text)] -- ^
  }

deriving instance Eq OutlineBase
deriving instance Generic OutlineBase
deriving instance Show OutlineBase


-- | Smart constructor for 'OutlineBase'.
mkOutlineBase :: Refined (Not Null) Text -> OutlineBase
mkOutlineBase t = OutlineBase t mzero mzero mzero mzero


data OutlineSubscription = OutlineSubscription
  { xmlUri              :: URI
  , htmlUri             :: Maybe URI
  , description         :: Text
  , language            :: Text
  , subscriptionTitle   :: Text
  , subscriptionVersion :: Text
  }

deriving instance Eq OutlineSubscription
deriving instance Generic OutlineSubscription
deriving instance Show OutlineSubscription


-- | Smart constructor for 'OutlineSubscription'
mkOutlineSubscription :: URI -> OutlineSubscription
mkOutlineSubscription uri = OutlineSubscription uri mzero mempty mempty mempty mempty


-- | Outlines are the main payload of an OPML document.
data OpmlOutline = OpmlOutlineGeneric { opmlOutlineBase :: OutlineBase, opmlOutlineContent :: Text }
                 | OpmlOutlineLink { opmlOutlineBase :: OutlineBase, opmlOutlineUri :: URI }
                 | OpmlOutlineSubscription { opmlOutlineBase :: OutlineBase, opmlOutlineSubscription :: OutlineSubscription }

deriving instance Eq OpmlOutline
deriving instance Generic OpmlOutline
deriving instance Show OpmlOutline

data Opml = Opml
  { opmlVersion  :: Version
  , opmlHead     :: OpmlHead
  , opmlOutlines :: Forest OpmlOutline
  }

deriving instance Eq Opml
deriving instance Generic Opml
deriving instance Show Opml

-- | Bare 'Opml'. Version is set to @2.0@.
mkOpml :: Opml
mkOpml = Opml (makeVersion [2, 0]) mkOpmlHead mempty