{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module CLI (runCLI) where

import CLI.Parsers
import CLI.Runners
import CLI.Types
import Control.Exception.Base (SomeException, fromException, handle, throwIO)
import Data.Char (isSpace)
import Data.List (dropWhileEnd)
import Data.Version (showVersion)
import Files (ensuredFile)
import GHC.IO.Exception (IOErrorType (ResourceVanished))
import Logger
import Options.Applicative
import Paths_phino (version)
import System.Exit (ExitCode (..), exitFailure, exitWith)
import System.IO (hPutStrLn, stderr)
import System.IO.Error (ioeGetErrorType)

runCLI :: [String] -> IO ()
runCLI :: [String] -> IO ()
runCLI [String]
args = (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO ()
handler (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let parsed :: ParserResult CliArgs
parsed = ParserPrefs
-> ParserInfo CliArgs -> [String] -> ParserResult CliArgs
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure ParserPrefs
defaultPrefs ParserInfo CliArgs
parserInfo [String]
args
  CliArgs{Maybe Pin
_pin :: Maybe Pin
$sel:_pin:CliArgs :: CliArgs -> Maybe Pin
_pin, Command
_command :: Command
$sel:_command:CliArgs :: CliArgs -> Command
_command} <- case ParserResult CliArgs
parsed of
    Success CliArgs
opts -> CliArgs -> IO CliArgs
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CliArgs
opts
    Failure ParserFailure ParserHelp
failure -> do
      let (String
msg, ExitCode
code) = ParserFailure ParserHelp -> String -> (String, ExitCode)
renderFailure ParserFailure ParserHelp
failure String
"phino"
      case ExitCode
code of
        ExitCode
ExitSuccess -> do
          String -> IO ()
putStrLn String
msg
          ExitCode -> IO CliArgs
forall a. ExitCode -> IO a
exitWith ExitCode
code
        ExitCode
_ -> do
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> String -> String
prefixFirstLine String
"[ERROR]: " String
msg)
          ExitCode -> IO CliArgs
forall a. ExitCode -> IO a
exitWith ExitCode
code
    CompletionInvoked CompletionResult
_ -> ParserResult CliArgs -> IO CliArgs
forall a. ParserResult a -> IO a
handleParseResult ParserResult CliArgs
parsed
  Maybe Pin -> IO ()
checkPin Maybe Pin
_pin
  Command -> IO ()
setLogger Command
_command
  case Command
_command of
    CmdRewrite OptsRewrite
opts -> OptsRewrite -> IO ()
runRewrite OptsRewrite
opts
    CmdDataize OptsDataize
opts -> [String] -> OptsDataize -> IO ()
runDataize [String]
args OptsDataize
opts
    CmdMorph OptsMorph
opts -> [String] -> OptsMorph -> IO ()
runMorph [String]
args OptsMorph
opts
    CmdExplain OptsExplain
opts -> OptsExplain -> IO ()
runExplain OptsExplain
opts
    CmdMerge OptsMerge
opts -> OptsMerge -> IO ()
runMerge OptsMerge
opts
    CmdMatch OptsMatch
opts -> OptsMatch -> IO ()
runMatch OptsMatch
opts
    CmdCompile OptsCompile
opts -> OptsCompile -> IO ()
runCompile OptsCompile
opts
  where
    prefixFirstLine :: String -> String -> String
    prefixFirstLine :: String -> String -> String
prefixFirstLine String
_ String
"" = String
"Failure"
    prefixFirstLine String
prefix String
msg = String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
    handler :: SomeException -> IO ()
    handler :: SomeException -> IO ()
handler SomeException
e = case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
      Just ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just (ExitFailure Int
_) -> IO ()
forall a. IO a
exitFailure
      Maybe ExitCode
_ -> case SomeException -> Maybe IOError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
        Just (IOError
ioe :: IOError) | IOError -> IOErrorType
ioeGetErrorType IOError
ioe IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
ResourceVanished -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
141)
        Maybe IOError
_ -> do
          String -> IO ()
logError (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
          IO ()
forall a. IO a
exitFailure
    setLogger :: Command -> IO ()
    setLogger :: Command -> IO ()
setLogger Command
cmd =
      let (LogLevel
level, Int
lns) = case Command
cmd of
            CmdRewrite OptsRewrite{LogLevel
_logLevel :: LogLevel
$sel:_logLevel:OptsRewrite :: OptsRewrite -> LogLevel
_logLevel, Int
_logLines :: Int
$sel:_logLines:OptsRewrite :: OptsRewrite -> Int
_logLines} -> (LogLevel
_logLevel, Int
_logLines)
            CmdDataize OptsDataize{LogLevel
_logLevel :: LogLevel
$sel:_logLevel:OptsDataize :: OptsDataize -> LogLevel
_logLevel, Int
_logLines :: Int
$sel:_logLines:OptsDataize :: OptsDataize -> Int
_logLines} -> (LogLevel
_logLevel, Int
_logLines)
            CmdMorph OptsMorph{LogLevel
_logLevel :: LogLevel
$sel:_logLevel:OptsMorph :: OptsMorph -> LogLevel
_logLevel, Int
_logLines :: Int
$sel:_logLines:OptsMorph :: OptsMorph -> Int
_logLines} -> (LogLevel
_logLevel, Int
_logLines)
            CmdExplain OptsExplain{LogLevel
_logLevel :: LogLevel
$sel:_logLevel:OptsExplain :: OptsExplain -> LogLevel
_logLevel, Int
_logLines :: Int
$sel:_logLines:OptsExplain :: OptsExplain -> Int
_logLines} -> (LogLevel
_logLevel, Int
_logLines)
            CmdMerge OptsMerge{LogLevel
_logLevel :: LogLevel
$sel:_logLevel:OptsMerge :: OptsMerge -> LogLevel
_logLevel, Int
_logLines :: Int
$sel:_logLines:OptsMerge :: OptsMerge -> Int
_logLines} -> (LogLevel
_logLevel, Int
_logLines)
            CmdMatch OptsMatch{LogLevel
_logLevel :: LogLevel
$sel:_logLevel:OptsMatch :: OptsMatch -> LogLevel
_logLevel, Int
_logLines :: Int
$sel:_logLines:OptsMatch :: OptsMatch -> Int
_logLines} -> (LogLevel
_logLevel, Int
_logLines)
            CmdCompile OptsCompile{LogLevel
_logLevel :: LogLevel
$sel:_logLevel:OptsCompile :: OptsCompile -> LogLevel
_logLevel, Int
_logLines :: Int
$sel:_logLines:OptsCompile :: OptsCompile -> Int
_logLines} -> (LogLevel
_logLevel, Int
_logLines)
       in LogLevel -> Int -> IO ()
setLogConfig LogLevel
level Int
lns
    checkPin :: Maybe Pin -> IO ()
    checkPin :: Maybe Pin -> IO ()
checkPin Maybe Pin
Nothing = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    checkPin (Just (PinFile String
file)) = String -> IO String
ensuredFile String
file IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
readFile IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Pin -> IO ()
checkPin (Maybe Pin -> IO ()) -> (String -> Maybe Pin) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pin -> Maybe Pin
forall a. a -> Maybe a
Just (Pin -> Maybe Pin) -> (String -> Pin) -> String -> Maybe Pin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pin
PinVersion (String -> Pin) -> (String -> String) -> String -> Pin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
    checkPin (Just (PinVersion String
expected))
      | String
expected String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
actual = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = CmdException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> String -> CmdException
VersionMismatch String
expected String
actual)
      where
        actual :: String
actual = Version -> String
showVersion Version
version