lmu/uni2work.workflows.visualiser
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

unpack text before output

Browse Source
This commit is contained in:
David Mosbach 2023-06-30 04:51:06 +02:00
parent a4384f8bd1
commit d77e73f737
3 changed files with 22 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
app/Main.hs
View File

@ -20,7 +20,7 @@ module Main where
import Index (Index, Entry (Entry), getDefDescription, getInstDescription, getEntryByFile) import Index (Index, Entry (Entry), getDefDescription, getInstDescription, getEntryByFile)
import Data.Char (isSpace) 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 (decode1Strict, Node, Pos, Parser, parseEither)
import Data.YAML.Event hiding (Scalar) import Data.YAML.Event hiding (Scalar)
import Control.Monad (forM_) import Control.Monad (forM_)
@ -80,6 +80,7 @@ module Main where
generateJSON args = do generateJSON args = do
-- print $ head args -- print $ head args
-- print $ last args -- print $ last args
putStrLn $ "reading " ++ head args ++ "..."
content <- BS.readFile (head args) content <- BS.readFile (head args)
let decoded = decodeWithComments1Strict content :: Either (Pos, String) Workflow let decoded = decodeWithComments1Strict content :: Either (Pos, String) Workflow
if isLeft decoded then error (show $ fromLeft undefined decoded) else do if isLeft decoded then error (show $ fromLeft undefined decoded) else do
@ -91,7 +92,7 @@ module Main where
encodeFile (last args) $ buildData yaml 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 -- | 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 description = if isJust description1 then description1 else description2
url = snd x url = snd x
format = dropWhileEnd isSpace . map (\y -> if y == '\n' then ' ' else y) 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\": \"" ++ "\",\n\"description\": \""
++ format (show $ fromMaybe (pack "") description) ++ "\",\n\"url\": \"" ++ url ++ "\"}" ++ format (unpack $ fromMaybe (pack "") description) ++ "\",\n\"url\": \"" ++ url ++ "\"}"
in writeIndex index xs (newContent ++ content) in writeIndex index xs (newContent ++ content)
decodeIndex :: FilePath -> IO Index decodeIndex :: FilePath -> IO Index
decodeIndex path = do decodeIndex path = do

7
app/Workflow.hs
View File

@ -134,6 +134,13 @@ module Workflow where
<*> pure comment <*> pure comment
<*> pure anchor <*> pure anchor
<*> pure merge <*> 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. -- | Structure of an edge.

15
app/YamlParser.hs
View File

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