-----------------------------------------------------------------------------
-- |
-- Module      :  Disco.Interactive.CmdLine
-- Copyright   :  disco team and contributors
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Definition of the command-line REPL interface for Disco.
--
-----------------------------------------------------------------------------

module Disco.Interactive.CmdLine
  ( -- * Command-line options record

    DiscoOpts(..)

    -- * optparse-applicative command line parsers
  , discoOpts, discoInfo

    -- * main

  , discoMain

  ) where

import           Data.Version                           (showVersion)
import           Paths_disco                            (version)

import           Control.Lens                           hiding (use)
import           Control.Monad                          (unless, when)
import qualified Control.Monad.Catch                    as CMC
import           Control.Monad.IO.Class                 (MonadIO (..))
import           Data.Foldable                          (forM_)
import           Data.List                              (isPrefixOf)
import           Data.Maybe                             (isJust)
import           System.Exit                            (exitFailure,
                                                         exitSuccess)

import qualified Options.Applicative                    as O
import           System.Console.Haskeline               as H

import           Disco.Error
import           Disco.Eval
import           Disco.Interactive.Commands
import           Disco.Messages
import           Disco.Module                           (miExts)
import           Disco.Pretty

import           Disco.Effects.State
import           Polysemy
import           Polysemy.ConstraintAbsorber.MonadCatch
import           Polysemy.Error

------------------------------------------------------------
-- Command-line options parser
------------------------------------------------------------

-- | Command-line options for disco.
data DiscoOpts = DiscoOpts
  { DiscoOpts -> Bool
onlyVersion :: Bool          -- ^ Should we just print the version?
  , DiscoOpts -> Maybe String
evaluate    :: Maybe String  -- ^ A single expression to evaluate
  , DiscoOpts -> Maybe String
cmdFile     :: Maybe String  -- ^ Execute the commands in a given file
  , DiscoOpts -> Maybe String
checkFile   :: Maybe String  -- ^ Check a file and then exit
  , DiscoOpts -> Bool
debugFlag   :: Bool
  }

discoOpts :: O.Parser DiscoOpts
discoOpts :: Parser DiscoOpts
discoOpts = Bool
-> Maybe String
-> Maybe String
-> Maybe String
-> Bool
-> DiscoOpts
DiscoOpts
  (Bool
 -> Maybe String
 -> Maybe String
 -> Maybe String
 -> Bool
 -> DiscoOpts)
-> Parser Bool
-> Parser
     (Maybe String -> Maybe String -> Maybe String -> Bool -> DiscoOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
O.switch (
        [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"version"
        , Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'v'
        , String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
O.help String
"show current version"
        ]
        )

   Parser
  (Maybe String -> Maybe String -> Maybe String -> Bool -> DiscoOpts)
-> Parser (Maybe String)
-> Parser (Maybe String -> Maybe String -> Bool -> DiscoOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional (
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption ([Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"evaluate"
          , Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'e'
          , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
O.help String
"evaluate an expression"
          , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"TERM"
          ])
      )
  Parser (Maybe String -> Maybe String -> Bool -> DiscoOpts)
-> Parser (Maybe String)
-> Parser (Maybe String -> Bool -> DiscoOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional (
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption ([Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"file"
          , Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'f'
          , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
O.help String
"execute the commands in a file"
          , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"FILE"
          ])
      )
  Parser (Maybe String -> Bool -> DiscoOpts)
-> Parser (Maybe String) -> Parser (Bool -> DiscoOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional (
        Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption ([Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"check"
          , String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
O.help String
"check a file without starting the interactive REPL"
          , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"FILE"
          ])
      )
  Parser (Bool -> DiscoOpts) -> Parser Bool -> Parser DiscoOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
O.switch (
        [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"debug"
        , String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
O.help String
"print debugging information"
        , Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'd'
        ]
        )

discoVersion :: String
discoVersion :: String
discoVersion = Version -> String
showVersion Version
version

discoInfo :: O.ParserInfo DiscoOpts
discoInfo :: ParserInfo DiscoOpts
discoInfo = Parser DiscoOpts -> InfoMod DiscoOpts -> ParserInfo DiscoOpts
forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (Parser (DiscoOpts -> DiscoOpts)
forall a. Parser (a -> a)
O.helper Parser (DiscoOpts -> DiscoOpts)
-> Parser DiscoOpts -> Parser DiscoOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DiscoOpts
discoOpts) (InfoMod DiscoOpts -> ParserInfo DiscoOpts)
-> InfoMod DiscoOpts -> ParserInfo DiscoOpts
forall a b. (a -> b) -> a -> b
$ [InfoMod DiscoOpts] -> InfoMod DiscoOpts
forall a. Monoid a => [a] -> a
mconcat
  [ InfoMod DiscoOpts
forall a. InfoMod a
O.fullDesc
  , String -> InfoMod DiscoOpts
forall a. String -> InfoMod a
O.progDesc String
"Command-line interface for Disco, a programming language for discrete mathematics."
  , String -> InfoMod DiscoOpts
forall a. String -> InfoMod a
O.header (String -> InfoMod DiscoOpts) -> String -> InfoMod DiscoOpts
forall a b. (a -> b) -> a -> b
$ String
"disco " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
discoVersion
  ]

optsToCfg :: DiscoOpts -> DiscoConfig
optsToCfg :: DiscoOpts -> DiscoConfig
optsToCfg DiscoOpts
opts = DiscoConfig
initDiscoConfig DiscoConfig -> (DiscoConfig -> DiscoConfig) -> DiscoConfig
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> DiscoConfig -> Identity DiscoConfig
Iso' DiscoConfig Bool
debugMode ((Bool -> Identity Bool) -> DiscoConfig -> Identity DiscoConfig)
-> Bool -> DiscoConfig -> DiscoConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DiscoOpts -> Bool
debugFlag DiscoOpts
opts

------------------------------------------------------------
-- Command-line interface
------------------------------------------------------------

banner :: String
banner :: String
banner = String
"Welcome to Disco, version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
discoVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!\n\nA language for programming discrete mathematics.\n\n"

discoMain :: IO ()
discoMain :: IO ()
discoMain = do
  DiscoOpts
opts <- ParserInfo DiscoOpts -> IO DiscoOpts
forall a. ParserInfo a -> IO a
O.execParser ParserInfo DiscoOpts
discoInfo

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiscoOpts -> Bool
onlyVersion DiscoOpts
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
discoVersion
    IO ()
forall a. IO a
exitSuccess

  let batch :: Bool
batch = (Maybe String -> Bool) -> [Maybe String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe String -> Bool
forall a. Maybe a -> Bool
isJust [DiscoOpts -> Maybe String
evaluate DiscoOpts
opts, DiscoOpts -> Maybe String
cmdFile DiscoOpts
opts, DiscoOpts -> Maybe String
checkFile DiscoOpts
opts]
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
batch (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr String
banner
  DiscoConfig
-> (forall (r :: EffectRow). Members DiscoEffects r => Sem r ())
-> IO ()
runDisco (DiscoOpts -> DiscoConfig
optsToCfg DiscoOpts
opts) ((forall (r :: EffectRow). Members DiscoEffects r => Sem r ())
 -> IO ())
-> (forall (r :: EffectRow). Members DiscoEffects r => Sem r ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ do
    case DiscoOpts -> Maybe String
checkFile DiscoOpts
opts of
      Just String
file -> do
        Bool
res <- String -> Sem r Bool
forall (r :: EffectRow).
Members
  (Error DiscoError
     : State TopInfo : Output Message : Embed IO : EvalEffects)
  r =>
String -> Sem r Bool
handleLoad String
file
        IO () -> Sem r ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ if Bool
res then IO ()
forall a. IO a
exitSuccess else IO ()
forall a. IO a
exitFailure
      Maybe String
Nothing   -> () -> Sem r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case DiscoOpts -> Maybe String
cmdFile DiscoOpts
opts of
      Just String
file -> do
        Maybe String
mcmds <- String -> Sem r (Maybe String)
forall (r :: EffectRow).
Members '[Output Message, Embed IO] r =>
String -> Sem r (Maybe String)
loadFile String
file
        case Maybe String
mcmds of
          Maybe String
Nothing   -> () -> Sem r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just String
cmds -> (String -> Sem r ()) -> [String] -> Sem r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Sem r ()
forall (r :: EffectRow).
Members DiscoEffects r =>
String -> Sem r ()
handleCMD (String -> [String]
lines String
cmds)
      Maybe String
Nothing   -> () -> Sem r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe String -> (String -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DiscoOpts -> Maybe String
evaluate DiscoOpts
opts) String -> Sem r ()
forall (r :: EffectRow).
Members DiscoEffects r =>
String -> Sem r ()
handleCMD
    Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
batch Sem r ()
forall (r :: EffectRow). Members DiscoEffects r => Sem r ()
loop

  where

    -- These types used to involve InputT Disco, but we now use Final
    -- (InputT IO) in the list of effects.  see
    -- https://github.com/polysemy-research/polysemy/issues/395 for
    -- inspiration.

    ctrlC :: MonadIO m => m a -> SomeException -> m a
    ctrlC :: m a -> SomeException -> m a
ctrlC m a
act SomeException
e = do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> IO ()
forall a. Show a => a -> IO ()
print SomeException
e
      m a
act

    withCtrlC :: (MonadIO m, CMC.MonadCatch m) => m a -> m a -> m a
    withCtrlC :: m a -> m a -> m a
withCtrlC m a
resume m a
act = m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
CMC.catch m a
act (m a -> SomeException -> m a
forall (m :: * -> *) a. MonadIO m => m a -> SomeException -> m a
ctrlC m a
resume)

    loop :: Members DiscoEffects r => Sem r ()
    loop :: Sem r ()
loop = do
      Maybe String
minput <- InputT IO (Maybe String) -> Sem r (Maybe String)
forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (InputT IO (Maybe String) -> Sem r (Maybe String))
-> InputT IO (Maybe String) -> Sem r (Maybe String)
forall a b. (a -> b) -> a -> b
$ InputT IO (Maybe String)
-> InputT IO (Maybe String) -> InputT IO (Maybe String)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m a -> m a
withCtrlC (Maybe String -> InputT IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> InputT IO (Maybe String))
-> Maybe String -> InputT IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
"") (String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
getInputLine String
"Disco> ")
      case Maybe String
minput of
        Maybe String
Nothing -> () -> Sem r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
input
          | String
":q" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
input Bool -> Bool -> Bool
&& String
input String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
":quit" -> do
              IO () -> Sem r ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Goodbye!"
              () -> Sem r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | String
":{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
input -> do
              [String] -> Sem r ()
forall (r :: EffectRow).
Members DiscoEffects r =>
[String] -> Sem r ()
multiLineLoop []
              Sem r ()
forall (r :: EffectRow). Members DiscoEffects r => Sem r ()
loop
          | Bool
otherwise -> do
              (SomeException -> DiscoError)
-> Sem (Error SomeException : r) () -> Sem r ()
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError @_ @DiscoError (String -> DiscoError
Panic (String -> DiscoError)
-> (SomeException -> String) -> SomeException -> DiscoError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) (Sem (Error SomeException : r) () -> Sem r ())
-> Sem (Error SomeException : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
                (MonadCatch (Sem (Error SomeException : r)) =>
 Sem (Error SomeException : r) ())
-> Sem (Error SomeException : r) ()
forall (r :: EffectRow) a.
Member (Error SomeException) r =>
(MonadCatch (Sem r) => Sem r a) -> Sem r a
absorbMonadCatch ((MonadCatch (Sem (Error SomeException : r)) =>
  Sem (Error SomeException : r) ())
 -> Sem (Error SomeException : r) ())
-> (MonadCatch (Sem (Error SomeException : r)) =>
    Sem (Error SomeException : r) ())
-> Sem (Error SomeException : r) ()
forall a b. (a -> b) -> a -> b
$
                Sem (Error SomeException : r) ()
-> Sem (Error SomeException : r) ()
-> Sem (Error SomeException : r) ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m a -> m a
withCtrlC (() -> Sem (Error SomeException : r) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Sem (Error SomeException : r) ()
 -> Sem (Error SomeException : r) ())
-> Sem (Error SomeException : r) ()
-> Sem (Error SomeException : r) ()
forall a b. (a -> b) -> a -> b
$
                String -> Sem (Error SomeException : r) ()
forall (r :: EffectRow).
Members DiscoEffects r =>
String -> Sem r ()
handleCMD String
input
              Sem r ()
forall (r :: EffectRow). Members DiscoEffects r => Sem r ()
loop

    multiLineLoop :: Members DiscoEffects r => [String] -> Sem r ()
    multiLineLoop :: [String] -> Sem r ()
multiLineLoop [String]
ls = do
      Maybe String
minput <- InputT IO (Maybe String) -> Sem r (Maybe String)
forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (InputT IO (Maybe String) -> Sem r (Maybe String))
-> InputT IO (Maybe String) -> Sem r (Maybe String)
forall a b. (a -> b) -> a -> b
$ InputT IO (Maybe String)
-> InputT IO (Maybe String) -> InputT IO (Maybe String)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m a -> m a
withCtrlC (Maybe String -> InputT IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing) (String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
getInputLine String
"Disco| ")
      case Maybe String
minput of
        Maybe String
Nothing -> () -> Sem r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
input
          | String
":}" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
input -> do
              (SomeException -> DiscoError)
-> Sem (Error SomeException : r) () -> Sem r ()
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError @_ @DiscoError (String -> DiscoError
Panic (String -> DiscoError)
-> (SomeException -> String) -> SomeException -> DiscoError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) (Sem (Error SomeException : r) () -> Sem r ())
-> Sem (Error SomeException : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
                (MonadCatch (Sem (Error SomeException : r)) =>
 Sem (Error SomeException : r) ())
-> Sem (Error SomeException : r) ()
forall (r :: EffectRow) a.
Member (Error SomeException) r =>
(MonadCatch (Sem r) => Sem r a) -> Sem r a
absorbMonadCatch ((MonadCatch (Sem (Error SomeException : r)) =>
  Sem (Error SomeException : r) ())
 -> Sem (Error SomeException : r) ())
-> (MonadCatch (Sem (Error SomeException : r)) =>
    Sem (Error SomeException : r) ())
-> Sem (Error SomeException : r) ()
forall a b. (a -> b) -> a -> b
$
                Sem (Error SomeException : r) ()
-> Sem (Error SomeException : r) ()
-> Sem (Error SomeException : r) ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m a -> m a
withCtrlC (() -> Sem (Error SomeException : r) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Sem (Error SomeException : r) ()
 -> Sem (Error SomeException : r) ())
-> Sem (Error SomeException : r) ()
-> Sem (Error SomeException : r) ()
forall a b. (a -> b) -> a -> b
$
                String -> Sem (Error SomeException : r) ()
forall (r :: EffectRow).
Members DiscoEffects r =>
String -> Sem r ()
handleCMD ([String] -> String
unlines ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
ls))
          | Bool
otherwise -> do
              [String] -> Sem r ()
forall (r :: EffectRow).
Members DiscoEffects r =>
[String] -> Sem r ()
multiLineLoop (String
inputString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls)

-- | Parse and run the command corresponding to some REPL input.
handleCMD :: Members DiscoEffects r => String -> Sem r ()
handleCMD :: String -> Sem r ()
handleCMD String
"" = () -> Sem r ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleCMD String
s = do
  ExtSet
exts <- Getter TopInfo ExtSet -> Sem r ExtSet
forall s (r :: EffectRow) a.
Member (State s) r =>
Getter s a -> Sem r a
use @TopInfo ((ModuleInfo -> f ModuleInfo) -> TopInfo -> f TopInfo
Lens' TopInfo ModuleInfo
replModInfo ((ModuleInfo -> f ModuleInfo) -> TopInfo -> f TopInfo)
-> ((ExtSet -> f ExtSet) -> ModuleInfo -> f ModuleInfo)
-> (ExtSet -> f ExtSet)
-> TopInfo
-> f TopInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExtSet -> f ExtSet) -> ModuleInfo -> f ModuleInfo
Lens' ModuleInfo ExtSet
miExts)
  case REPLCommands -> ExtSet -> String -> Either String SomeREPLExpr
parseLine REPLCommands
discoCommands ExtSet
exts String
s of
    Left String
m  -> Sem r Doc -> Sem r ()
forall (r :: EffectRow).
Member (Output Message) r =>
Sem r Doc -> Sem r ()
info (String -> Sem r Doc
forall (m :: * -> *). Applicative m => String -> m Doc
text String
m)
    Right SomeREPLExpr
l -> Sem r () -> (DiscoError -> Sem r ()) -> Sem r ()
forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch @DiscoError (REPLCommands -> SomeREPLExpr -> Sem r ()
forall (r :: EffectRow).
Members DiscoEffects r =>
REPLCommands -> SomeREPLExpr -> Sem r ()
dispatch REPLCommands
discoCommands SomeREPLExpr
l) (Sem r Doc -> Sem r ()
forall (r :: EffectRow).
Member (Output Message) r =>
Sem r Doc -> Sem r ()
info (Sem r Doc -> Sem r ())
-> (DiscoError -> Sem r Doc) -> DiscoError -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscoError -> Sem r Doc
forall t (r :: EffectRow). Pretty t => t -> Sem r Doc
pretty')
                -- The above has to be catch, not outputErrors, because
                -- the latter won't resume afterwards.