-- | Lesson plan notebook section declaration types and functions.
module Drasil.DocumentLanguage.Notebook.NBDecl where

import qualified Drasil.DocumentLanguage.Notebook.Core as NB (ApndxSec(..), NBDesc, DocSection(..), 
  IntrodSec(..), BodySec(..), SmmrySec(..))

import SysInfo.Drasil (SystemInformation)

-- * Types

-- | A Lesson Plan notebook declaration is made up of all necessary sections ('NbSection's).
type NBDecl  = [NbSection]

-- | Contains all the different sections needed for a notebook lesson plan ('NBDecl').
data NbSection = IntrodSec NB.IntrodSec
                | BodySec NB.BodySec
                | SmmrySec NB.SmmrySec
                | BibSec
                | ApndxSec NB.ApndxSec

-- * Functions

-- | Creates the notebook description (translates 'NBDecl' into a more usable form for generating documents).
mkNBDesc :: SystemInformation -> NBDecl -> NB.NBDesc
mkNBDesc :: SystemInformation -> NBDecl -> NBDesc
mkNBDesc _ = (NbSection -> DocSection) -> NBDecl -> NBDesc
forall a b. (a -> b) -> [a] -> [b]
map NbSection -> DocSection
sec where
  sec :: NbSection -> NB.DocSection
  sec :: NbSection -> DocSection
sec (IntrodSec i :: IntrodSec
i) = IntrodSec -> DocSection
NB.IntrodSec IntrodSec
i
  sec (BodySec bs :: BodySec
bs)  = BodySec -> DocSection
NB.BodySec BodySec
bs  
  sec (SmmrySec ss :: SmmrySec
ss) = SmmrySec -> DocSection
NB.SmmrySec SmmrySec
ss
  sec BibSec        = DocSection
NB.BibSec
  sec (ApndxSec a :: ApndxSec
a)  = ApndxSec -> DocSection
NB.ApndxSec ApndxSec
a