unpack text before output

app/Main.hs

@@ -20,7 +20,7 @@ module Main where
   import Index (Index, Entry (Entry), getDefDescription, getInstDescription, getEntryByFile)
   import Data.Char (isSpace)
 
-  import Data.Text (pack, Text)
+  import Data.Text (pack, unpack, Text)
   import Data.YAML (decode1Strict, Node, Pos, Parser, parseEither)
   import Data.YAML.Event hiding (Scalar)
   import Control.Monad (forM_)
@@ -80,6 +80,7 @@ module Main where
   generateJSON args = do
     -- print $ head args
     -- print $ last args
+    putStrLn $ "reading " ++ head args ++ "..."
     content <- BS.readFile (head args)
     let decoded = decodeWithComments1Strict content :: Either (Pos, String) Workflow
     if isLeft decoded then error (show $ fromLeft undefined decoded) else do
@@ -91,7 +92,7 @@ module Main where
       encodeFile (last args) $ buildData yaml
 
 
-  blackList = ["patch.yaml"] -- files not to parse when parsing the entire directory
+  blackList = ["patch.yaml", "theses.yaml", "master-practical-training.yaml"] -- files not to parse when parsing the entire directory
 
 
   -- | Processes all workflow definitions within the given directory (1) and writes the output files
@@ -125,9 +126,9 @@ module Main where
                                           description = if isJust description1 then description1 else description2
                                           url = snd x
                                           format = dropWhileEnd isSpace . map (\y -> if y == '\n' then ' ' else y)
-                                          newContent = (if null xs then "" else ",\n") ++ "{\n\"name\": \"" ++ format (show $ fromMaybe (pack $ snd x) name)
+                                          newContent = (if null xs then "" else ",\n") ++ "{\n\"name\": \"" ++ format (unpack $ fromMaybe (pack $ snd x) name)
                                                         ++ "\",\n\"description\": \""
-                                                        ++ format (show $ fromMaybe (pack "") description) ++ "\",\n\"url\": \"" ++ url ++ "\"}"
+                                                        ++ format (unpack $ fromMaybe (pack "") description) ++ "\",\n\"url\": \"" ++ url ++ "\"}"
                                       in  writeIndex index xs (newContent ++ content)
     decodeIndex :: FilePath -> IO Index
     decodeIndex path = do

app/Workflow.hs

@@ -134,6 +134,13 @@ module Workflow where
                                                         <*> pure comment
                                                         <*> pure anchor
                                                         <*> pure merge
+    fromYAML (Scalar bytes comment anchor _) = Label
+                                               <$> pure (Just . decodeUtf8 $ bytes)
+                                               <*> pure (Just . pack $ "de-de-formal")
+                                               <*> pure Nothing
+                                               <*> pure comment
+                                               <*> pure anchor
+                                               <*> pure []
 
 
   -- | Structure of an edge.

app/YamlParser.hs

@@ -63,6 +63,11 @@ module YamlParser where
   parse ((Right (EvPos (DocumentEnd _) pos)):_) = get >>= \pState -> return $ if  length pState.rootNodes == 1
                                                                             then head pState.rootNodes
                                                                             else Sequence pState.rootNodes [] NoAnchor pos
+  parse [] = get >>= \pState -> return $ if  length pState.rootNodes == 1
+                                         then head pState.rootNodes
+                                         else Sequence pState.rootNodes [] NoAnchor undefined
+  parse ((Right (EvPos StreamStart _)):es) = parseComment es >>= parse
+  parse ((Right (EvPos (DocumentStart _) _)):es) = parse es
   parse es = do
     (root, es') <- parseNode es
     pState <- get
@@ -78,8 +83,8 @@ module YamlParser where
 
 
   parseNode :: EvStream -> State ParseState (Maybe YAMLNode, EvStream)
-  parseNode [] = error "Unexpected eof"
-  parseNode ((Left _):es) = error "Failed to parse"
+  parseNode [] = trace "Unexpected eof" $ return (Nothing, [])
+  parseNode ((Left (p,s)):es) = trace ("Failed to parse: " ++ show s ++ " @ line " ++ show p.posLine) $ parseNode es
   parseNode es@((Right (EvPos event pos)):es') = do
     pState <- get
     showTrace (EvPos event pos) $ case event of
@@ -197,10 +202,10 @@ module YamlParser where
   decodeWithComments1 :: FromYAML' v => BS.L.ByteString -> Either (Pos, String) v
   decodeWithComments1 input = do
     let events = parseEvents input
-    let mainEvents = validHead events
-    unless (isJust mainEvents) . error $ "Missing DocumentStart event"
+    -- let mainEvents = validHead events
+    -- unless (isJust mainEvents) . error $ "Missing DocumentStart event"
     let initState = PState [] empty []
-    let content = evalState (parse $ fromJust mainEvents) initState
+    let content = evalState (parse events) initState
     parseEither . fromYAML $ content
     where
       validHead :: EvStream -> Maybe EvStream