{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Textphile.CLI.Utils where

import Control.Applicative (Applicative(..), Alternative(..))
import Control.Arrow (left)
import Control.Monad (Monad(..), forM_, when)
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Trans.Reader (Reader, runReader)
import Data.Bool
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Foldable (Foldable)
import Data.Function (($), (.), id)
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..), maybe)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Typeable (Typeable)
import Prelude (min, max, (-))
import Symantic.CLI as CLI
import System.IO (IO)
import Text.Show (Show(..))
import qualified Control.Monad.Classes as MC
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as BSL8
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Data.Text.Encoding as T
import qualified Symantic.Document as Doc
import qualified System.Console.Terminal.Size as Console
import qualified System.Directory as IO
import qualified System.FilePath as FP
import qualified System.IO as IO
import qualified System.Posix as Posix
import qualified Data.Version as Version
import qualified Paths_textphile as Textphile

import Data.Locale
import Textphile.CLI.Lang

progname :: Text
progname = "textphile"

version :: Text
version =
	progname <> "-" <>
	Text.pack (Version.showVersion Textphile.version)

api_help full =
	if full
	then
		api_compact <.> response @Doc <!>
		api_full    <.> response @Doc
	else
		(api_compact <!> api_full) <.> response @Doc
	where
	api_compact =
		(if full then helps l10n_help_opt_help_compact else id) $
		tag "h" (just False)
	api_full =
		(if full then helps l10n_help_opt_help_full else id) $
		tag "help" (just True)

run_help lay = route :!: route
	where
	route helpInh_full = do
		width <- Just . maybe 80 (min 80 . max 0 . (\x -> x - 2) . Console.width)
		 <$> Console.size
		return $
			Doc.setWidth width $
				runLayout helpInh_full lay

-- * Type 'Cfg_Global'
data Cfg_Global
 =   Cfg_Global
 {   cfg_global_stderr_prepend_newline  :: Bool
 ,   cfg_global_stderr_prepend_carriage :: Bool
 ,   cfg_global_stderr_append_newline   :: Bool
 ,   cfg_global_verbosity :: Verbosity
 ,   cfg_global_lang      :: Lang
 }

api_options =
	rule "OPTIONS" $
		Cfg_Global False False True
		 <$> api_param_verbosity
		 <*> api_param_lang
api_param_lang =
	(\v -> Map.findWithDefault
	 (LocaleIn @Langs en_US)
	 (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
	 (locales @Langs)) <$>
	toPermDefault "en_US" (env "LANG")

-- * Type 'Verbosity'
data Verbosity
 =   Verbosity_Error
 |   Verbosity_Warning
 |   Verbosity_Info
 |   Verbosity_Debug
 deriving (Eq,Ord)

instance IOType Verbosity
instance FromSegment Verbosity where
	fromSegment = \case
	 "error"   -> return $ Right Verbosity_Error
	 "warning" -> return $ Right Verbosity_Warning
	 "info"    -> return $ Right Verbosity_Info
	 "debug"   -> return $ Right Verbosity_Debug
	 _ -> return $ Left "invalid verbosity"

api_param_verbosity =
	helps l10n_help_opt_verbosity $
	toPermDefault Verbosity_Info $
		tag "verbosity" (
			constant "error"   Verbosity_Error   `alt`
			constant "warning" Verbosity_Warning `alt`
			constant "info"    Verbosity_Info    `alt`
			constant "debug"   Verbosity_Debug
		 ) `alt`
		env "TEXTPHILE_VERBOSITY"

outputMessage :: MC.MonadExec IO m => Cfg_Global -> Doc -> Doc -> m ()
outputMessage Cfg_Global{..} hdr msg =
	MC.exec @IO $ output $ OnHandle IO.stderr $ (`runReader` loqualize cfg_global_lang) $
		(if cfg_global_stderr_prepend_newline then Doc.newline else mempty) <>
		(if cfg_global_stderr_prepend_carriage then "\r" else mempty) <>
		hdr<>": "<>msg<>
		(if cfg_global_stderr_append_newline then Doc.newline else mempty)

outputError :: MC.MonadExec IO m => Cfg_Global -> Doc -> MaybeT m a
outputError cfg_global@Cfg_Global{..} msg = do
	when (Verbosity_Error <= cfg_global_verbosity) $ do
		outputMessage cfg_global (Doc.redder "ERROR") msg
	empty

outputWarning :: MC.MonadExec IO m => Cfg_Global -> Doc -> m ()
outputWarning cfg_global@Cfg_Global{..} msg = do
	when (Verbosity_Warning <= cfg_global_verbosity) $ do
		outputMessage cfg_global (Doc.yellower "WARNING") msg

outputInfo :: MC.MonadExec IO m => Cfg_Global -> Doc -> m ()
outputInfo cfg_global@Cfg_Global{..} msg = do
	when (Verbosity_Info <= cfg_global_verbosity) $ do
		outputMessage cfg_global (Doc.greener "info") msg

outputDebug :: MC.MonadExec IO m => Cfg_Global -> Doc -> m ()
outputDebug cfg_global@Cfg_Global{..} msg = do
	when (Verbosity_Debug <= cfg_global_verbosity) $ do
		outputMessage cfg_global (Doc.magentaer "debug") msg