diff --git a/app/Main.hs b/app/Main.hs index 7d17e9a..1c8fa64 100644 --- a/app/Main.hs +++ b/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 diff --git a/app/Workflow.hs b/app/Workflow.hs index 21c86f3..42423fb 100644 --- a/app/Workflow.hs +++ b/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. diff --git a/app/YamlParser.hs b/app/YamlParser.hs index 437ed35..982ce3b 100644 --- a/app/YamlParser.hs +++ b/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