module Main where

import Control.Monad
import Data.List
import Data.Maybe
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Process
import Text.Read

import Opts

{-
 - program & directory work
 -}
gitProg :: IO String
gitProg = fromMaybe "git" <$> lookupEnv "DELI_GIT"

gitCmd :: [String] -> IO ()
gitCmd args = do
  git <- gitProg
  st <- rawSystem git args
  unless (st == ExitSuccess) . fail $ "git command failed: " ++ show args

gitCmdOutput :: [String] -> IO String
gitCmdOutput args = do
  git <- gitProg
  (out, st) <-
    withCreateProcess (proc git args) {std_in = NoStream, std_out = CreatePipe} $ \_ (Just oh) _ p ->
      (,) <$> hGetContents' oh <*> waitForProcess p
  unless (st == ExitSuccess) . fail
    $ "git output command failed on: " ++ show args
  pure out

gitCmdFilter :: [String] -> String -> IO String
gitCmdFilter args input = do
  git <- gitProg
  (out, st) <-
    withCreateProcess
      (proc git args) {std_in = CreatePipe, std_out = CreatePipe} $ \(Just ih) (Just oh) _ p ->
      (,)
        <$> (hPutStr ih input >> hClose ih >> hGetContents' oh)
        <*> waitForProcess p
  unless (st == ExitSuccess) . fail
    $ "git filter command failed on: " ++ show args
  pure out

singleLine what = singleObj what . lines

singleObj :: MonadFail m => String -> [a] -> m a
singleObj _ [x] = pure x
singleObj what _ = fail $ "didn't get a single " ++ what

split :: (Char -> Bool) -> String -> [String]
split p [] = []
split p xs = uncurry (:) $ fmap (split p . drop 1) $ break p xs

uniq (x:xs@(y:_))
  | x == y = uniq xs
  | otherwise = x : uniq xs
uniq [x] = [x]
uniq [] = []

data SourceItem
  = SourceFile FilePath
  | SourceRange FilePath Int Int
  deriving (Show)

itemPath (SourceFile p) = p
itemPath (SourceRange p _ _) = p

sourceItems = start . map words
  where
    start (("diff":"--git":(a':'/':path):_):ls) = go (SourceFile path) ls
    start (_:ls) = start ls
    start [] = []
    go f (("diff":"--git":(a':'/':path):_):ls)
      | SourceFile _ <- f = f : go (SourceFile path) ls
      | otherwise = go (SourceFile path) ls
    go f (("@@":('-':inrange):('+':_):"@@":_):ls)
      | [Just a, Just b] <- map readMaybe $ split (== ',') inrange
      , a /= 0
      , b /= 0
      , r <- SourceRange (itemPath f) a b = r : go r ls
    go f (_:ls) = go f ls
    go (SourceFile fp) [] = [SourceFile fp]
    go _ [] = []

blameItem :: FilePath -> SourceItem -> IO [String]
blameItem base (SourceFile path) =
  lines
    <$> gitCmdOutput
          ["log", "-1", "--full-history", "--format=%H", base, "--", path]
blameItem base (SourceRange path r0 r1) =
  concatMap (take 1 . words) . lines
    <$> gitCmdOutput
          [ "annotate"
          , "-l"
          , "-L"
          , show r0 ++ "," ++ show (r0 + r1 - 1)
          , base
          , "--"
          , path
          ]

indepCommits :: [String] -> IO [String]
indepCommits = go []
  where
    batch = 32
    go acc [] = pure acc
    go acc xs =
      gitCmdOutput (["merge-base", "--independent"] ++ acc ++ take batch xs)
        >>= (`go` drop batch xs) . lines

diffToSources :: String -> String -> String -> IO [String]
diffToSources base commit bottom = do
  -- TODO: looks quite like this sometimes selects the head, which is ofc an issue
  out <- lines <$> gitCmdOutput ["diff", "-p", "--no-renames", base, commit]
  bis <-
    fmap (uniq . sort . uniq . concat) . traverse (blameItem base)
      $ sourceItems out
  indepCommits (bottom : bis)

makeEmptyTree :: IO String
makeEmptyTree =
  gitCmdOutput ["hash-object", "-w", "-t", "tree", "--stdin"]
    >>= singleLine "hash-object tree output"

makeEmptyCommit :: IO String
makeEmptyCommit = do
  et <- makeEmptyTree
  let commitObj =
        unlines
          [ "tree " ++ et
          , "author git-deli <git-deli@localhost> 1777294464 +0000"
          , "committer git-deli <git-deli@localhost> 1777294464 +0000"
          , ""
          , "git-deli head commit"
          ]
  ec <-
    gitCmdFilter ["hash-object", "-w", "-t", "commit", "--stdin"] commitObj
      >>= singleLine "empty commit hash"
  pure ec

mergedCommitsTree [] = makeEmptyTree
mergedCommitsTree (c:cs) = go c c cs
  where
    go _ t [] = pure t
    go b t (c1:cs) = do
      b' <- gitCmdOutput ["merge-base", b, c1] >>= singleLine "merge base"
      t' <-
        gitCmdOutput
          [ "merge-tree"
          , "--write-tree"
          , "-Xno-renames"
          , "--merge-base=" ++ b'
          , t
          , c1
          ]
          >>= singleLine "merged tree hash"
      go b' t' cs

delinearize :: String -> String -> String -> IO String
delinearize head commit bottom = do
  parents <- diffToSources head commit bottom
  t <- mergedCommitsTree parents
  git <- gitProg
  -- create a new tree which is essentially commit-head+mergedtree
  t' <-
    gitCmdOutput
      [ "merge-tree"
      , "--write-tree"
      , "-Xno-renames"
      , "--merge-base=" ++ head
      , t
      , commit
      ]
      >>= singleLine "transplanted tree hash"
  -- now let's get all the data from the original commit and change parents
  commitMsg' <- gitCmdOutput ["cat-file", "commit", commit]
  let (msgHead, msgBody) = break null $ lines commitMsg'
      commitMsg =
        unlines
          $ concat
              [ ["tree " ++ t']
              , map ("parent " ++) parents
              , filter
                  (not . flip elem [["parent"], ["tree"]] . take 1 . words)
                  msgHead
              , msgBody
              ]
  -- label the stuff with a proper commit
  commit' <-
    gitCmdFilter ["hash-object", "-w", "-t", "commit", "--stdin"] commitMsg
      >>= singleLine "transplanted commit hash-object"
  -- take the old head
  headMsg' <- gitCmdOutput ["cat-file", "commit", head]
  -- make a new one
  let (hHead, hBody) = break null $ lines headMsg'
      getP ["parent", x] = [x]
      getP _ = []
  hParents <- indepCommits . (commit' :) $ concatMap (getP . words) hHead
  let headMsg =
        unlines
          $ concat
              [ filter ((== ["tree"]) . take 1 . words) msgHead
              , map ("parent " ++) hParents
              , filter
                  (not . flip elem [["parent"], ["tree"]] . take 1 . words)
                  hHead
              , hBody
              ]
  -- write the new head
  hcommit' <-
    gitCmdFilter ["hash-object", "-w", "-t", "commit", "--stdin"] headMsg
      >>= singleLine "new head hash-object"
  pure hcommit'

setGitRef :: String -> String -> IO ()
setGitRef refname tgt = gitCmd ["update-ref", refname, tgt]

main = do
  opts <- parseOpts
  print opts