{-# LANGUAGE GADTs #-}
-- | Lesson plan notebook chapter types.
module Drasil.DocumentLanguage.Notebook.Core where

import Data.Generics.Multiplate (Multiplate(multiplate, mkPlate))
import Language.Drasil

-- * Lesson Chapter Types

type LsnDesc = [LsnChapter]

data LsnChapter = Intro Intro
                | LearnObj LearnObj
                | Review Review
                | CaseProb CaseProb
                | Example Example
                | Smmry Smmry
                | BibSec
                | Apndx Apndx

-- TODO: Work on detail structure of Lesson Plan

-- ** Introduction
newtype Intro = IntrodProg [Contents]

-- ** Learning Objectives
newtype LearnObj = LrnObjProg [Contents]

-- ** Review Chapter
newtype Review = ReviewProg [Contents]

-- ** A Case Problem
newtype CaseProb = CaseProbProg [Contents]

-- ** Examples of the lesson
newtype Example = ExampleProg [Contents]
  
-- ** Summary
newtype Smmry = SmmryProg [Contents]

-- ** Appendix
newtype Apndx = ApndxProg [Contents]

-- * Multiplate Definition and Type

data DLPlate f = DLPlate {
  forall (f :: * -> *). DLPlate f -> LsnChapter -> f LsnChapter
lsnChap :: LsnChapter -> f LsnChapter,
  forall (f :: * -> *). DLPlate f -> Intro -> f Intro
intro :: Intro -> f Intro,
  forall (f :: * -> *). DLPlate f -> LearnObj -> f LearnObj
learnObj :: LearnObj -> f LearnObj,
  forall (f :: * -> *). DLPlate f -> Review -> f Review
review :: Review -> f Review,
  forall (f :: * -> *). DLPlate f -> CaseProb -> f CaseProb
caseProb :: CaseProb -> f CaseProb,
  forall (f :: * -> *). DLPlate f -> Example -> f Example
example :: Example -> f Example,
  forall (f :: * -> *). DLPlate f -> Smmry -> f Smmry
smmry :: Smmry -> f Smmry,
  forall (f :: * -> *). DLPlate f -> Apndx -> f Apndx
apndx :: Apndx -> f Apndx
}

instance Multiplate DLPlate where
  multiplate :: forall (f :: * -> *). Applicative f => DLPlate f -> DLPlate f
multiplate DLPlate f
p = (LsnChapter -> f LsnChapter)
-> (Intro -> f Intro)
-> (LearnObj -> f LearnObj)
-> (Review -> f Review)
-> (CaseProb -> f CaseProb)
-> (Example -> f Example)
-> (Smmry -> f Smmry)
-> (Apndx -> f Apndx)
-> DLPlate f
forall (f :: * -> *).
(LsnChapter -> f LsnChapter)
-> (Intro -> f Intro)
-> (LearnObj -> f LearnObj)
-> (Review -> f Review)
-> (CaseProb -> f CaseProb)
-> (Example -> f Example)
-> (Smmry -> f Smmry)
-> (Apndx -> f Apndx)
-> DLPlate f
DLPlate LsnChapter -> f LsnChapter
lc Intro -> f Intro
forall {f :: * -> *}. Applicative f => Intro -> f Intro
introd LearnObj -> f LearnObj
forall {f :: * -> *}. Applicative f => LearnObj -> f LearnObj
lrnObj Review -> f Review
forall {f :: * -> *}. Applicative f => Review -> f Review
rvw CaseProb -> f CaseProb
forall {f :: * -> *}. Applicative f => CaseProb -> f CaseProb
csProb Example -> f Example
forall {f :: * -> *}. Applicative f => Example -> f Example
exmp Smmry -> f Smmry
forall {f :: * -> *}. Applicative f => Smmry -> f Smmry
smry Apndx -> f Apndx
forall {f :: * -> *}. Applicative f => Apndx -> f Apndx
aps where
    lc :: LsnChapter -> f LsnChapter
lc (Intro Intro
x) = Intro -> LsnChapter
Intro (Intro -> LsnChapter) -> f Intro -> f LsnChapter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DLPlate f -> Intro -> f Intro
forall (f :: * -> *). DLPlate f -> Intro -> f Intro
intro DLPlate f
p Intro
x
    lc (LearnObj LearnObj
x) = LearnObj -> LsnChapter
LearnObj (LearnObj -> LsnChapter) -> f LearnObj -> f LsnChapter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DLPlate f -> LearnObj -> f LearnObj
forall (f :: * -> *). DLPlate f -> LearnObj -> f LearnObj
learnObj DLPlate f
p LearnObj
x
    lc (Review Review
x) = Review -> LsnChapter
Review (Review -> LsnChapter) -> f Review -> f LsnChapter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DLPlate f -> Review -> f Review
forall (f :: * -> *). DLPlate f -> Review -> f Review
review DLPlate f
p Review
x
    lc (CaseProb CaseProb
x) = CaseProb -> LsnChapter
CaseProb (CaseProb -> LsnChapter) -> f CaseProb -> f LsnChapter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DLPlate f -> CaseProb -> f CaseProb
forall (f :: * -> *). DLPlate f -> CaseProb -> f CaseProb
caseProb DLPlate f
p CaseProb
x
    lc (Example Example
x) = Example -> LsnChapter
Example (Example -> LsnChapter) -> f Example -> f LsnChapter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DLPlate f -> Example -> f Example
forall (f :: * -> *). DLPlate f -> Example -> f Example
example DLPlate f
p Example
x
    lc (Smmry Smmry
x) = Smmry -> LsnChapter
Smmry (Smmry -> LsnChapter) -> f Smmry -> f LsnChapter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DLPlate f -> Smmry -> f Smmry
forall (f :: * -> *). DLPlate f -> Smmry -> f Smmry
smmry DLPlate f
p Smmry
x
    lc (Apndx Apndx
x) = Apndx -> LsnChapter
Apndx (Apndx -> LsnChapter) -> f Apndx -> f LsnChapter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DLPlate f -> Apndx -> f Apndx
forall (f :: * -> *). DLPlate f -> Apndx -> f Apndx
apndx DLPlate f
p Apndx
x
    lc LsnChapter
BibSec = LsnChapter -> f LsnChapter
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LsnChapter
BibSec

    introd :: Intro -> f Intro
introd (IntrodProg [Contents]
con) = Intro -> f Intro
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Intro -> f Intro) -> Intro -> f Intro
forall a b. (a -> b) -> a -> b
$ [Contents] -> Intro
IntrodProg [Contents]
con 
    lrnObj :: LearnObj -> f LearnObj
lrnObj (LrnObjProg [Contents]
con) = LearnObj -> f LearnObj
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LearnObj -> f LearnObj) -> LearnObj -> f LearnObj
forall a b. (a -> b) -> a -> b
$ [Contents] -> LearnObj
LrnObjProg [Contents]
con 
    rvw :: Review -> f Review
rvw (ReviewProg [Contents]
con) = Review -> f Review
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Review -> f Review) -> Review -> f Review
forall a b. (a -> b) -> a -> b
$ [Contents] -> Review
ReviewProg [Contents]
con
    csProb :: CaseProb -> f CaseProb
csProb (CaseProbProg [Contents]
con) = CaseProb -> f CaseProb
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CaseProb -> f CaseProb) -> CaseProb -> f CaseProb
forall a b. (a -> b) -> a -> b
$ [Contents] -> CaseProb
CaseProbProg [Contents]
con 
    exmp :: Example -> f Example
exmp (ExampleProg [Contents]
con) = Example -> f Example
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Example -> f Example) -> Example -> f Example
forall a b. (a -> b) -> a -> b
$ [Contents] -> Example
ExampleProg [Contents]
con
    smry :: Smmry -> f Smmry
smry (SmmryProg [Contents]
con) = Smmry -> f Smmry
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Smmry -> f Smmry) -> Smmry -> f Smmry
forall a b. (a -> b) -> a -> b
$ [Contents] -> Smmry
SmmryProg [Contents]
con 
    aps :: Apndx -> f Apndx
aps (ApndxProg [Contents]
con) = Apndx -> f Apndx
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Apndx -> f Apndx) -> Apndx -> f Apndx
forall a b. (a -> b) -> a -> b
$ [Contents] -> Apndx
ApndxProg [Contents]
con
  mkPlate :: forall (f :: * -> *).
(forall a. Projector DLPlate a -> a -> f a) -> DLPlate f
mkPlate forall a. Projector DLPlate a -> a -> f a
b = (LsnChapter -> f LsnChapter)
-> (Intro -> f Intro)
-> (LearnObj -> f LearnObj)
-> (Review -> f Review)
-> (CaseProb -> f CaseProb)
-> (Example -> f Example)
-> (Smmry -> f Smmry)
-> (Apndx -> f Apndx)
-> DLPlate f
forall (f :: * -> *).
(LsnChapter -> f LsnChapter)
-> (Intro -> f Intro)
-> (LearnObj -> f LearnObj)
-> (Review -> f Review)
-> (CaseProb -> f CaseProb)
-> (Example -> f Example)
-> (Smmry -> f Smmry)
-> (Apndx -> f Apndx)
-> DLPlate f
DLPlate ((forall (f :: * -> *). DLPlate f -> LsnChapter -> f LsnChapter)
-> LsnChapter -> f LsnChapter
forall a. Projector DLPlate a -> a -> f a
b DLPlate f -> LsnChapter -> f LsnChapter
forall (f :: * -> *). DLPlate f -> LsnChapter -> f LsnChapter
lsnChap) ((forall (f :: * -> *). DLPlate f -> Intro -> f Intro)
-> Intro -> f Intro
forall a. Projector DLPlate a -> a -> f a
b DLPlate f -> Intro -> f Intro
forall (f :: * -> *). DLPlate f -> Intro -> f Intro
intro) ((forall (f :: * -> *). DLPlate f -> LearnObj -> f LearnObj)
-> LearnObj -> f LearnObj
forall a. Projector DLPlate a -> a -> f a
b DLPlate f -> LearnObj -> f LearnObj
forall (f :: * -> *). DLPlate f -> LearnObj -> f LearnObj
learnObj) ((forall (f :: * -> *). DLPlate f -> Review -> f Review)
-> Review -> f Review
forall a. Projector DLPlate a -> a -> f a
b DLPlate f -> Review -> f Review
forall (f :: * -> *). DLPlate f -> Review -> f Review
review) 
    ((forall (f :: * -> *). DLPlate f -> CaseProb -> f CaseProb)
-> CaseProb -> f CaseProb
forall a. Projector DLPlate a -> a -> f a
b DLPlate f -> CaseProb -> f CaseProb
forall (f :: * -> *). DLPlate f -> CaseProb -> f CaseProb
caseProb) ((forall (f :: * -> *). DLPlate f -> Example -> f Example)
-> Example -> f Example
forall a. Projector DLPlate a -> a -> f a
b DLPlate f -> Example -> f Example
forall (f :: * -> *). DLPlate f -> Example -> f Example
example) ((forall (f :: * -> *). DLPlate f -> Smmry -> f Smmry)
-> Smmry -> f Smmry
forall a. Projector DLPlate a -> a -> f a
b DLPlate f -> Smmry -> f Smmry
forall (f :: * -> *). DLPlate f -> Smmry -> f Smmry
smmry) ((forall (f :: * -> *). DLPlate f -> Apndx -> f Apndx)
-> Apndx -> f Apndx
forall a. Projector DLPlate a -> a -> f a
b DLPlate f -> Apndx -> f Apndx
forall (f :: * -> *). DLPlate f -> Apndx -> f Apndx
apndx)