{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module ItCli where

import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Writer
import Data.Char (isLetter, isDigit)
import Data.Data (Proxy(..))
import Data.ItCli
import Data.Yaml
import Data.List (isPrefixOf)
import Data.Time (getCurrentTime)
import Data.UUID.V4 (nextRandom)
import Data.Maybe (catMaybes)
import File
import System.Directory
import System.FilePath
import Text.Read (readEither)
import qualified Data.UUID as UUID

class ItCliNew a where
  type NewParams a
  makeNew :: NewParams a -> ItCliM a

class ItCliPath a where
  makePath :: Proxy a -> FilePath -> FilePath

instance ItCliNew IssueMeta where
  type NewParams IssueMeta = IssueTitle
  makeNew desc = do
    date <- liftIO $ getCurrentTime
    return $ IssueMeta
      { _issueTitle = desc
      , _issueClosed = False
      , _issueDate = date
      }

instance ItCliPath IssueMeta where
  makePath _ = (</> "meta")

instance ItCliNew Comment where
  type NewParams Comment = CommentMessage
  makeNew msg = do 
    name <- asks _itCliName
    date <- liftIO $ getCurrentTime
    return $ Comment
      { _commentDate = date
      , _commentName = name
      , _commentMessage = msg
      }
    where

instance ItCliPath Comments where
  makePath _ = (</> "comments")

instance ItCliPath Comment where
  makePath _ = makePath (Proxy :: Proxy Comments)

runItCliM :: ItCliM a -> IO (Either String a, Logs)
runItCliM x = runWriterT . runExceptT $ readConfig >>= runReaderT x

makeIssueClosed :: IssueMeta -> IssueMeta
makeIssueClosed meta = meta { _issueClosed = True }

getItCliDir :: IO FilePath
getItCliDir = (</> ".itcli") <$> getCurrentDirectory

getConfigPath :: IO FilePath
getConfigPath =  (</> "config") <$> getItCliDir

getIssueBaseDir :: IssueId -> ItCliM FilePath
getIssueBaseDir iid = liftIO $ (</> (UUID.toString iid)) <$> getItCliDir

copyFileToIssue :: IssueId -> FilePath -> ItCliM ()
copyFileToIssue iid fp = do
  issueFp <- (</> (takeFileName fp)) <$> getIssueBaseDir iid
  fileExists <- liftIO $ doesFileExist issueFp
  liftIO $ when (not fileExists) $ copyFile fp issueFp
  tell ["Copied " ++ fp ++ " to " ++ issueFp]

writeItCli :: (ItCliPath a, ToJSON a) => IssueId -> a -> ItCliM ()
writeItCli iid x = do
  d <- (makePath $ makeProxy x) <$> getIssueBaseDir iid 
  liftIO $ createDirectoryIfMissing False (takeDirectory d)
  liftIO $ encodeFile d x
  where
    makeProxy :: a -> Proxy a
    makeProxy _ = Proxy

getFromFile :: (FromJSON a) => FilePath -> ItCliM a
getFromFile = liftIO . decodeFileEither >=> liftEither . mapError
  where
    mapError (Left e) = Left $ prettyPrintParseException e
    mapError (Right a) = Right a
  

readItCli :: (FromJSON a, ItCliPath a) => IssueId -> ItCliM a
readItCli iid = getIssueBaseDir iid >>= getFile Proxy
  where
    getFile :: (FromJSON a, ItCliPath a) => Proxy a -> FilePath -> ItCliM a 
    getFile p = getFromFile . makePath p

makeIssuePath :: FilePath -> FilePath -> FilePath
makeIssuePath bp = (bp </>) . makePath (Proxy :: Proxy IssueMeta) 

listIssueIds :: ItCliM [IssueId]
listIssueIds = do
  liftIO getItCliDir >>= \bd ->
    (liftIO . listDirectory $ bd) >>= 
      liftIO . filterM (doesFileExist . makeIssuePath bd) >>=
        return . catMaybes . fmap UUID.fromString

getIssueIdFromArg :: IssueIdArg -> ItCliM IssueId
getIssueIdFromArg iidarg = do 
  listIssueIds >>= 
    pickId . filter (isPrefixOf iidarg . UUID.toString)
  where
    pickId [] = throwError $ "There are no issues with id: " ++ iidarg
    pickId (x:[]) = return x
    pickId (x:xs) = throwError $ "There are multiple issues that start with id: " ++ iidarg

openIssue :: IssueTitle -> ItCliM IssueId
openIssue title = do  
  iid <- liftIO nextRandom
  meta <- makeNew title
  writeItCli iid (meta :: IssueMeta)
  writeItCli iid (Comments [])
  tell ["Issue created: " ++ (display iid)]
  return iid

closeIssue :: IssueIdArg -> ItCliM ()
closeIssue iidarg = do 
  iid <- getIssueIdFromArg iidarg
  writeItCli iid =<< makeIssueClosed <$> readItCli iid
  tell ["Closed issue: " ++ (display iid)]

readConfig :: (MonadError String m, MonadIO m) => m Config
readConfig = liftIO getConfigPath >>= liftIO . readFile >>= liftEither . readEither

writeConfig :: Config -> IO ()
writeConfig x = getConfigPath >>= flip writeFile (show x)

initItCliDir :: IO ()
initItCliDir = do
  getItCliDir >>= createDirectoryIfMissing False
  writeConfig $ Config "unknown"
  putStrLn "initialied new itcli repo in .itcli"

listIssue :: IssueId -> IssueMeta -> ItCliM ()
listIssue iid meta = 
  tell . (:[]) $
    (display iid)
    ++ " " ++ (display $ _issueClosed meta)
    ++ " " ++ (_issueTitle meta)

filterArgsToFilter :: ListFilterArgs -> [(IssueId, IssueMeta)] -> [(IssueId, IssueMeta)]
filterArgsToFilter Nothing = id
filterArgsToFilter (Just True) = filter $ _issueClosed . snd
filterArgsToFilter (Just False) = filter $ not . _issueClosed . snd

listIssues :: ListFilterArgs -> ItCliM ()
listIssues args = listIssueIds >>= showIs
  where
    showIs [] = tell ["There are no issues yet.\nUse \"itcli open\" to create a new one"]
    showIs x@(_:_) = 
      mapM getIssue x >>= 
        mapM_ (uncurry listIssue) . filterArgsToFilter args
    getIssue iid = readItCli iid >>= \a -> return (iid, a)

copyFileAttchmentMessage :: IssueId -> CommentMessage -> ItCliM ()
copyFileAttchmentMessage _ (CommentMessage _) = return ()
copyFileAttchmentMessage iid (FileAttachment fp) = copyFileToIssue iid fp

addComment :: IssueIdArg -> CommentMessage -> ItCliM ()
addComment iidarg msg = do
  iid <- getIssueIdFromArg iidarg
  newComment <- makeNew msg :: ItCliM Comment
  currentComments <- readItCli iid :: ItCliM Comments
  copyFileAttchmentMessage iid msg
  writeItCli iid . Comments . (newComment:) . fromComments $ currentComments

showIssue :: IssueIdArg -> ItCliM ()
showIssue iidarg = do 
  iid <- getIssueIdFromArg iidarg
  readItCli iid >>= tell . (:[]) . printMeta 
  tell [""]
  readItCli iid >>= tell . (:[]) . printComments

makeBranchName :: IssueIdArg -> ItCliM String
makeBranchName = 
  getIssueIdFromArg >=> \iid -> 
    readItCli iid >>=
      return . makeBranchName iid . _issueTitle
  where
    makeBranchName iid = (++ display iid) . getBranchName . words
    getBranchName [] = ""
    getBranchName (x:xs) = filter isValidChar $ x ++ "-"
    isValidChar c =
      isLetter c
      || isDigit c
      || (c == '-')

makeCommitMessage :: IssueIdArg -> ItCliM String
makeCommitMessage = 
  getIssueIdFromArg >=> \iid ->
    readItCli iid >>=
      return . makeCommitMessage iid
  where
    makeCommitMessage iid meta =
      "fixes " 
      ++ (display iid)
      ++ " - " ++ (_issueTitle meta)