Worked on manual, fixed bug when reading escaped inline-element.

Data/Yaml/Simple.hs

@@ -32,7 +32,7 @@ import Control.Arrow
 
 -- | Things that can be encoded as YAML
 class Yamlable y where
-   from_yaml :: Yaml -> y
+   from_yaml :: Yaml -> IO y
 
 -- | Yaml
 data Yaml =

Manual/Reader.hs

@@ -46,6 +46,7 @@ import System.Directory
 import qualified Data.Set as S
 
 import Control.Monad
+import Control.Exception hiding (try)
 
 
 -- | Parse an inline element
@@ -80,7 +81,7 @@ inline =
    itext :: Parser String
    itext =
       try (fmap return $ satisfy $ flip notElem "\\{")
-         <|> string "\\{"
+         <|> (string "\\{" >> return "{")
    section_link = link "section" ISectionLink
    extern_link = link "external" IExternLink
    link name f = do
@@ -105,9 +106,11 @@ eparse_inline txt =
          parse (many1 inline) "" txt
 
 -- | Parse inline elements
-parse_inline :: String -> [Inline]
-parse_inline txt =
-   either (error . show) id $ eparse_inline txt 
+parse_inline :: String -> IO [Inline]
+parse_inline txt = evaluate $
+   either (throw . error_line "Error while parsing inline elements from paragraph beginning:" . error_section . error_line (take 10 txt) . error_section . (flip error_lines empty_error) . lines . show) 
+          id
+          (eparse_inline txt)
 
 -- I say the orphan instances are okay because this is a module EXCLUSIVELY for reading in the manual
 
@@ -116,17 +119,17 @@ instance Yamlable Paragraph where
    from_yaml y =
       case y of
          YStr s ->
-            Paragraph (parse_inline s) ""
+            liftM2 Paragraph (parse_inline s) (return "")
          YMap m ->
-            Paragraph (parse_inline $ ptext "text") (ptext "class")
-         _      -> perror "Paragraph must be a string or a map"
+            liftM2 Paragraph (parse_inline $ ptext "text") (evaluate $ ptext "class")
+         _      -> throw $ new_error "Paragraph must be a string or a map"
       where
       -- Look up paragraph text from a map
       ptext :: String -> String
       ptext nm =
-         yext (yookup nm y) (error $ "Could not find text field '" ++ nm ++ "' in paragraph map.  Must have members 'text' and 'class'")
+         yext (yookup nm y) (throw $ new_error $ "Could not find field '" ++ nm ++ "' in paragraph map.  Must have members 'text' and 'class'")
 
-      perror msg = error $ pretty $
+      perror msg = throw $ 
          error_line "Error while reading Paragraph: " $
             error_section $ error_line msg $ error_section $ 
                error_lines ["Reading yaml:", show y] $ empty_error
@@ -148,20 +151,22 @@ ymap f y =
       _       -> Nothing
 
 instance Yamlable Section where
-   from_yaml y =
-      Section [snumber $ yookup "number" y]
-              (stitle $ yookup "title" y)
-              (read_key (serror "unique") $ yookup "unique" y)
-              (fromMaybe (serror "text") $ paras $ yookup "text" y)
-              []
+   from_yaml y = do
+      mps <- paras $ yookup "text" y
+      ps <- maybe (serror "text") evaluate mps
+      liftM5 Section (evaluate [snumber $ yookup "number" y])
+              (evaluate $ stitle $ yookup "title" y)
+              (evaluate $ read_key (serror "unique") $ yookup "unique" y)
+              (return ps)
+              (return [])
       where
       snumber a = 
          fromMaybe (serror "number")  $ a >>= ystr >>= readMay 
 
       stitle =
          read_key (serror "title")
 
-      serror msg = error $ pretty $ 
+      serror msg = throw $ 
          error_line "Error while reading Section:" $ error_section $
             error_line ("Section did not have a valid '" ++ msg ++ "' member.") $ error_section $
                error_lines ["Reading yaml:", show y] empty_error
@@ -177,17 +182,27 @@ not_empty nm str =
 
 -- | Load a section and all associated subsections.
 load_section :: FilePath -> IO Section
-load_section = flip load_section_nums []
-
+load_section sfp = load_section_nums sfp [] 
 
+-- | Catch errors while reading files
+catch_read_errs :: String -> IO a -> IO a
+catch_read_errs msg act =
+   act `catches` [Handler reporth, Handler anyh]
+   where
+   reporth :: Error -> a
+   reporth e = throw $ ewhere e
+   ewhere = error_line msg . error_section
+   anyh :: SomeException -> a
+   anyh e = throw $ ewhere $ error_lines (lines $ show e) empty_error
+
 -- | Load a section and all associated subsections.
 load_section_nums :: FilePath
              -> [Int]
              -> IO Section
-load_section_nums fp nums = do
+load_section_nums fp nums = catch_read_errs ("Error in section file " ++ fp) $ do
    root <- parse_yaml_file fp
+   un_root_section <- from_yaml root
    let new_nums = number un_root_section ++ nums
-       un_root_section = from_yaml root
        root_section = un_root_section {number = reverse new_nums}
        subsection_dir = dropExtensions fp
    subsections_exist <- doesDirectoryExist subsection_dir
@@ -197,38 +212,39 @@ load_section_nums fp nums = do
          subsects <- mapM (flip load_section_nums new_nums) subsect_fs
          return $ root_section {subsections = sort_sections subsects}
       else
-         return root_section
+         evaluate root_section
    where
    dir = dropFileName fp
 
 sort_sections :: [Section] -> [Section]
 sort_sections = 
    sortBy (\s1 s2 -> number s1 `compare` number s2)
 
-paras :: Maybe Yaml -> Maybe [Paragraph]
+paras :: Maybe Yaml -> IO (Maybe [Paragraph])
 paras ma =
-   ma >>= next
+   maybe (return Nothing) next ma
    where
+   next :: Yaml -> IO (Maybe [Paragraph])
    next y =
       case y of
-         YStr t -> Just [from_yaml y]
-         y -> ymap from_yaml y
+         YStr t -> fmap (Just . return) $ from_yaml y
+         y -> maybe (return Nothing) (fmap Just . sequence) $ ymap from_yaml y
 
 -- Load a header file
 instance Yamlable Header where
    from_yaml y =
-      Header title
-             copyright
-             license
-             license_file
-             preamble
+      liftM5 Header (evaluate title)
+                    (evaluate copyright)
+                    (evaluate license)
+                    (evaluate license_file)
+                    preamble
       where
       title = read_key (herror "title") $ yookup "title" y
       copyright = read_key (herror "copyright") $ yookup "copyright" y
       license = read_key (herror "license") $ yookup "license" y
       license_file = read_key (herror "license_file") $ yookup "license_file" y
-      preamble = fromMaybe [] $ paras $ yookup "preamble" y
-      herror nm = error $ pretty $ 
+      preamble = fmap (fromMaybe []) $ paras $ yookup "preamble" y
+      herror nm = throw $ 
          error_line "Error while reading Header:" $
             error_section $ error_line ("Header did not have valid '" ++ nm ++ "' field.") $ error_section $ 
                error_lines ["Reading yaml:", show y] empty_error
@@ -246,12 +262,14 @@ load_manual man_dir = do
    let files = S.fromList fs
        sfs = S.delete headf $ S.delete css_file $ files 
        headf = combine man_dir "header.yaml"
-   css <- if S.member css_file files then readFile css_file else return ""
-   if S.member headf files
-      then do
-         head <- fmap (from_yaml) $ parse_yaml_file headf
-         sections <- fmap sort_sections $ mapM load_section $ S.toList sfs
-         return $ Manual head css (contents sections) sections
-      else error $ "load_manual: Header not present"
+   catch_read_errs ("Error creating manual from source directory '" ++ man_dir ++ "':") (load_data headf files sfs)
    where
+   load_data headf files sfs = do
+      css <- if S.member css_file files then readFile css_file else return ""
+      if S.member headf files
+         then do
+            head <- parse_yaml_file headf >>= from_yaml
+            sections <- fmap sort_sections $ mapM load_section $ S.toList sfs
+            evaluate $ Manual head css (contents sections) sections
+         else throw $ new_error "Header not present"
    css_file = man_dir `combine` "style" `addExtension` "css"

Manual/Structure.hs

@@ -77,7 +77,7 @@ data Inline =
 -- | A text paragraph
 data Paragraph = Paragraph
    { -- | The paragraph text
-     ptext :: [Inline]
+     ptext :: ![Inline]
    , -- | The paragraph's class
      pclass :: String
    } 
@@ -92,7 +92,7 @@ data Manual = Manual
    , -- | The manual's contents.
      mcontents :: Contents
    , -- | The sections of a manual.
-     sections :: [Section]
+     sections :: ![Section]
    }
    deriving Show
 
@@ -105,9 +105,9 @@ data Section = Section
    , -- | Unique name for this section
     unique :: String
    , -- | The section text
-    stext :: [Paragraph]
+    stext :: ![Paragraph]
      -- | Subsections
-   , subsections :: [Section]
+   , subsections :: ![Section]
    }
    deriving Show