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