module Celtchar.Novel.Structure where
import Control.Applicative ((<|>))
import Data.HashMap.Strict ((!))
import Data.Maybe (fromMaybe)
import Data.Text (pack)
import Data.Yaml
import GHC.Generics
class HasDependencies c where
getDeps :: c -> [FilePath]
data Language = French | English
deriving (Generic)
newtype Document = Document FilePath
deriving (Generic, Show)
instance HasDependencies Document where
getDeps (Document fp) = [fp]
instance FromJSON Document where
parseJSON v = Document <$> parseJSON v
instance ToJSON Document where
toJSON (Document path) = String (pack path)
data Chapter = Chapter { chapterTitle :: Maybe String
, documents :: [Document]
}
deriving (Generic, Show)
instance HasDependencies Chapter where
getDeps (Chapter _ docs) = docs >>= getDeps
instance FromJSON Chapter where
parseJSON (Object v) = Chapter <$> v .:? "title"
<*> v .: "documents"
instance ToJSON Chapter where
toJSON (Chapter title docs) = object [ "title" .= title
, "documents" .= docs
]
data Part = Part { partTitle :: String
, chapters :: [Chapter]
}
deriving (Generic, Show)
instance FromJSON Part where
parseJSON (Object v) = Part <$> v .: "title"
<*> v .: "chapters"
instance ToJSON Part where
toJSON (Part title chaps) = object [ "title" .= title
, "chapters" .= chaps
]
instance HasDependencies Part where
getDeps (Part _ chaps) = chaps >>= getDeps
data Manuscript = WithParts [Part]
| WithChapters [Chapter]
deriving (Generic, Show)
instance HasDependencies Manuscript where
getDeps (WithParts parts) = parts >>= getDeps
getDeps (WithChapters chaps) = chaps >>= getDeps
instance FromJSON Manuscript where
parseJSON v = (WithParts <$> parseJSON v)
<|> (WithChapters <$> parseJSON v)
instance ToJSON Manuscript where
toJSON (WithParts p) = toJSON p
toJSON (WithChapters c) = toJSON c
instance FromJSON Language where
parseJSON (String "english") = pure English
parseJSON (String "french") = pure French
parseJSON _ = fail "unknown language"
instance ToJSON Language where
toJSON English = String $ pack "english"
toJSON French = String $ pack "french"
instance Show Language where
show English = "english"
show French = "french"
data Novel = Novel { author :: String
, language :: Language
, novelTitle :: String
, frontmatter :: Maybe [Chapter]
, manuscript :: Manuscript
, appendix :: Maybe [Chapter]
}
deriving (Generic, Show)
instance HasDependencies Novel where
getDeps (Novel _ _ _ mfrontmatter man mappendix) =
(frontmatter >>= getDeps)
`mappend` getDeps man
`mappend` (appendix >>= getDeps)
where frontmatter = fromMaybe [] mfrontmatter
appendix = fromMaybe [] mappendix
instance FromJSON Novel where
parseJSON (Object v) = Novel <$> v .: "author"
<*> v .: "language"
<*> v .: "title"
<*> v .:? "frontmatter"
<*> v .: "manuscript"
<*> v .:? "appendix"
instance ToJSON Novel where
toJSON (Novel author language title front man app) =
object [ "language" .= language
, "author" .= author
, "frontmatter" .= front
, "title" .= title
, "manuscript" .= man
, "appendix" .= app
]
getNovelStructure :: FilePath -> IO (Either String Novel)
getNovelStructure conf = do
ec <- decodeFileEither conf
case ec of
Right novel -> pure . Right $ novel
Left ex -> pure . Left $ prettyPrintParseException ex
defaultNovel :: Novel
defaultNovel =
Novel { novelTitle = "title"
, author = "author"
, language = English
, frontmatter = Just []
, appendix = Just []
, manuscript =
WithParts [ Part { partTitle = "part title"
, chapters = [ Chapter { chapterTitle = Just "chapter title"
, documents = []
}]
}
]
}