-- This file is part of khph.
--
-- Copyright 2016 Bryan Gardiner <bog@khumba.net>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE CPP #-}

module Main (main) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad ((<=<), forM_, unless)
import Control.Monad.IO.Class (liftIO)
import Data.Either (partitionEithers)
import Data.List (intercalate, isSuffixOf)
import Data.Maybe (catMaybes, isNothing)
import qualified Data.Set as Set
import qualified Khph.Args as Args
import Khph.Project.Base
import qualified Khph.Project.Impl as ProjectImpl
import Khph.Project.Monad
import Khph.Query.Base
import Khph.Query.Parse
import Khph.Util
import System.Directory (
  canonicalizePath,
  getCurrentDirectory,
  getDirectoryContents,
  )
import System.Exit (exitFailure)
import System.FilePath (
  (</>),
  pathSeparator,
  replaceBaseName,
  takeBaseName,
  takeDirectory,
  takeFileName,
  )
import System.IO (hPutStrLn, stderr)
import System.Posix.Files (getFileStatus, isDirectory, isRegularFile)

main :: IO ()
main = do
  flagsResult <- Args.parseFlags
  case flagsResult of
    Left err -> do
      hPutStrLn stderr $ "khph: " ++ err
      exitFailure
    Right (commonArgs, maybeRequest) -> do
      initialDirectory <- canonicalizePath =<< getCurrentDirectory

      -- Find a project file to use.
      (projectRoot, maybeProjectFile) <- case Args.caProject commonArgs of
        "" -> do
          result <- findProjectFile True initialDirectory
          case result of
            Nothing -> die "Couldn't find a project."
            Just path -> return (takeDirectory path, Just $ takeFileName path)
        pathRaw -> do
          path <- canonicalizePath pathRaw
          stat <- getFileStatus path
          case undefined of
            _ | isRegularFile stat ->
              return (takeDirectory path, Just $ takeFileName path)
            _ | isDirectory stat -> do
              maybeProjectFile <- findProjectFile False path
              return (path, maybeProjectFile)
            _ -> die $ concat
                 ["--project expects a regular file or directory.  Got ", show path, "."]

      ProjectImpl.run commonArgs projectRoot maybeProjectFile $ do
        request <- case maybeRequest of
          Just request -> return request
          Nothing -> liftIO $ do
            putStr $ unlines
              [ "khph: " ++ Args.description
              , "See --help for more information."
              ]
            exitFailure

        case request of
          Args.Help ->
            -- Printing the help message is handled by the argument parser.
            return ()

          Args.List {Args.listQuery = queryStrMaybe} -> do
            query <- case queryStrMaybe of
              Nothing -> return LogicTrue
              Just queryStr -> parseQueryOrDie queryStr
            printSummary $ "Query: " ++ show query

            entries <- queryEntries query
            forM_ entries $ \entry -> do
              hardLinks <- entryHardLinks entry
              links <- if not $ null hardLinks
                       then return hardLinks
                       else entrySoftLinks entry
              path <- case links of
                [] -> projectDie $ concat
                      ["list: Internal error, should have links for ", show entry, " but don't."]
                link:_ -> return link
              liftIO . putStrLn =<< pathRealize path

            let entryCount = length entries
            printSummary $ concat
              ["Found ", show entryCount, if entryCount == 1 then " entry." else " entries."]

          Args.TagList {Args.tagListSpec = entrySpecStrMaybe} -> do
            tags <- case entrySpecStrMaybe of
              Nothing -> Set.toList <$> tagList
              Just entrySpecStr -> tagLookup =<< parseEntrySpecOrDie entrySpecStr
            forM_ tags $ liftIO . putStrLn . tagToRelativePath

          Args.TagCreate {Args.tags = tagStrs} ->
            forM_ tagStrs $ tagCreate <=< parseEntrySpecOrDie

          Args.TagAdd { Args.files = files
                      , Args.tags = tagStrs
                      } -> do
            projectPaths <- parsePathsOrDie files
            entries <- findEntriesOrDie projectPaths
            tags <- findTagsOrDie tagStrs
            tagAdd entries tags

          Args.TagRemove { Args.files = files
                         , Args.tags = tagStrs
                         } -> do
            projectPaths <- parsePathsOrDie files
            entries <- findEntriesOrDie projectPaths
            tags <- findTagsOrDie tagStrs
            tagRemove entries tags

          Args.Realize { Args.tag = tagStr
                       , Args.query = queryStr
                       , Args.tagsInName = tagsInName
                       } -> do
            -- Parse inputs.
            entrySpec <- parseEntrySpecOrDie tagStr
            query <- parseQueryOrDie queryStr

            -- Look up (or create) the tag, and remove the tag's existing
            -- association with all entries.  If you're realizing a query for
            -- entries with a tag, you don't want the target tag contributing to
            -- that!
            (tag, tagIsNew) <- tagCreate entrySpec
            unless tagIsNew $ do
              entriesOld <- queryEntries $ LogicQuery $ QueryTag $ Some $ LogicQuery $ TreeAt tag
              tagRemove entriesOld [tag]

            entriesNew <- queryEntries query
            forM_ entriesNew $ \entry -> do
              etags <- entryTags entry
              sourcePath <- maybe (projectDie $ concat
                                   ["realize: ", show entry, " should have a source path."])
                                  return =<<
                            entrySourcePath entry

              -- If requested, then we add tags into link file names.
              let linkFileName = if tagsInName
                                 then Just $ replaceBaseName targetFileName newBaseName
                                 else Nothing
                  -- The following are only used when tagsInName is true.
                  renderedTags =
                    map (map (\c -> if c == pathSeparator then '-' else c) .
                         tagToRelativePath) etags
                  targetFileName = takeFileName $ projectPathToRelativePath sourcePath
                  newBaseName = intercalate " " $ takeBaseName targetFileName : renderedTags

              tagAdd1 entry tag linkFileName

            let entryCount = length entriesNew
            printSummary $ concat
              ["Found ", show entryCount, if entryCount == 1 then " entry." else " entries."]

          _ -> projectDie "khph: Unimplemented command."

findProjectFile :: Bool -> FilePath -> IO (Maybe FilePath)
findProjectFile recur startingDirectory = do
  contents <- getDirectoryContents startingDirectory
  let projectFiles = filter (".khph" `isSuffixOf`) contents
  case projectFiles of
    projectFile:_ -> return $ Just $ startingDirectory </> projectFile
    [] -> if recur
          then let parent = takeDirectory startingDirectory
               in if parent == startingDirectory
                  then return Nothing
                  else findProjectFile recur parent
          else return Nothing

parsePathsOrDie :: MonadProject m => [FilePath] -> m [ProjectPath]
parsePathsOrDie pathStrs = do
  (errors, projectPaths) <- partitionEithers <$> mapM parseRealPath pathStrs
  if null errors
    then return projectPaths
    else projectDie $ concat $
         "parsePathsOrDie: Couldn't parse some paths: " : map ("\n- " ++) errors

findEntriesOrDie :: MonadProject m => [ProjectPath] -> m [Entry m]
findEntriesOrDie projectPaths = do
  entriesResult <- mapM (\p -> (,) p <$> entryAtPath p) projectPaths
  case filter (isNothing . snd) entriesResult of
    [] -> return $ catMaybes $ map snd entriesResult
    xs -> projectDie $ concat $
          "findEntriesOrDie: Couldn't find some entries: " :
          map (("\n- " ++) . projectPathToRelativePath . fst) xs

findTagsOrDie :: MonadProject m => [String] -> m [Tag]
findTagsOrDie = mapM $ tagLookup1 "main" <=< parseEntrySpecOrDie

parseEntrySpecOrDie :: MonadProject m => String -> m EntrySpec
parseEntrySpecOrDie specStr = case toEntrySpec specStr of
  Left err ->
    projectDie $ concat
    ["parseEntrySpecOrDie: Couldn't parse EntrySpec from ", show specStr, ": ", err]
  Right entrySpec -> return entrySpec

parseQueryOrDie :: MonadProject m => String -> m Query
parseQueryOrDie queryStr = do
  queryResult <- parseQuery queryStr
  case queryResult of
    Left err ->
      projectDie $ concat
      ["parseQueryOrDie: Error parsing query from ", show queryStr, ": ", err]
    Right query -> return query