113 lines
6.0 KiB
Haskell
113 lines
6.0 KiB
Haskell
-- SPDX-FileCopyrightText: 2023 David Mosbach <david.mosbach@campus.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Main where
|
|
|
|
----------------Imports----------------
|
|
|
|
import System.Environment (getArgs)
|
|
import System.Directory
|
|
import Data.Yaml (ParseException, decodeEither', Value (String, Null))
|
|
import Data.Aeson (encode, encodeFile)
|
|
|
|
import qualified Data.ByteString.Char8 as BS
|
|
import Workflow (Workflow, buildData)
|
|
import Export
|
|
import Data.Maybe (fromJust, isNothing, isJust, fromMaybe)
|
|
import Data.Either (isLeft, fromLeft, fromRight)
|
|
import Data.List (dropWhileEnd)
|
|
import Control.Exception (throw)
|
|
import Text.Regex.TDFA ((=~))
|
|
import Index (Index, Entry (Entry), getDefDescription, getInstDescription, getEntryByFile)
|
|
import Data.Char (isSpace)
|
|
|
|
---------------------------------------
|
|
|
|
|
|
----------------Methods----------------
|
|
|
|
-- | Required command line arguments:
|
|
-- 1. A workflow source file (YAML)
|
|
-- 2. A graph data target file (JSON)
|
|
main :: IO ()
|
|
main = getArgs >>= process >>= finish where
|
|
process :: [String] -> IO Bool
|
|
process args@[_, _] = generateJSON args >> return False
|
|
process args@["--all", src, to] = processDirectory src to >> return False
|
|
process _ = print "Please provide (1) a source and (2) a target file or provide '--all' and (1) a source and (2) a target directory" >> return True
|
|
finish :: Bool -> IO ()
|
|
finish abort = if abort then return () else print "Done."
|
|
|
|
|
|
|
|
-- | Imports the YAML document specified in the first command line argument and
|
|
-- exports the graph data to the JSON file specified in the second argument.
|
|
generateJSON :: [String] -> IO ()
|
|
generateJSON args = do
|
|
-- print $ head args
|
|
-- print $ last args
|
|
content <- BS.readFile (head args)
|
|
let decoded = decodeEither' content :: Either ParseException Workflow
|
|
if isLeft decoded then throw (fromLeft undefined decoded) else do
|
|
let yaml = fromRight undefined decoded
|
|
-- let GData (nodeData, edgeData) = buildData yaml
|
|
-- putStrLn $ "\nNode Data:\n\n" ++ show nodeData
|
|
-- putStrLn $ "\nEdge Data:\n\n" ++ show edgeData
|
|
-- encodeFile (last args) $ GData (nodeData, edgeData)
|
|
encodeFile (last args) $ buildData yaml
|
|
|
|
|
|
blackList = ["patch.yaml"] -- files not to parse when parsing the entire directory
|
|
|
|
|
|
-- | Processes all workflow definitions within the given directory (1) and writes the output files
|
|
-- to the other given directory (2).
|
|
processDirectory :: FilePath -> FilePath -> IO ()
|
|
processDirectory src to = listDirectory src >>= filterWorkflows >>= (\ x -> generateForAll x [] Nothing) where
|
|
filterWorkflows :: [FilePath] -> IO [FilePath]
|
|
filterWorkflows entries = return $ filter (=~ ".+\\.yaml") entries
|
|
generateForAll :: [FilePath] -> [(String, FilePath)] -> Maybe FilePath -> IO () -- sources -> targets -> _index.yaml
|
|
generateForAll [] _ Nothing = fail "_index.yaml not found"
|
|
generateForAll [] targets (Just index) = decodeIndex index >>= \x -> writeIndex x targets "]"
|
|
generateForAll (x:xs) targets index = let (yaml, rel, abs) = defineTarget x
|
|
(newIndex, skip) = case index of
|
|
Just _ -> (index, False)
|
|
Nothing -> if x =~ ".+index\\.yaml" then (Just $ src ++ "/" ++ x, True) else (Nothing, False)
|
|
in if skip || x `elem` blackList
|
|
then generateForAll xs targets newIndex
|
|
else generateJSON [src ++ "/" ++ x, abs] >> generateForAll xs ((yaml, rel):targets) newIndex
|
|
defineTarget :: FilePath -> (String, FilePath, FilePath) -- (src, rel, abs)
|
|
defineTarget x = let (path, match, _) = x =~ "[a-zA-Z0-9+._-]+\\.yaml" :: (String, String, String)
|
|
(newFile, _, _) = match =~ "\\." :: (String, String, String)
|
|
relative = "/definitions/" ++ newFile ++ ".json"
|
|
absolute = to ++ relative
|
|
in (match, relative, absolute)
|
|
writeIndex :: Index -> [(String, FilePath)] -> String -> IO () -- content of _index.yaml -> targets -> content for index.json
|
|
writeIndex index [] content = print index >> writeFile (to ++ "/index.json") ('[':content)
|
|
writeIndex index (x:xs) content = let entry = findEntry (fst x) index
|
|
(name1, description1) = getDefDescription entry
|
|
(name2, description2) = getInstDescription entry
|
|
name = if isJust name1 then name1 else name2
|
|
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 (fromMaybe (snd x) name)
|
|
++ "\",\n\"description\": \""
|
|
++ format (fromMaybe "" description) ++ "\",\n\"url\": \"" ++ url ++ "\"}"
|
|
in writeIndex index xs (newContent ++ content)
|
|
decodeIndex :: FilePath -> IO Index
|
|
decodeIndex path = do
|
|
content <- BS.readFile path
|
|
let decoded = decodeEither' content :: Either ParseException Index
|
|
if isLeft decoded
|
|
then throw (fromLeft undefined decoded)
|
|
else return $ fromRight undefined decoded
|
|
findEntry :: String -> Index -> Entry
|
|
findEntry file index = getEntryByFile file index
|
|
|
|
|
|
---------------------------------------
|
|
|
|
-- https://stackoverflow.com/questions/59903779/how-to-parse-json-with-field-of-optional-and-variant-type-in-haskell
|
|
-- https://stackoverflow.com/questions/21292428/reading-yaml-lists-of-objects-in-haskell |