-- Copyright © 2021 Felix Lechner
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <https://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Main where

import qualified Codec.Compression.Lzma        as Lzma
import           Control.DeepSeq                ( force )
import           Control.Exception              ( evaluate )
import           Control.Monad.Catch            ( SomeException(..)
                                                , try
                                                )
import           Control.Monad.Loops            ( iterateM_ )
import qualified Data.Aeson                    as JSON
import qualified Data.ByteString.Lazy.Char8    as Lazy
import           Data.Either                    ( Either(Left, Right) )
import           Data.List                      ( intercalate
                                                , map
                                                )
import           Data.Time.ISO8601              ( formatISO8601Millis )
import qualified Data.Yaml                     as Yaml
import           GHC.Generics                   ( Generic )
import qualified Options.Applicative           as Options
import           System.Environment             ( getArgs )
import           System.ZMQ4.Monadic            ( Rep(..)
                                                , Socket(..)
                                                , ZMQ(..)
                                                , bind
                                                , connect
                                                , liftIO
                                                , receive
                                                , runZMQ
                                                , send
                                                , socket
                                                )
import           Text.Printf                    ( printf )

import qualified Job.Product                   as Product
import           Job.Product                    ( Product )
import qualified Job.Task                      as Task
import           Job.Task                       ( Task )
import qualified Lintian.Results               as Results
import           Lintian.Results                ( Results )

data CommandLine = CommandLine
  { configPath :: String
  }

parser :: Options.Parser CommandLine
parser = CommandLine <$> Options.strOption
  (  Options.long "config"
  <> Options.short 'c'
  <> Options.metavar "PATH"
  <> Options.help "Path to configuration file"
  )

data Config = Config
  { listen_port    :: Int
  , storage_folder :: String
  }
  deriving (Show, Generic)

instance Yaml.FromJSON Config

defaultConfig = Config { listen_port = 5555, storage_folder = "/tmp" }

getConfig :: String -> IO Config
getConfig configPath = do
  eitherConfig <-
    Yaml.decodeFileEither configPath :: IO (Either Yaml.ParseException Config)

  case eitherConfig of
    Right config -> return config
    Left  error  -> do
      print error
      return defaultConfig

saveTask :: Lazy.ByteString -> Task -> String -> Integer -> IO ()
saveTask message task baseDir counter = do
  let task_data = map
        ($ task)
        [Task.source_name, Task.source_version, Task.release, Task.port]

  case Task.product task of
    Nothing -> printf "[%d] Error: no product from %s tool for %s.\n"
                      counter
                      (Task.tool_name task)
                      (Task.name task)
    Just product -> do

      let start_time = formatISO8601Millis $ Product.processing_start product

      case Product.stdout product of
        Nothing -> printf
          "[%d] Error: no program output from %s tool for %s.\n"
          counter
          (Task.tool_name task)
          (Task.name task)
        Just results -> do

          let lintian_version = Results.lintian_version results
          let name_data       = task_data ++ [lintian_version, start_time]

          let fileName        = intercalate "_" name_data ++ ".json.xz"

          printf "[%d] Received %s.\n" counter fileName
          Lazy.writeFile (baseDir ++ "/" ++ fileName) message

processMessage :: Lazy.ByteString -> Config -> Integer -> IO ()
processMessage bytes config counter = do
  result <-
    try (evaluate $ force $ Lzma.decompress bytes) :: IO
      (Either SomeException Lazy.ByteString)
  case result of
    Left  error -> print error
    Right json  -> do
      let eitherTask = JSON.eitherDecode json :: Either String Task

      case eitherTask of
        Right task  -> saveTask bytes task (storage_folder config) counter
        Left  error -> printf "Error: %s\n%s\n" error (Lazy.unpack json)

collect :: CommandLine -> IO ()
collect (CommandLine path) = do
  config <- getConfig path

  printf "Listening on port %d.\n" (listen_port config)

  runZMQ $ do
    responder <- socket Rep
    bind responder $ "tcp://*:" ++ show (listen_port config)

    flip iterateM_ 1 $ \counter -> do
      message <- receive responder
      liftIO $ processMessage (Lazy.fromStrict message) config counter

      send responder [] "thanks"
      pure (counter + 1)

main :: IO ()
main = collect =<< Options.execParser opts
 where
  opts = Options.info
    (parser Options.<**> Options.helper)
    (  Options.fullDesc
    <> Options.progDesc "Collect job results from worker processes"
    <> Options.header "collect - receive results from job workers"
    )
