Setup.hs

{-# LANGUAGE OverloadedStrings #-}

module Gli.Setup where

import qualified Data.Attoparsec.Text as P
import qualified Data.Map.Strict      as M
import qualified Data.Text            as T
import           Data.Yaml
import           Gli.Gitlab
import           Gli.Types
import           Network.URI
import           System.Process

setupProject :: String -> IO ()
setupProject file = do
  origin <- readProcess "git"
            ["config", "--get", "remote.origin.url"]
            ""
  case P.parseOnly parseGitUrl (T.pack (origin)) of
    Left  msg    -> print msg
    Right gitUrl -> do
      print gitUrl
      cfg <- decodeFile file :: IO (Maybe GliCfg)
      case cfg of
        Nothing -> putStrLn $ mappend "Unable to parse file " (show file)
        Just b  -> if M.null matchedKeyVal
          then putStrLn $ mappend "Unable to find a relevent key for \
                                  \the domain, please check the config \
                                  \file " (show file)
          else do
          project <- getProject
            (T.strip (T.pack origin)) (head $ M.elems $  matchedKeyVal)
          encodeFile localYmlFile (LocalYmlContent
                                   (MasterFileConfig file matchedKey)
                                    project)
          appendFile gitInfoExcludeFile localYmlFile
          where
            matchedKey = head $ M.keys $ matchedKeyVal
            matchedKeyVal = fetchKeyFromAccount (accounts b) (domain gitUrl)

parseGitUrl :: P.Parser GitUrl
parseGitUrl = do
  _ <- P.string "git@"
  d <- P.takeTill (':' ==)
  _ <- P.char ':'
  r <- P.takeTill ('\n' ==)
  return $ GitUrl d r

fetchKeyFromAccount :: Account -> T.Text -> M.Map T.Text AccountConfig
fetchKeyFromAccount a g =
  M.filter (\v -> g == httpDomainConfig(url v)) (accountMap a)

httpDomainConfig :: String -> T.Text
httpDomainConfig u =
  case parseURI u of
    Nothing -> error "Unable to find remote url"
    Just a  -> case uriAuthority a of
      Nothing -> error "Unable to parse the url"
      Just b  -> T.pack $ uriRegName b

accountMap :: Account -> M.Map T.Text AccountConfig
accountMap (Account acc) = acc