{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Codec.Archive.Tar qualified as Tar
import Codec.Archive.Tar.Entry (fileEntry, toTarPath)
import Control.Applicative ((<**>), optional)
import Control.Arrow ((&&&))
import Control.Monad (unless, void, when)
import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
import Data.ByteString.Lazy qualified as Lazy
import Data.ByteString.Lazy qualified as ByteString.Lazy
import Data.CAProvinceCodes qualified as Province
import Data.Char (toUpper)
import Data.Foldable (toList)
import Data.List (intercalate, sortOn)
import Data.Map.Lazy qualified as Map
import Data.Maybe (catMaybes)
import Data.Semigroup (Any (Any))
import Data.Semigroup.Cancellative (isPrefixOf, isSuffixOf)
import Data.Text (Text)
import Options.Applicative (Parser, ReadM, long, metavar, short)
import Options.Applicative qualified as OptsAp
import Rank2 qualified
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
import System.FilePath (replaceDirectory, takeFileName)
import System.IO (hPutStrLn, stderr)
import Text.FDF (FDF, parse, serialize)

import Tax.Canada (completeForms)
import Tax.FDF (FDFs)
import Tax.FDF qualified as FDF
import Tax.PDFtk (fdf2pdf, pdf2fdf)

main :: IO ()
main = OptsAp.execParser (OptsAp.info optionsParser
                          $ OptsAp.progDesc "Update all calculated fields in a Canadian T1 tax form")
       >>= process

data Options = Options {
   province :: Province.Code,
   t1InputPath :: FilePath,
   p428InputPath :: Maybe FilePath,
   p479InputPath :: Maybe FilePath,
   schedule6InputPath :: Maybe FilePath,
   schedule7InputPath :: Maybe FilePath,
   schedule9InputPath :: Maybe FilePath,
   schedule11InputPath :: Maybe FilePath,
   outputPath :: FilePath,
   verbose :: Bool}

optionsParser :: Parser Options
optionsParser =
   Options
   <$> OptsAp.argument readProvince (metavar "<two-letter province code>")
   <*> OptsAp.strOption (long "t1" <> metavar "<input T1 form file>")
   <*> optional (OptsAp.strOption (long "428" <> metavar "<input 428 form file>"))
   <*> optional (OptsAp.strOption (long "479" <> metavar "<input 479 form file>"))
   <*> optional (OptsAp.strOption (long "s6" <> metavar "<input Schedule 6 form file>"))
   <*> optional (OptsAp.strOption (long "s7" <> metavar "<input Schedule 7 form file>"))
   <*> optional (OptsAp.strOption (long "s9" <> metavar "<input Schedule 9 form file>"))
   <*> optional (OptsAp.strOption (long "s11" <> metavar "<input Schedule 11 form file>"))
   <*> OptsAp.strOption (short 'o' <> long "output" <> OptsAp.value "-" <> metavar "<output file or directory>")
   <*> OptsAp.switch (short 'v' <> long "verbose")
   <**> OptsAp.helper

readProvince :: ReadM Province.Code
readProvince = OptsAp.eitherReader (tryRead . map toUpper)
   where tryRead s = case reads s
                     of [(p, "")] -> Right p
                        _ -> Left ("Invalid province code " <> s <> " - expecting one of "
                                   <> intercalate ", " (onLast ("or " <>) $ show <$> Province.all))
         onLast f [x] = [f x]
         onLast f (x:xs) = x : onLast f xs
         onLast _ [] = []

readFDF :: FilePath -> IO (Bool, Lazy.ByteString)
readFDF inputPath = do
   exists <- doesFileExist inputPath
   unless (inputPath == "-" || exists) (error $ "Input file " <> show inputPath <> " doesn't exist.")
   content <- if inputPath == "-" then ByteString.Lazy.getContents else ByteString.Lazy.readFile inputPath
   if "%FDF-1." `isPrefixOf` content
      then pure (False, content)
      else if "%PDF-1." `isPrefixOf` content
           then either error ((,) True) <$> pdf2fdf content
           else error "Expecting an FDF or PDF file"

process :: Options -> IO ()
process Options{province, t1InputPath, p428InputPath, p479InputPath,
                schedule6InputPath, schedule7InputPath, schedule9InputPath, schedule11InputPath,
                outputPath, verbose} = do
   let inputFiles :: [(Text, FilePath)]
       inputFiles = sortOn fst $
                    catMaybes [(,) "T1"  <$> Just t1InputPath,
                               (,) "428" <$> p428InputPath,
                               (,) "479" <$> p479InputPath,
                               (,) "Schedule6" <$> schedule6InputPath,
                               (,) "Schedule7" <$> schedule7InputPath,
                               (,) "Schedule9" <$> schedule9InputPath,
                               (,) "Schedule11" <$> schedule11InputPath]
   inputs <- traverse (traverse readFDF) inputFiles :: IO [(Text, (Bool, Lazy.ByteString))]
   let writeFrom :: FilePath -> Bool -> ByteString.ByteString -> IO ()
       writeFrom inputPath asPDF content = do
          content' <- (if asPDF then (either error Lazy.toStrict <$>) . fdf2pdf inputPath . Lazy.fromStrict else pure) content
          if outputPath == "-"
             then ByteString.putStr content'
             else do
                isDir <- doesDirectoryExist outputPath
                if isDir
                   then ByteString.writeFile (replaceDirectory inputPath outputPath) content'
                   else ByteString.writeFile outputPath content'
       paths = snd <$> inputFiles :: [FilePath]
       arePDFs = fst . snd <$> inputs
       bytesMap = Lazy.toStrict . snd <$> Map.fromAscList inputs
   case traverse parse bytesMap >>= completeForms province of
      Left err -> error err
      Right fixedFDFs -> do
         let bytesMap' = serialize <$> fixedFDFs
             byteses' = toList bytesMap'
             tarEntries = sequenceA (zipWith fdfEntry paths byteses')
             fdfEntry path content =
                (`fileEntry` ByteString.Lazy.fromStrict content) <$> toTarPath False (takeFileName path)
             tarFile = either (error . ("Can't tar: " <>)) (ByteString.Lazy.toStrict . Tar.write) tarEntries
         -- when verbose (hPutStrLn stderr $ show (form'T1, form'ON))
         when ("/" `isSuffixOf` outputPath) (createDirectoryIfMissing True outputPath)
         if outputPath == "-"
            then ByteString.putStr tarFile
            else do isDir <- doesDirectoryExist outputPath
                    if isDir
                       then void $ sequenceA (zipWith3 writeFrom paths arePDFs byteses')
                       else ByteString.writeFile outputPath tarFile