mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-16 03:16:20 +00:00
separating flags into separate module
This commit is contained in:
Andrew Gibiansky
parent
1d011463b0
commit
208d434d45
@ -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
|
||||
|
||||
121
src/IHaskell/Flags.hs
Normal file
121
src/IHaskell/Flags.hs
Normal file
@ -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) "<ghc-extension>" "Extension to enable at start.",
|
||||
flagReq ["conf","c"] (store ConfFile) "<file.hs>" "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) "<dir>" "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 "<json-kernel-file>"
|
||||
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 <format> <name>[.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 "<format>"
|
||||
filenameArg = flagArg updateFile "<name>[.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
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
110
src/Main.hs
110
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) "<ghc-extension>" "Extension to enable at start.",
|
||||
flagReq ["conf","c"] (store ConfFile) "<file.hs>" "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) "<dir>" "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 "<json-kernel-file>"
|
||||
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 <format> <name>[.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 "<format>"
|
||||
filenameArg = flagArg updateFile "<name>[.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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user