Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

option to replace the command marker "$>" with an alternative for single line commands #347

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 8 additions & 1 deletion src/Ghcid.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,6 +65,7 @@ data Options = Options
,color :: ColorMode
,setup :: [String]
,allow_eval :: Bool
,single_line_command_marker :: String
,target :: [String]
}
deriving (Data,Typeable,Show)
Expand Down Expand Up @@ -104,6 +105,7 @@ options = cmdArgsMode $ Options
,color = Auto &= name "colour" &= name "color" &= opt Always &= typ "always/never/auto" &= help "Color output (defaults to when the terminal supports it)"
,setup = [] &= name "setup" &= typ "COMMAND" &= help "Setup commands to pass to ghci on stdin, usually :set <something>"
,allow_eval = False &= name "allow-eval" &= help "Execute REPL commands in comments"
,single_line_command_marker = "$>" &= name "eval-mark" &= typ "MARKER" &= help "Replace the command marker \"$>\" with an alternative for single line commands"
,target = [] &= typ "TARGET" &= help "Target Component to build (e.g. lib:foo for Cabal, foo:lib for Stack)"
} &= verbosity &=
program "ghcid" &= summary ("Auto reloading GHCi daemon v" ++ showVersion version)
Expand Down Expand Up @@ -258,7 +260,12 @@ mainWithTerminal termSize termOutput = do
else id

maybe withWaiterNotify withWaiterPoll (poll opts) $ \waiter ->
runGhcid (if allow_eval opts then enableEval session else session) waiter termSize (clear . termOutput . restyle) opts
runGhcid
(customizeSingleLineCommandMarker (single_line_command_marker opts) $ if allow_eval opts then enableEval session else session)
waiter
termSize
(clear . termOutput . restyle)
opts



Expand Down
65 changes: 35 additions & 30 deletions src/Session.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,8 +3,8 @@
-- | A persistent version of the Ghci session, encoding lots of semantics on top.
-- Not suitable for calling multithreaded.
module Session(
Session, enableEval, withSession,
sessionStart, sessionReload,
Session, enableEval, customizeSingleLineCommandMarker,
withSession, sessionStart, sessionReload,
sessionExecAsync,
) where

Expand Down Expand Up @@ -35,11 +35,15 @@ data Session = Session
,running :: Var Bool -- ^ Am I actively running an async command
,withThread :: ThreadId -- ^ Thread that called withSession
,allowEval :: Bool -- ^ Is the allow-eval flag set?
,singleLineCommandMarker :: String -- ^ alternative to "$>" for single line commands
}

enableEval :: Session -> Session
enableEval s = s { allowEval = True }

customizeSingleLineCommandMarker :: String -> Session -> Session
customizeSingleLineCommandMarker m s = s { singleLineCommandMarker = m }


debugShutdown x = when False $ print ("DEBUG SHUTDOWN", x)

Expand All @@ -56,6 +60,7 @@ withSession f = do
debugShutdown "Starting session"
withThread <- myThreadId
let allowEval = False
let singleLineCommandMarker = "$>"
f Session{..} `finally` do
debugShutdown "Start finally"
modifyVar_ running $ const $ pure False
Expand Down Expand Up @@ -119,7 +124,7 @@ sessionStart Session{..} cmd setup = do
messages <- pure $ map (qualify dir) messages

let loaded = loadedModules dir messages
evals <- performEvals v allowEval loaded
evals <- performEvals v allowEval singleLineCommandMarker loaded

-- install a handler
forkIO $ do
Expand All @@ -146,39 +151,38 @@ sessionRestart session@Session{..} = do
sessionStart session cmd setup


performEvals :: Ghci -> Bool -> [FilePath] -> IO [Load]
performEvals _ False _ = pure []
performEvals ghci True reloaded = do
performEvals :: Ghci -> Bool -> String -> [FilePath] -> IO [Load]
performEvals _ False _ _ = pure []
performEvals ghci True singleLineCommandMarker reloaded = do
cmds <- mapM getCommands reloaded
fmap join $ forM cmds $ \(file, cmds') ->
forM cmds' $ \(num, cmd) -> do
ref <- newIORef []
execStream ghci cmd $ \_ resp -> modifyIORef ref (resp :)
resp <- unlines . reverse <$> readIORef ref
pure $ Eval $ EvalResult file (num, 1) cmd resp


getCommands :: FilePath -> IO (FilePath, [(Int, String)])
getCommands fp = do
ls <- readFileUTF8' fp
pure (fp, splitCommands $ zipFrom 1 $ lines ls)

splitCommands :: [(Int, String)] -> [(Int, String)]
splitCommands [] = []
splitCommands ((num, line) : ls)
| isCommand line =
let (cmds, xs) = span (isCommand . snd) ls
in (num, unwords $ fmap (drop $ length commandPrefix) $ line : fmap snd cmds) : splitCommands xs
| isMultilineCommandPrefix line =
let (cmds, xs) = break (isMultilineCommandSuffix . snd) ls
in (num, unlines (wrapGhciMultiline (fmap snd cmds))) : splitCommands (drop1 xs)
| otherwise = splitCommands ls

isCommand :: String -> Bool
isCommand = isPrefixOf commandPrefix

commandPrefix :: String
commandPrefix = "-- $> "
where
getCommands :: FilePath -> IO (FilePath, [(Int, String)])
getCommands fp = do
ls <- readFileUTF8' fp
pure (fp, splitCommands $ zipFrom 1 $ lines ls)

splitCommands :: [(Int, String)] -> [(Int, String)]
splitCommands [] = []
splitCommands ((num, line) : ls)
| isCommand line =
let (cmds, xs) = span (isCommand . snd) ls
in (num, unwords $ fmap (drop $ length commandPrefix) $ line : fmap snd cmds) : splitCommands xs
| isMultilineCommandPrefix line =
let (cmds, xs) = break (isMultilineCommandSuffix . snd) ls
in (num, unlines (wrapGhciMultiline (fmap snd cmds))) : splitCommands (drop1 xs)
| otherwise = splitCommands ls

isCommand :: String -> Bool
isCommand = isPrefixOf commandPrefix

commandPrefix :: String
commandPrefix = "-- " ++ singleLineCommandMarker ++ " "

isMultilineCommandPrefix :: String -> Bool
isMultilineCommandPrefix = (==) multilineCommandPrefix
Expand Down Expand Up @@ -216,7 +220,8 @@ sessionReload session@Session{..} = do
loaded <- map ((dir </>) . snd) <$> showModules ghci
let reloaded = loadedModules dir messages
warn <- readIORef warnings
evals <- performEvals ghci allowEval reloaded
evals <-
performEvals ghci allowEval singleLineCommandMarker reloaded

-- only keep old warnings from files that are still loaded, but did not reload
let validWarn w = loadFile w `elem` loaded && loadFile w `notElem` reloaded
Expand Down