Git.hs

module Craft.Git where

import           Control.Lens           hiding (noneOf)
import           Formatting             hiding (char)
import           Text.Megaparsec
import           Text.Megaparsec.String

import           Craft                  hiding (Version (..))
import qualified Craft.Directory        as Dir


type BranchName = String
type TagName    = String
type SHA        = String


data Version
  = Branch BranchName
  | Latest BranchName
  | Tag    TagName
  | Commit SHA
 deriving (Eq)


instance Show Version where
  show (Branch name) = name
  show (Latest name) = name
  show (Tag    name) = "tags/" ++ name
  show (Commit sha)  = sha


origin :: String
origin = "origin"


type URL = String


data Repo
  = Repo
    { _gitUrl       :: URL
    , _gitDirectory :: Directory
    , _gitVersion   :: Version
    , _gitDepth     :: Maybe Int
    }
  deriving (Eq, Show)
makeLenses ''Repo


repo :: URL -> Path Abs Dir -> Repo
repo url' dirpath =
  Repo
  { _gitUrl       = url'
  , _gitDirectory = directory dirpath
  , _gitVersion   = Latest "master"
  , _gitDepth     = Nothing
  }


gitBin :: String
gitBin = "git"


git :: String -> [String] -> Craft ()
git cmd args = exec_ gitBin $ cmd : args


remotes :: Craft [String]
remotes = lines <$> ($stdoutOrError =<< exec gitBin ["remote"])


setURL :: URL -> Craft ()
setURL url' = do
  rs <- remotes
  if origin `elem` rs then
    git "remote" ["set-url", origin, url']
  else
    git "remote" ["add", origin, url']


getURL :: Craft URL
getURL = do
  results <- parseExecStdout repoURLParser gitBin ["remote", "-v"]
  case lookup (origin, "fetch") results of
    Nothing -> $craftError $ "git remote `" ++ origin ++ "` not found."
    Just x  -> return x


-- TESTME
repoURLParser :: Parser [((String, String), String)]
repoURLParser = some $ do
  remote <- word
  url' <- word
  direction <- char '(' *> some alphaNumChar <* char ')' <* newline
  return ((remote, direction), url')
 where
  word :: Parser String
  word = some (noneOf " \t") <* some (spaceChar <|> tab)


getVersion :: Craft Version
getVersion = Commit <$> parseExecStdout (some alphaNumChar) gitBin ["rev-parse", "HEAD"]


get :: Path Abs Dir -> Craft (Maybe Repo)
get dp =
  Dir.get dp >>= \case
    Nothing -> return Nothing
    Just dir -> withCWD dir $ do
      !url'     <- getURL
      !version' <- getVersion
      return . Just
             $ Repo { _gitDirectory = dir
                    , _gitUrl       = url'
                    , _gitVersion   = version'
                    , _gitDepth     = Nothing
                    }


instance Craftable Repo Repo where
  watchCraft r = do
    let dp = r ^. gitDirectory . path
        ver = r ^. gitVersion
        verify ver' =
          case ver of
            Commit _ ->
              when (ver' /= ver) $
                $craftError
                $ formatToString ("craft Git.Repo `"%shown%"` failed! Wrong Commit: "%shown%" Got: "%shown)
                                 r ver ver'
            _ -> return ()
        checkoutCommit :: Craft Version
        checkoutCommit = do
          setURL $ r ^. gitUrl
          git "fetch" [origin]
          git "checkout" ["--force", show ver]
          git "reset" ["--hard"]
          ver' <- getVersion
          verify ver'
          return ver'

    Dir.get dp >>= \case
      Nothing -> do
        case r ^. gitDepth of
          Nothing -> git "clone" [r ^. gitUrl, fromAbsDir dp]
          Just d  -> git "clone" ["--depth", show d, r ^. gitUrl, fromAbsDir dp]
        Dir.get dp >>= \case
          Nothing -> $craftError $ "craft Git.Repo `"++show r++"` failed! "
                                ++ "Clone Failed. Directory `"++show dp++"` not found."
          Just dir -> do
            craft_ $ r ^. gitDirectory
            withCWD dir $ do
              ver' <- checkoutCommit
              return (Created, r & gitVersion .~ ver' )

      Just dir -> do
        craft_ $ r ^. gitDirectory
        withCWD dir $ do
          !beforeVersion <- getVersion
          ver' <- checkoutCommit
          case ver of
            Latest branchName -> git "pull" [origin, branchName]
            _                 -> return ()
          return ( if beforeVersion == ver' then Unchanged else Updated
                 , r & gitVersion .~ ver')