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