95 lines
4.8 KiB
Haskell
95 lines
4.8 KiB
Haskell
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)
|
|
import Data.Either (isLeft, fromLeft, fromRight)
|
|
import Control.Exception (throw)
|
|
import Text.Regex.TDFA ((=~))
|
|
|
|
---------------------------------------
|
|
|
|
|
|
----------------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] -> [FilePath] -> Maybe FilePath -> IO () -- sources -> targets -> _index.yaml
|
|
generateForAll [] _ Nothing = fail "_index.yaml not found"
|
|
generateForAll [] targets (Just index) = writeIndex (decodeIndex index) targets "]"
|
|
generateForAll (x:xs) targets index = let (rel, abs) = defineTarget x
|
|
(newIndex, skip) = case index of
|
|
Just _ -> (index, False)
|
|
Nothing -> if x =~ ".+index\\.yaml" then (Just x, True) else (Nothing, False)
|
|
in if skip || x `elem` blackList
|
|
then generateForAll xs targets newIndex
|
|
else generateJSON [src ++ "/" ++ x, abs] >> generateForAll xs (rel:targets) newIndex
|
|
defineTarget :: FilePath -> (FilePath, FilePath) -- (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 (relative, absolute)
|
|
writeIndex :: Value -> [FilePath] -> String -> IO () -- content of _index.yaml -> targets -> content for index.json
|
|
writeIndex _ [] content = writeFile (to ++ "/index.json") ('[':content)
|
|
writeIndex index (x:xs) content = let name = x
|
|
url = x
|
|
description = ""
|
|
newContent = (if null xs then "" else ",\n") ++ "{\n\"name\": \"" ++ name
|
|
++ "\",\n\"description\": \""
|
|
++ description ++ "\",\n\"url\": \"" ++ url ++ "\"}"
|
|
in writeIndex index xs (newContent ++ content)
|
|
decodeIndex :: FilePath -> Value
|
|
decodeIndex _ = Null
|
|
|
|
|
|
---------------------------------------
|
|
|
|
-- 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 |