Skip to content

Commit

Permalink
Run config.hs from CLI
Browse files Browse the repository at this point in the history
  • Loading branch information
matthunz committed Jun 15, 2024
1 parent 208b0ca commit 27d426d
Show file tree
Hide file tree
Showing 3 changed files with 49 additions and 37 deletions.
77 changes: 48 additions & 29 deletions app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,15 @@ module Main where

import Control.Exception (SomeException)
import Control.Exception.Base (try)
import Control.Monad (when)
import GHC.IO.Exception (ExitCode (ExitSuccess))
import Options.Applicative
import System.Environment.XDG.BaseDir (getUserConfigDir, getUserDataDir)
import System.FilePath ((</>))
import System.Process (readProcessWithExitCode)

data Args = Args
{sRecompile :: Bool}
{aRecompile :: Bool}

args :: Parser Args
args =
Expand All @@ -28,34 +29,52 @@ main = run =<< execParser opts
(args <**> helper)
(fullDesc <> progDesc "Shell prompt")

appName :: String
appName = "prompt"

run :: Args -> IO ()
run (Args True) = recompile
run _ = return ()
run args = do
when (aRecompile args) recompile

dataDir <- getUserDataDir ""
let binPath = dataDir </> appName

result <-
try
(readProcessWithExitCode binPath [] "") ::
IO (Either SomeException (ExitCode, String, String))

case result of
Left e -> print e
Right (exitCode, stdout, stderr) -> do
if exitCode == ExitSuccess
then putStrLn stdout
else putStrLn stderr

recompile :: IO ()
recompile =
let appName = "prompt"
in do
dataDir <- getUserDataDir ""
configDir <- getUserConfigDir ""

let binPath = dataDir </> appName

result <-
try
( readProcessWithExitCode
"ghc"
[ "-o",
binPath,
configDir </> "prompt" </> "prompt.hs"
]
""
) ::
IO (Either SomeException (ExitCode, String, String))

case result of
Left e -> print e
Right (exitCode, _, stderr) -> do
if exitCode == ExitSuccess
then return ()
else putStrLn stderr
recompile = do
dataDir <- getUserDataDir ""
configDir <- getUserConfigDir ""

let binPath = dataDir </> appName

result <-
try
( readProcessWithExitCode
"stack"
[ "ghc",
"--",
"-o",
binPath,
configDir </> "prompt" </> "config.hs"
]
""
) ::
IO (Either SomeException (ExitCode, String, String))

case result of
Left e -> print e
Right (exitCode, _, stderr) -> do
if exitCode == ExitSuccess
then return ()
else putStrLn stderr
7 changes: 0 additions & 7 deletions app/Prompt.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,13 +11,6 @@ import System.Exit (ExitCode (ExitSuccess))
import System.FilePath (takeFileName)
import System.Process (readProcessWithExitCode)

main :: IO ()
main = do
run
[ currentDirectoryModule,
gitBranchModule
]

run :: [IO (Maybe String)] -> IO ()
run modules = do
results <- mapConcurrently id modules
Expand Down
2 changes: 1 addition & 1 deletion prompt.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ executable prompt
xdg-basedir >= 0.2,
optparse-applicative >= 0.18

library prompt-lib
library
exposed-modules:
Prompt
hs-source-dirs: app
Expand Down

0 comments on commit 27d426d

Please sign in to comment.