{-|
Module      : Main

Copyright   : (c) Henry J. Wylde, 2015
License     : BSD3
Maintainer  : public@hjwylde.com
-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK hide, prune #-}

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

module Main (
    main,
) where

import           Control.Concurrent
import           Control.Monad.Catch    (MonadMask (..))
import           Control.Monad.Except
import           Control.Monad.Extra
import           Control.Monad.Logger
import           Control.Monad.Parallel (MonadParallel (..))
import qualified Control.Monad.Parallel as Parallel
import           Control.Monad.Reader

import           Data.List.Extra    (dropEnd, linesBy, lower)
import           Data.Maybe         (fromJust, fromMaybe, isNothing)
import           Data.Text          (Text)
import qualified Data.Text          as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO       as T
import           Data.Time          (defaultTimeLocale, formatTime, getZonedTime)

import Omnifmt.Config  as Config
import Omnifmt.Exit
import Omnifmt.Options hiding (omnifmt)
import Omnifmt.Pipes

import Options.Applicative

import           Pipes
import           Pipes.Concurrent
import qualified Pipes.Prelude    as Pipes
import           Prelude          hiding (filter, log)

import System.Directory.Extra
import System.FilePath
import System.IO
import System.IO.Temp
import System.Log.FastLogger

instance MonadParallel m => MonadParallel (LoggingT m) where
    bindM2 f ma mb = LoggingT $ \g -> bindM2 (f' g) (runLoggingT ma g) (runLoggingT mb g)
        where
            f' g a b = runLoggingT (f a b) g

main :: IO ()
main = do
    options     <- customExecParser omnifmtPrefs omnifmtInfo
    let chatty  = if optMode options == Diff then Quiet else optChatty options

    flip runLoggingT (log $ optChatty options) . filter chatty $ do
        mFilePath <- Config.nearestConfigFile "."
        when (isNothing mFilePath) . panic_ $ Config.defaultFileName ++ ": not found"

        mConfig <- Config.readConfig $ fromJust mFilePath
        when (isNothing mConfig) . panic_ $ fromJust mFilePath ++ ": error"

        runReaderT (handle options) (fromJust mConfig)

handle :: (MonadIO m, MonadLogger m, MonadMask m, MonadParallel m, MonadReader Config m) => Options -> m ()
handle options = do
    rootDir         <- liftIO getCurrentDirectory
    filePaths       <- runPanic $ if null (argPaths options)
        then ask >>= expandDirectory . takeDirectory . fromJust . source
        else providedFilePaths options
    absFilePaths    <- forM filePaths $ \filePath -> ifM (liftIO $ doesFileExist filePath)
        (liftIO $ canonicalizePath filePath) (return filePath)

    numThreads <- liftIO getNumCapabilities >>= \numCapabilities ->
        return $ fromMaybe numCapabilities (optThreads options)

    (output, input) <- liftIO $ spawn unbounded

    withSystemTempDirectory "omnifmt" $ \tmpDir -> do
        runEffect $ each (map (\filePath -> omnifmt (makeRelative rootDir filePath) (tmpDir </> dropDrive filePath)) absFilePaths) >-> toOutput output

        liftIO performGC

        Parallel.forM_ [1..numThreads] $ \_ ->
            runEffect (fromInput input >-> pipeline >-> runner (optMode options)) >>
            liftIO performGC

providedFilePaths :: MonadIO m => Options -> m [FilePath]
providedFilePaths options = concatMapM expandDirectory $ concatMap splitter (argPaths options)
    where
        splitter = if optNull options then linesBy (== '\0') else (:[])

expandDirectory :: MonadIO m => FilePath -> m [FilePath]
expandDirectory path = ifM (liftIO $ doesDirectoryExist path) (liftIO $ listFilesRecursive path) (return [path])

pipeline :: (MonadIO m, MonadLogger m, MonadReader Config m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
pipeline = checkFileSupported >-> checkFileExists >-> createPrettyFile >-> runProgram >-> checkFilePretty
    where
        createPrettyFile = select [Unknown] $ \item@(_, _, prettyFilePath) -> do
            liftIO $ createDirectoryIfMissing True (takeDirectory prettyFilePath)

            return item

runner :: (MonadIO m, MonadLogger m) => Mode -> Consumer (Status, FilePath, FilePath) m ()
runner Normal   = commit    >-> printFileStatus logFunction >-> Pipes.drain
runner DryRun   = cat       >-> printFileStatus logFunction >-> Pipes.drain
runner Diff     = diff      >-> Pipes.drain

logFunction :: MonadLogger m => Status -> Text -> m ()
logFunction status
    | status `elem` [Unknown, Error, Timeout]       = logWarnN
    | status `elem` [Unsupported, NotFound, Pretty] = logDebugN
    | otherwise                                     = logInfoN

filter :: Chatty -> LoggingT m a -> LoggingT m a
filter Quiet    = filterLogger (\_ level -> level >= LevelError)
filter Default  = filterLogger (\_ level -> level >= LevelInfo)
filter Verbose  = filterLogger (\_ level -> level >= LevelDebug)

log :: Chatty -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
log chatty _ _ level msg = do
    timestamp <- formatTime defaultTimeLocale "%F %T.%q" <$> getZonedTime

    forM_ (T.lines . T.decodeUtf8 $ fromLogStr msg) $ \line ->
        T.hPutStrLn h $ if chatty == Verbose
            then T.unwords [T.pack $ "[" ++ dropEnd 6 timestamp ++ "]", formattedLevel, line]
            else line
    where
        h               = if level == LevelError then stderr else stdout
        formattedLevel  = T.justifyLeft 6 ' ' . T.drop 5 . T.pack . lower $ show level