module HsDev.Tools.Base (
	runTool, runTool_,
	Result, ToolM,
	runWait, runWait_,
	tool, tool_,
	matchRx, splitRx, replaceRx,
	at, at_,

	module HsDev.Tools.Types
	) where

import Control.Monad.Except
import Data.Array (assocs)
import Data.List (unfoldr, intercalate)
import Data.Maybe (fromMaybe)
import Data.String
import System.Exit
import System.Process
import Text.Regex.PCRE ((=~), MatchResult(..))

import HsDev.Error
import HsDev.Tools.Types
import HsDev.Util (liftIOErrors)

-- | Run tool, throwing HsDevError on fail
runTool :: FilePath -> [String] -> String -> IO String
runTool :: FilePath -> [FilePath] -> FilePath -> IO FilePath
runTool FilePath
name [FilePath]
args FilePath
input = (FilePath -> HsDevError) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a.
MonadCatch m =>
(FilePath -> HsDevError) -> m a -> m a
hsdevLiftIOWith FilePath -> HsDevError
onIOError (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ do
	(ExitCode
code, FilePath
out, FilePath
err) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
name [FilePath]
args FilePath
input
	case ExitCode
code of
		ExitFailure Int
ecode -> HsDevError -> IO FilePath
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> IO FilePath) -> HsDevError -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> HsDevError
ToolError FilePath
name (FilePath -> HsDevError) -> FilePath -> HsDevError
forall a b. (a -> b) -> a -> b
$
			FilePath
"exited with code " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ecode FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
		ExitCode
ExitSuccess -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
out
	where
		onIOError :: FilePath -> HsDevError
onIOError FilePath
s = FilePath -> FilePath -> HsDevError
ToolError FilePath
name (FilePath -> HsDevError) -> FilePath -> HsDevError
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [
			FilePath
"args: [" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " [FilePath]
args FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"]",
			FilePath
"stdin: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
input,
			FilePath
"error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s]

-- | Run tool with not stdin
runTool_ :: FilePath -> [String] -> IO String
runTool_ :: FilePath -> [FilePath] -> IO FilePath
runTool_ FilePath
name [FilePath]
args = FilePath -> [FilePath] -> FilePath -> IO FilePath
runTool FilePath
name [FilePath]
args FilePath
""

type Result = Either String String
type ToolM a = ExceptT String IO a

-- | Run command and wait for result
runWait :: FilePath -> [String] -> String -> IO Result
runWait :: FilePath -> [FilePath] -> FilePath -> IO Result
runWait FilePath
name [FilePath]
args FilePath
input = do
	(ExitCode
code, FilePath
out, FilePath
err) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
name [FilePath]
args FilePath
input
	Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
out) then FilePath -> Result
forall a b. b -> Either a b
Right FilePath
out else FilePath -> Result
forall a b. a -> Either a b
Left FilePath
err

-- | Run command with no input
runWait_ :: FilePath -> [String] -> IO Result
runWait_ :: FilePath -> [FilePath] -> IO Result
runWait_ FilePath
name [FilePath]
args = FilePath -> [FilePath] -> FilePath -> IO Result
runWait FilePath
name [FilePath]
args FilePath
""

-- | Tool
tool :: FilePath -> [String] -> String -> ToolM String
tool :: FilePath -> [FilePath] -> FilePath -> ToolM FilePath
tool FilePath
name [FilePath]
args FilePath
input = ToolM FilePath -> ToolM FilePath
forall (m :: * -> *) a.
MonadCatch m =>
ExceptT FilePath m a -> ExceptT FilePath m a
liftIOErrors (ToolM FilePath -> ToolM FilePath)
-> ToolM FilePath -> ToolM FilePath
forall a b. (a -> b) -> a -> b
$ IO Result -> ToolM FilePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO Result -> ToolM FilePath) -> IO Result -> ToolM FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath -> IO Result
runWait FilePath
name [FilePath]
args FilePath
input

-- | Tool with no input
tool_ :: FilePath -> [String] -> ToolM String
tool_ :: FilePath -> [FilePath] -> ToolM FilePath
tool_ FilePath
name [FilePath]
args = FilePath -> [FilePath] -> FilePath -> ToolM FilePath
tool FilePath
name [FilePath]
args FilePath
""

matchRx :: String -> String -> Maybe (Int -> Maybe String)
matchRx :: FilePath -> FilePath -> Maybe (Int -> Maybe FilePath)
matchRx FilePath
pat FilePath
str = if Bool
matched then (Int -> Maybe FilePath) -> Maybe (Int -> Maybe FilePath)
forall a. a -> Maybe a
Just Int -> Maybe FilePath
look else Maybe (Int -> Maybe FilePath)
forall a. Maybe a
Nothing where
	m :: MatchResult String
	m :: MatchResult FilePath
m = FilePath
str FilePath -> FilePath -> MatchResult FilePath
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
pat
	matched :: Bool
matched = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ MatchResult FilePath -> FilePath
forall a. MatchResult a -> a
mrMatch MatchResult FilePath
m
	groups :: [(Int, FilePath)]
groups = ((Int, FilePath) -> Bool) -> [(Int, FilePath)] -> [(Int, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Int, FilePath) -> Bool) -> (Int, FilePath) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool)
-> ((Int, FilePath) -> FilePath) -> (Int, FilePath) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) ([(Int, FilePath)] -> [(Int, FilePath)])
-> [(Int, FilePath)] -> [(Int, FilePath)]
forall a b. (a -> b) -> a -> b
$ Array Int FilePath -> [(Int, FilePath)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs (Array Int FilePath -> [(Int, FilePath)])
-> Array Int FilePath -> [(Int, FilePath)]
forall a b. (a -> b) -> a -> b
$ MatchResult FilePath -> Array Int FilePath
forall a. MatchResult a -> Array Int a
mrSubs MatchResult FilePath
m
	look :: Int -> Maybe FilePath
look Int
i = Int -> [(Int, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, FilePath)]
groups

splitRx :: String -> String -> [String]
splitRx :: FilePath -> FilePath -> [FilePath]
splitRx FilePath
pat = (Maybe FilePath -> Maybe (FilePath, Maybe FilePath))
-> Maybe FilePath -> [FilePath]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Maybe FilePath -> Maybe (FilePath, Maybe FilePath)
split' (Maybe FilePath -> [FilePath])
-> (FilePath -> Maybe FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just where
	split' :: Maybe String -> Maybe (String, Maybe String)
	split' :: Maybe FilePath -> Maybe (FilePath, Maybe FilePath)
split' Maybe FilePath
Nothing = Maybe (FilePath, Maybe FilePath)
forall a. Maybe a
Nothing
	split' (Just FilePath
str) = case FilePath
str FilePath -> FilePath -> (FilePath, FilePath, FilePath)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
pat of
		(FilePath
pre, FilePath
"", FilePath
"") -> (FilePath, Maybe FilePath) -> Maybe (FilePath, Maybe FilePath)
forall a. a -> Maybe a
Just (FilePath
pre, Maybe FilePath
forall a. Maybe a
Nothing)
		(FilePath
pre, FilePath
_, FilePath
post) -> (FilePath, Maybe FilePath) -> Maybe (FilePath, Maybe FilePath)
forall a. a -> Maybe a
Just (FilePath
pre, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
post)

replaceRx :: String -> String -> String -> String
replaceRx :: FilePath -> FilePath -> FilePath -> FilePath
replaceRx FilePath
pat FilePath
w = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
w ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
splitRx FilePath
pat

at :: (Int -> Maybe a) -> Int -> a
at :: (Int -> Maybe a) -> Int -> a
at Int -> Maybe a
g Int
i = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> a
forall a. HasCallStack => FilePath -> a
error (FilePath -> a) -> FilePath -> a
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't find group " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Int -> Maybe a
g Int
i

at_ :: IsString s => (Int -> Maybe s) -> Int -> s
at_ :: (Int -> Maybe s) -> Int -> s
at_ Int -> Maybe s
g = s -> Maybe s -> s
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> s
forall a. IsString a => FilePath -> a
fromString FilePath
"") (Maybe s -> s) -> (Int -> Maybe s) -> Int -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe s
g