Language/DTC/Document.hs

   1 {-# LANGUAGE DisambiguateRecordFields #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 module Language.DTC.Document where
   7
   8 import Control.Applicative (Applicative(..))
   9 import Data.Eq (Eq)
  10 import Data.Int (Int)
  11 import Data.Maybe (Maybe(..))
  12 import Data.Ord (Ord)
  13 import Data.Semigroup (Semigroup(..))
  14 import Data.Sequence (Seq)
  15 import Data.String (IsString(..))
  16 import Data.Text (Text)
  17 import Text.Show (Show)
  18 import qualified Data.Sequence as Seq
  19
  20 -- * Class 'Default'
  21 class Default a where
  22         def :: a
  23 instance Default Text where
  24         def = ""
  25 instance Default (Maybe a) where
  26         def = Nothing
  27 instance Default [a] where
  28         def = []
  29 instance Default (Seq a) where
  30         def = Seq.empty
  31
  32 -- * Type 'MayText'
  33 newtype MayText
  34  =      MayText { unMayText :: Text }
  35  deriving (Eq,Show,Default)
  36 instance Semigroup MayText where
  37         MayText "" <> y = y
  38         x <> MayText "" = x
  39         _x <> y          = y
  40
  41 whenMayText :: Applicative m => MayText -> (MayText -> m ()) -> m ()
  42 whenMayText (MayText "") _f = pure ()
  43 whenMayText t f = f t
  44
  45 -- * Type 'Nat'
  46 newtype Nat = Nat Int
  47  deriving (Eq, Ord, Show)
  48
  49 -- * Type 'Nat1'
  50 newtype Nat1 = Nat1 Int
  51  deriving (Eq, Ord, Show)
  52
  53 -- * Type 'Document'
  54 data Document
  55  =   Document
  56  {   head  :: Head
  57  ,   body  :: [Body]
  58  } deriving (Eq,Show)
  59 instance Default Document where
  60         def = Document
  61          { head  = def
  62          , body  = def
  63          }
  64
  65 -- * Type 'Head'
  66 data Head
  67  =   Head
  68  {   about :: About
  69  } deriving (Eq,Show)
  70 instance Default Head where
  71         def = Head
  72          { about = def
  73          }
  74
  75 -- ** Type 'About'
  76 data About
  77  =   About
  78  {   titles   :: [] Title
  79  ,   authors  :: [] Entity
  80  ,   editor   :: Maybe Entity
  81  ,   date     :: Maybe Date
  82  ,   version  :: MayText
  83  ,   keywords :: [] Text
  84  ,   links    :: [] Link
  85  ,   series   :: [] Serie
  86  ,   includes :: [] Include
  87  } deriving (Eq,Show)
  88 instance Default About where
  89         def = About
  90          { includes = def
  91          , titles   = def
  92          , date     = def
  93          , version  = def
  94          , editor   = def
  95          , authors  = def
  96          , keywords = def
  97          , links    = def
  98          , series   = def
  99          }
 100 instance Semigroup About where
 101         x <> y = About
 102          { titles   = titles   x <> titles   y
 103          , authors  = authors  x <> authors  y
 104          , editor   = editor   x <> editor   y
 105          , date     = date     x <> date     y
 106          , version  = version  x <> version  y
 107          , keywords = keywords x <> keywords y
 108          , links    = links    x <> links    y
 109          , series   = series   x <> series   y
 110          , includes = includes x <> includes y
 111          }
 112
 113 -- * Type 'Body'
 114 data Body
 115  = Section { attrs   :: CommonAttrs
 116            , title   :: Title
 117            , aliases :: [Alias]
 118            , body    :: [Body]
 119            }
 120  | Verticals [Vertical]
 121  deriving (Eq,Show)
 122
 123 -- * Type 'Vertical'
 124 data Vertical
 125  = Para    { attrs :: CommonAttrs
 126            , para  :: Horizontals
 127            }
 128  | OL      { attrs :: CommonAttrs
 129            , items :: [Verticals]
 130            }
 131  | UL      { attrs :: CommonAttrs
 132            , items :: [Verticals]
 133            }
 134  | RL      { attrs :: CommonAttrs
 135            , refs  :: [Reference]
 136            }
 137  | ToC     { attrs :: CommonAttrs
 138            , depth :: Maybe Int
 139            }
 140  | ToF     { attrs :: CommonAttrs
 141            , depth :: Maybe Int
 142            }
 143  | Index   { attrs :: CommonAttrs
 144            }
 145  | Figure  { type_ :: Text
 146            , attrs :: CommonAttrs
 147            , title :: Title
 148            , body  :: Verticals
 149            }
 150  | Artwork { attrs :: CommonAttrs
 151            , art   :: Artwork
 152            }
 153  | Comment Text
 154  deriving (Eq,Show)
 155
 156 -- * Type 'CommonAttrs'
 157 data CommonAttrs
 158  =   CommonAttrs
 159  {   id     :: Ident
 160  ,   class_ :: [Text]
 161  } deriving (Eq,Show)
 162
 163 -- * Type 'Verticals'
 164 type Verticals = [Vertical]
 165
 166 -- * Type 'Artwork'
 167 data Artwork
 168  =   Raw Text
 169  deriving (Eq,Show)
 170
 171 -- * Type 'Horizontal'
 172 data Horizontal
 173  =   BR
 174  |   B    Horizontals
 175  |   Code Horizontals
 176  |   Del  Horizontals
 177  |   I    Horizontals
 178  |   Note Horizontals
 179  |   Q    Horizontals
 180  |   SC   Horizontals
 181  |   Sub  Horizontals
 182  |   Sup  Horizontals
 183  |   U    Horizontals
 184  |   Eref {href :: URL  , text :: Horizontals}
 185  |   Iref {to   :: Ident, text :: Horizontals}
 186  |   Ref  {to   :: Ident, text :: Horizontals}
 187  |   Rref {to   :: Ident, text :: Horizontals}
 188  |   Plain Text
 189  deriving (Eq,Show)
 190
 191 -- * Type 'Horizontals'
 192 type Horizontals = [] Horizontal
 193
 194 -- * Type 'Ident'
 195 newtype Ident = Ident Text
 196  deriving (Eq,Show,Default,IsString)
 197
 198 -- * Type 'Title'
 199 newtype Title = Title Horizontals
 200  deriving (Eq,Show,Default)
 201
 202 -- * Type 'URL'
 203 newtype URL = URL Text
 204  deriving (Eq,Show,Default)
 205
 206 -- * Type 'Path'
 207 newtype Path = Path Text
 208  deriving (Eq,Show,Default)
 209
 210
 211 -- ** Type 'Address'
 212 data Address
 213  =   Address
 214  {   street  :: Text
 215  ,   zipcode :: Text
 216  ,   city    :: Text
 217  ,   region  :: Text
 218  ,   country :: Text
 219  ,   email   :: Text
 220  ,   tel     :: Text
 221  ,   fax     :: Text
 222  } deriving (Eq,Show)
 223 instance Default Address where
 224         def = Address
 225          { street  = def
 226          , zipcode = def
 227          , city    = def
 228          , region  = def
 229          , country = def
 230          , email   = def
 231          , tel     = def
 232          , fax     = def
 233          }
 234
 235 -- * Type 'Include'
 236 data Include
 237  =   Include
 238  {   href :: Path
 239  } deriving (Eq,Show)
 240 instance Default Include where
 241         def = Include
 242          { href = def
 243          }
 244
 245 -- * Type 'Reference'
 246 data Reference
 247  =   Reference
 248  {   id    :: Ident
 249  ,   to    :: Maybe URL
 250  ,   about :: About
 251  } deriving (Eq,Show)
 252 reference :: Ident -> Reference
 253 reference id =
 254         Reference
 255          { id
 256          , to    = def
 257          , about = def
 258          }
 259 instance Default Reference where
 260         def = reference def
 261
 262 -- * Type 'Entity'
 263 data Entity
 264  =   Entity
 265  {   name    :: Text
 266  ,   address :: Address
 267  } deriving (Eq,Show)
 268 instance Default Entity where
 269         def = Entity
 270          { name    = def
 271          , address = def
 272          }
 273 instance Semigroup Entity where
 274         _x <> y = y
 275
 276 -- * Type 'Date'
 277 data Date
 278  =   Date
 279  {   year  :: Int
 280  ,   month :: Maybe Nat1
 281  ,   day   :: Maybe Nat1
 282  } deriving (Eq,Show)
 283 instance Default Date where
 284         def = Date
 285          { year  = 1970
 286          , month = Just (Nat1 01)
 287          , day   = Just (Nat1 01)
 288          }
 289 instance Semigroup Date where
 290         _x <> y = y
 291
 292 -- * Type 'Link'
 293 data Link
 294  =   Link
 295  {   name  :: Text
 296  ,   href  :: URL
 297  ,   rel   :: Text
 298  ,   body  :: Horizontals
 299  } deriving (Eq,Show)
 300 instance Default Link where
 301         def = Link
 302          { name = def
 303          , href = def
 304          , rel  = def
 305          , body = def
 306          }
 307
 308 -- * Type 'Alias'
 309 data Alias
 310  =   Alias
 311  {   id :: Ident
 312  } deriving (Eq,Show)
 313 instance Default Alias where
 314         def = Alias
 315          { id = def
 316          }
 317
 318 -- * Type 'Serie'
 319 data Serie
 320  =   Serie
 321  {   name :: Text
 322  ,   key  :: Text
 323  } deriving (Eq,Show)
 324 instance Default Serie where
 325         def = Serie
 326          { name = def
 327          , key  = def
 328          }