{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (forM_, when)
import qualified Data.Binary as B
import Data.Function (on)
import Data.List (intercalate, groupBy, sortBy)
import Data.Maybe (catMaybes, fromJust, isJust)
import Data.Ord (comparing)
import qualified Distribution.Types.PackageDescription as PD
import Distribution.Types.PackageDescription (PackageDescription)
import Distribution.Types.BuildType (BuildType(Simple))
import Options.Applicative (execParser)
import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
import System.Exit (die)
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)

import Coolbal.CabalPlan
import Coolbal.Configure (configure)
import Coolbal.FindRoot
import Coolbal.Options
import Coolbal.Target
import Coolbal.Target.Executable (makeExeTarget)


checkCompatibleSpec :: PackageDescription -> IO ()
checkCompatibleSpec pd
  | PD.buildType pd /= Simple = die ("Only build type Simple is supported; package uses " ++ show (PD.buildType pd))
  | not (null (PD.setupBuildInfo pd)) = die "Custom setup build info unsupported"
  | otherwise = return ()

compatibleTargets :: PackageDescription -> CabalPlan -> [AnyTarget]
compatibleTargets pd plan =
    catMaybes (map (\e -> AnyTargetExe <$> makeExeTarget e plan) (PD.executables pd))

parseCabalPlan' :: FoundCabalSpec -> IO CabalPlan
parseCabalPlan' foundSpec = 
    parseCabalPlan (foundcsRootDir foundSpec </> "dist-newstyle/cache/plan.json")
        >>= \case NotFound -> die "Cabal plan.json not found; make sure to run 'cabal build' beforehand"
                  ParseError e -> die ("Error when parsing Cabal plan.json: " ++ e)
                  Parsed plan -> return plan

readCachedTargets :: (AnyTarget -> Bool) -> IO (FilePath, [AnyTarget], [(String, [AnyTarget])])
readCachedTargets predicate = do
    FoundRootDir rootdir <- findDist
    allTargets <- B.decodeFile (rootdir </> "dist-coolbal/targets.bin")
    let targets = filter predicate allTargets
        targetsForName = map ((,) <$> fst . head <*> map snd)
                         $ groupBy ((==) `on` fst)
                         $ sortBy (comparing fst)
                         $ concat
                             [[(useAnyTarget targetName t, t), (useAnyTarget targetNameQualified t, t)]
                             | t <- targets]
    return (rootdir, targets, targetsForName)

targetsToBuild :: [(String, [AnyTarget])] -> String -> IO [AnyTarget]
targetsToBuild targetsForName name =
    case lookup name targetsForName of
      Nothing -> die ("Target not found: '" ++ name ++ "'")
      Just [t] -> return [t]
      Just _ -> die ("Ambiguous target name: '" ++ name ++ "'")

doConfigure :: IO ()
doConfigure = do
    foundSpec <- findCabalSpec
    pd <- configure (foundcsCabal foundSpec)
    checkCompatibleSpec pd
    plan <- parseCabalPlan' foundSpec
    -- print pd
    let targets = compatibleTargets pd plan
        names = map (useAnyTarget (\t -> targetName t ++ " (" ++ targetNameQualified t ++ ")")) targets
    hPutStrLn stderr ("Supported targets: " ++ intercalate ", " names)

    createDirectoryIfMissing True (foundcsRootDir foundSpec </> "dist-coolbal")
    B.encodeFile (foundcsRootDir foundSpec </> "dist-coolbal/targets.bin") targets

doClean :: IO ()
doClean = do
    foundSpec <- findCabalSpec
    removeDirectoryRecursive (foundcsRootDir foundSpec </> "dist-coolbal")

doBuild :: BuildOptions -> IO ()
doBuild (BuildOptions mtarget) = do
    (rootdir, targets, targetsForName) <- readCachedTargets (const True)
    toBuild <- maybe (return targets) (targetsToBuild targetsForName) mtarget
    forM_ toBuild $ useAnyTarget $ \tg -> do
        old <- targetCheckOld rootdir tg
        when old $ targetBuild rootdir tg

doRun :: RunOptions -> IO ()
doRun (RunOptions mtarget args) = do
    (rootdir, targets, targetsForName) <- readCachedTargets (isJust . useAnyTarget targetExecute)
    toBuild <- maybe (return targets) (targetsToBuild targetsForName) mtarget
    case toBuild of
      [tg] -> do
          useAnyTarget (\tg' -> do old <- targetCheckOld rootdir tg'
                                   when old $ targetBuild rootdir tg'
                                   -- when (not old) $ putStrLn "Up to date"
                                   fromJust (targetExecute tg') rootdir args)
                       tg

      _ -> do
          die "Cannot determine which target to run, multiple executables found"

main :: IO ()
main = do
    options <- execParser optionParser
    case options of
      Configure -> doConfigure
      Clean -> doClean
      Build opts -> doBuild opts
      Run opts -> doRun opts