-- SPDX-FileCopyrightText: 2023 David Mosbach <david.mosbach@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Main where

  ----------------Imports----------------

  import Prelude hiding (lookup)
  import System.Environment (getArgs)
  import System.Directory
  import Data.Aeson (encode, encodeFile)

  import qualified Data.ByteString.Char8 as BS
  import qualified Data.ByteString.Lazy as BS.L
  import Workflow (Workflow, buildData)
  import Export
  import YamlParser (parse, ParseState (..), decodeWithComments1, decodeWithComments1Strict, YAMLNode)
  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)

  import Data.Text (pack, unpack, Text)
  import Data.YAML (decode1Strict, Node, Pos, Parser, parseEither)
  import Data.YAML.Event hiding (Scalar)
  import Control.Monad (forM_)
  import Control.Monad.State.Lazy
  import Data.Map.Lazy (Map, insert, lookup, empty)
  import Data.Text.Encoding (encodeUtf8, decodeUtf8)
  import Data.Text.Lazy (toStrict)
  import Debug.Trace (trace)
  import ServerMain (serverMain)
  
  ---------------------------------------


  ----------------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 ["--server"] = serverMain >> return True
    process [path] = printEvents path >> runParser path >> return True
    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."


  printEvents :: FilePath -> IO ()
  printEvents path = do
    input <- BS.L.readFile path
    forM_ (parseEvents input) $ \ev -> case ev of
      Left _ -> error "Failed to parse"
      Right event -> putStrLn (show (eEvent event) ++ " @" ++ show (posLine $ ePos event))


  runParser :: FilePath -> IO ()
  runParser path = do
    input <- BS.L.readFile path
    -- let events = parseEvents input
    -- let mainEvents = validHead events
    -- unless (isJust mainEvents) . error $ "Missing DocumentStart event"
    -- let initState = PState [] empty []
    -- let (rootNode, state) = runState (parse $ fromJust mainEvents) initState
    let decoded = decodeWithComments1 input :: Either (Pos, String) YAMLNode -- Workflow
    print decoded
    -- print rootNode where
    --   validHead :: EvStream -> Maybe EvStream
    --   validHead ((Right (EvPos StreamStart _)):(Right (EvPos (DocumentStart _) _)):es) = Just es
    --   validHead _ = Nothing
         


  -- | 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
    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
      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 (pack $ 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 (unpack $ fromMaybe (pack $ snd x) name)
                                                        ++ "\",\n\"description\": \""
                                                        ++ format (unpack $ fromMaybe (pack "") description) ++ "\",\n\"url\": \"" ++ url ++ "\"}"
                                      in  writeIndex index xs (newContent ++ content)
    decodeIndex :: FilePath -> IO Index
    decodeIndex path = do
      content <- BS.readFile path
      let decoded = decodeWithComments1Strict content :: Either (Pos, String) Index
      if isLeft decoded
      then error $ show (fromLeft undefined decoded)
      else return $ fromRight undefined decoded
    findEntry :: Text -> 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