diff --git a/IHaskell.cabal b/IHaskell.cabal index 30bc204a..2dca53ed 100644 --- a/IHaskell.cabal +++ b/IHaskell.cabal @@ -95,6 +95,7 @@ library IHaskell.Eval.ParseShell IHaskell.Eval.Util IHaskell.IPython + IHaskell.Flags IHaskell.Message.Parser IHaskell.Message.UUID IHaskell.Message.Writer @@ -121,6 +122,7 @@ executable IHaskell IHaskell.Eval.ParseShell IHaskell.Eval.Util IHaskell.IPython + IHaskell.Flags IHaskell.Message.Parser IHaskell.Message.UUID IHaskell.Message.Writer diff --git a/src/IHaskell/Flags.hs b/src/IHaskell/Flags.hs new file mode 100644 index 00000000..b816acea --- /dev/null +++ b/src/IHaskell/Flags.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module IHaskell.Flags ( + IHaskellMode(..), + Argument(..), + Args(..), + parseFlags, + help, + ) where + +import ClassyPrelude +import System.Console.CmdArgs.Explicit +import System.Console.CmdArgs.Text + +import IHaskell.Types + +-- Command line arguments to IHaskell. A set of aruments is annotated with +-- the mode being invoked. +data Args = Args IHaskellMode [Argument] + +data Argument + = ServeFrom String -- ^ Which directory to serve notebooks from. + | Extension String -- ^ An extension to load at startup. + | ConfFile String -- ^ A file with commands to load at startup. + | Help -- ^ Display help text. + deriving (Eq, Show) + +-- Which mode IHaskell is being invoked in. +-- `None` means no mode was specified. +data IHaskellMode + = ShowHelp String + | Notebook + | Console + | UpdateIPython + | Kernel (Maybe String) + | View (Maybe ViewFormat) (Maybe String) + deriving (Eq, Show) + +-- | Given a list of command-line arguments, return the IHaskell mode and +-- arguments to process. +parseFlags :: [String] -> Either String Args +parseFlags = process ihaskellArgs + +-- | Get help text for a given IHaskell ode. +help :: IHaskellMode -> String +help mode = + showText (Wrap 100) $ helpText [] HelpFormatAll $ chooseMode mode + where + chooseMode Console = console + chooseMode Notebook = notebook + chooseMode (Kernel _) = kernel + chooseMode UpdateIPython = update + +universalFlags :: [Flag Args] +universalFlags = [ + flagReq ["extension","e", "X"] (store Extension) "" "Extension to enable at start.", + flagReq ["conf","c"] (store ConfFile) "" "File with commands to execute at start.", + flagHelpSimple (add Help) + ] + where + add flag (Args mode flags) = Args mode $ flag : flags + +store :: (String -> Argument) -> String -> Args -> Either String Args +store constructor str (Args mode prev) = Right $ Args mode $ constructor str : prev + +notebook :: Mode Args +notebook = mode "notebook" (Args Notebook []) "Browser-based notebook interface." noArgs $ + flagReq ["serve","s"] (store ServeFrom) "" "Directory to serve notebooks from.": + universalFlags + +console :: Mode Args +console = mode "console" (Args Console []) "Console-based interactive repl." noArgs universalFlags + +kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg [] + where + kernelArg = flagArg update "" + update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags + +update :: Mode Args +update = mode "update" (Args UpdateIPython []) "Update IPython frontends." noArgs [] + +view :: Mode Args +view = (modeEmpty $ Args (View Nothing Nothing) []) { + modeNames = ["view"], + modeCheck = + \a@(Args (View fmt file) _) -> + if not (isJust fmt && isJust file) + then Left "Syntax: IHaskell view [.ipynb]" + else Right a, + modeHelp = concat [ + "Convert an IHaskell notebook to another format.\n", + "Notebooks are searched in the IHaskell directory and the current directory.\n", + "Available formats are " ++ intercalate ", " (map show + ["pdf", "html", "ipynb", "markdown", "latex"]), + "." + ], + modeArgs = ([formatArg, filenameArg], Nothing) + + } + where + formatArg = flagArg updateFmt "" + filenameArg = flagArg updateFile "[.ipynb]" + updateFmt fmtStr (Args (View _ s) flags) = + case readMay fmtStr of + Just fmt -> Right $ Args (View (Just fmt) s) flags + Nothing -> Left $ "Invalid format '" ++ fmtStr ++ "'." + updateFile name (Args (View f _) flags) = Right $ Args (View f (Just name)) flags + + +ihaskellArgs :: Mode Args +ihaskellArgs = + let descr = "Haskell for Interactive Computing." + helpStr = showText (Wrap 100) $ helpText [] HelpFormatAll ihaskellArgs + onlyHelp = [flagHelpSimple (add Help)] + noMode = mode "IHaskell" (Args (ShowHelp helpStr) []) descr noArgs onlyHelp in + noMode { modeGroupModes = toGroup [console, notebook, view, update, kernel] } + where + add flag (Args mode flags) = Args mode $ flag : flags + +noArgs = flagArg unexpected "" + where + unexpected a = error $ "Unexpected argument: " ++ a diff --git a/src/IHaskell/IPython.hs b/src/IHaskell/IPython.hs index 01981839..9579c0a9 100644 --- a/src/IHaskell/IPython.hs +++ b/src/IHaskell/IPython.hs @@ -26,44 +26,12 @@ import Data.List.Utils (split) import Data.String.Utils (rstrip) import Text.Printf -import Text.Read as Read hiding (pfail) -import Text.ParserCombinators.ReadP - import qualified System.IO.Strict as StrictIO import qualified Paths_ihaskell as Paths import qualified Codec.Archive.Tar as Tar import IHaskell.Types -data ViewFormat - = Pdf - | Html - | Ipynb - | Markdown - | Latex - deriving Eq - -instance Show ViewFormat where - show Pdf = "pdf" - show Html = "html" - show Ipynb = "ipynb" - show Markdown = "markdown" - show Latex = "latex" - -instance Read ViewFormat where - readPrec = Read.lift $ do - str <- munch (const True) - case str of - "pdf" -> return Pdf - "html" -> return Html - "ipynb" -> return Ipynb - "notebook" -> return Ipynb - "latex" -> return Latex - "markdown" -> return Markdown - "md" -> return Markdown - _ -> pfail - - -- | Which commit of IPython we are on. ipythonCommit :: Text ipythonCommit = "9c922f54af799704f4000aeee94ec7c74cada194" diff --git a/src/IHaskell/Types.hs b/src/IHaskell/Types.hs index 320e794b..ddfb52a9 100644 --- a/src/IHaskell/Types.hs +++ b/src/IHaskell/Types.hs @@ -21,6 +21,7 @@ module IHaskell.Types ( LintStatus(..), Width, Height, FrontendType(..), + ViewFormat(..), defaultKernelState, extractPlain ) where @@ -32,6 +33,37 @@ import Data.Serialize import GHC.Generics (Generic) import qualified Data.ByteString.Char8 as Char +import Text.Read as Read hiding (pfail, String) +import Text.ParserCombinators.ReadP + +data ViewFormat + = Pdf + | Html + | Ipynb + | Markdown + | Latex + deriving Eq + +instance Show ViewFormat where + show Pdf = "pdf" + show Html = "html" + show Ipynb = "ipynb" + show Markdown = "markdown" + show Latex = "latex" + +instance Read ViewFormat where + readPrec = Read.lift $ do + str <- munch (const True) + case str of + "pdf" -> return Pdf + "html" -> return Html + "ipynb" -> return Ipynb + "notebook" -> return Ipynb + "latex" -> return Latex + "markdown" -> return Markdown + "md" -> return Markdown + _ -> pfail + -- | A TCP port. type Port = Int diff --git a/src/Main.hs b/src/Main.hs index 4951e39e..c92066bb 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -12,7 +12,6 @@ import Data.Aeson import Text.Printf import System.Exit (exitSuccess) import System.Directory -import System.Console.CmdArgs.Explicit hiding (complete) import qualified Data.Map as Map @@ -25,113 +24,25 @@ import IHaskell.Eval.Info import qualified Data.ByteString.Char8 as Chars import IHaskell.IPython import qualified IHaskell.Eval.Stdin as Stdin +import IHaskell.Flags import GHC hiding (extensions) import Outputable (showSDoc, ppr) --- Command line arguments to IHaskell. A set of aruments is annotated with --- the mode being invoked. -data Args = Args IHaskellMode [Argument] - -data Argument - = ServeFrom String -- ^ Which directory to serve notebooks from. - | Extension String -- ^ An extension to load at startup. - | ConfFile String -- ^ A file with commands to load at startup. - | Help -- ^ Display help text. - deriving (Eq, Show) - --- Which mode IHaskell is being invoked in. --- `None` means no mode was specified. -data IHaskellMode - = None - | Notebook - | Console - | UpdateIPython - | Kernel (Maybe String) - | View (Maybe ViewFormat) (Maybe String) - deriving (Eq, Show) main :: IO () main = do - stringArgs <- map unpack <$> getArgs - case process ihaskellArgs stringArgs of - Left errmsg -> putStrLn $ pack errmsg + args <- parseFlags <$> map unpack <$> getArgs + case args of + Left errorMessage -> + hPutStrLn stderr errorMessage Right args -> ihaskell args -universalFlags :: [Flag Args] -universalFlags = [ - flagReq ["extension","e", "X"] (store Extension) "" "Extension to enable at start.", - flagReq ["conf","c"] (store ConfFile) "" "File with commands to execute at start.", - flagHelpSimple (add Help) - ] - where - add flag (Args mode flags) = Args mode $ flag : flags - -store :: (String -> Argument) -> String -> Args -> Either String Args -store constructor str (Args mode prev) = Right $ Args mode $ constructor str : prev - -notebook :: Mode Args -notebook = mode "notebook" (Args Notebook []) "Browser-based notebook interface." noArgs $ - flagReq ["serve","s"] (store ServeFrom) "" "Directory to serve notebooks from.": - universalFlags - -console :: Mode Args -console = mode "console" (Args Console []) "Console-based interactive repl." noArgs universalFlags - -kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg [] - where - kernelArg = flagArg update "" - update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags - -update :: Mode Args -update = mode "update" (Args UpdateIPython []) "Update IPython frontends." noArgs [] - -view :: Mode Args -view = (modeEmpty $ Args (View Nothing Nothing) []) { - modeNames = ["view"], - modeCheck = - \a@(Args (View fmt file) _) -> - if not (isJust fmt && isJust file) - then Left "Syntax: IHaskell view [.ipynb]" - else Right a, - modeHelp = concat [ - "Convert an IHaskell notebook to another format.\n", - "Notebooks are searched in the IHaskell directory and the current directory.\n", - "Available formats are " ++ intercalate ", " (map show - ["pdf", "html", "ipynb", "markdown", "latex"]), - "." - ], - modeArgs = ([formatArg, filenameArg], Nothing) - - } - where - formatArg = flagArg updateFmt "" - filenameArg = flagArg updateFile "[.ipynb]" - updateFmt fmtStr (Args (View _ s) flags) = - case readMay fmtStr of - Just fmt -> Right $ Args (View (Just fmt) s) flags - Nothing -> Left $ "Invalid format '" ++ fmtStr ++ "'." - updateFile name (Args (View f _) flags) = Right $ Args (View f (Just name)) flags - - -ihaskellArgs :: Mode Args -ihaskellArgs = - let descr = "Haskell for Interactive Computing." - onlyHelp = [flagHelpSimple (add Help)] - noMode = mode "IHaskell" (Args None []) descr noArgs onlyHelp in - noMode { modeGroupModes = toGroup [console, notebook, view, update, kernel] } - where - add flag (Args mode flags) = Args mode $ flag : flags - -noArgs = flagArg unexpected "" - where - unexpected a = error $ "Unexpected argument: " ++ a - ihaskell :: Args -> IO () -- If no mode is specified, print help text. -ihaskell (Args None _) = - print $ helpText [] HelpFormatAll ihaskellArgs +ihaskell (Args (ShowHelp help) _) = + putStrLn $ pack help -- Update IPython: remove then reinstall. -- This is in case cabal updates IHaskell but the corresponding IPython @@ -188,14 +99,9 @@ showingHelp :: IHaskellMode -> [Argument] -> IO () -> IO () showingHelp mode flags act = case find (==Help) flags of Just _ -> - print $ helpText [] HelpFormatAll $ chooseMode mode + putStrLn $ pack $ help mode Nothing -> act - where - chooseMode Console = console - chooseMode Notebook = notebook - chooseMode (Kernel _) = kernel - chooseMode UpdateIPython = update -- | Parse initialization information from the flags. initInfo :: FrontendType -> [Argument] -> IO InitInfo