{-# language NoImplicitPrelude, DoAndIfThenElse, OverloadedStrings, ExtendedDefaultRules #-}
{-# LANGUAGE NoImplicitPrelude, DeriveFunctor #-}

module IHaskell.Flags (
    IHaskellMode(..),
    Argument(..),
    Args(..),
    LhsStyle(..),
    NotebookFormat(..),
    lhsStyleBird,
    parseFlags,
    help,
    ) where

import qualified Data.Text as T
import           IHaskellPrelude hiding (Arg(..))

import           System.Console.CmdArgs.Explicit
import           System.Console.CmdArgs.Text
import           Data.List (findIndex)

-- Command line arguments to IHaskell. A set of arguments is annotated with the mode being invoked.
data Args = Args IHaskellMode [Argument]
  deriving Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> String
$cshow :: Args -> String
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show

data Argument = ConfFile String               -- ^ A file with commands to load at startup.
              | OverwriteFiles                -- ^ Present when output should overwrite existing files.
              | GhcLibDir String              -- ^ Where to find the GHC libraries.
              | RTSFlags [String]             -- ^ Options for the GHC runtime (e.g. heap-size limit
                                              --     or number of threads).
              | KernelDebug                   -- ^ Spew debugging output from the kernel.
              | KernelName String             -- ^ The IPython kernel directory name.
              | DisplayName String            -- ^ The IPython display name.
              | Help                          -- ^ Display help text.
              | Version                       -- ^ Display version text.
              | CodeMirror String             -- ^ change codemirror mode (default=ihaskell)
              | HtmlCodeWrapperClass String   -- ^ set the wrapper class for HTML output
              | HtmlCodeTokenPrefix String    -- ^ set a prefix on each token of HTML output
              | ConvertFrom String
              | ConvertTo String
              | ConvertFromFormat NotebookFormat
              | ConvertToFormat NotebookFormat
              | ConvertLhsStyle (LhsStyle String)
              | KernelspecInstallPrefix String
              | KernelspecUseStack
              | KernelspecEnvFile FilePath
  deriving (Argument -> Argument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Argument -> Argument -> Bool
$c/= :: Argument -> Argument -> Bool
== :: Argument -> Argument -> Bool
$c== :: Argument -> Argument -> Bool
Eq, Int -> Argument -> ShowS
[Argument] -> ShowS
Argument -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Argument] -> ShowS
$cshowList :: [Argument] -> ShowS
show :: Argument -> String
$cshow :: Argument -> String
showsPrec :: Int -> Argument -> ShowS
$cshowsPrec :: Int -> Argument -> ShowS
Show)

data LhsStyle string =
       LhsStyle
         { forall string. LhsStyle string -> string
lhsCodePrefix :: string  -- ^ @>@
         , forall string. LhsStyle string -> string
lhsOutputPrefix :: string  -- ^ @<<@
         , forall string. LhsStyle string -> string
lhsBeginCode :: string  -- ^ @\\begin{code}@
         , forall string. LhsStyle string -> string
lhsEndCode :: string  -- ^ @\\end{code}@
         , forall string. LhsStyle string -> string
lhsBeginOutput :: string  -- ^ @\\begin{verbatim}@
         , forall string. LhsStyle string -> string
lhsEndOutput :: string  -- ^ @\\end{verbatim}@
         }
  deriving (LhsStyle string -> LhsStyle string -> Bool
forall string.
Eq string =>
LhsStyle string -> LhsStyle string -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LhsStyle string -> LhsStyle string -> Bool
$c/= :: forall string.
Eq string =>
LhsStyle string -> LhsStyle string -> Bool
== :: LhsStyle string -> LhsStyle string -> Bool
$c== :: forall string.
Eq string =>
LhsStyle string -> LhsStyle string -> Bool
Eq, forall a b. a -> LhsStyle b -> LhsStyle a
forall a b. (a -> b) -> LhsStyle a -> LhsStyle b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LhsStyle b -> LhsStyle a
$c<$ :: forall a b. a -> LhsStyle b -> LhsStyle a
fmap :: forall a b. (a -> b) -> LhsStyle a -> LhsStyle b
$cfmap :: forall a b. (a -> b) -> LhsStyle a -> LhsStyle b
Functor, Int -> LhsStyle string -> ShowS
forall string. Show string => Int -> LhsStyle string -> ShowS
forall string. Show string => [LhsStyle string] -> ShowS
forall string. Show string => LhsStyle string -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LhsStyle string] -> ShowS
$cshowList :: forall string. Show string => [LhsStyle string] -> ShowS
show :: LhsStyle string -> String
$cshow :: forall string. Show string => LhsStyle string -> String
showsPrec :: Int -> LhsStyle string -> ShowS
$cshowsPrec :: forall string. Show string => Int -> LhsStyle string -> ShowS
Show)

data NotebookFormat = LhsMarkdown
                    | IpynbFile
  deriving (NotebookFormat -> NotebookFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotebookFormat -> NotebookFormat -> Bool
$c/= :: NotebookFormat -> NotebookFormat -> Bool
== :: NotebookFormat -> NotebookFormat -> Bool
$c== :: NotebookFormat -> NotebookFormat -> Bool
Eq, Int -> NotebookFormat -> ShowS
[NotebookFormat] -> ShowS
NotebookFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotebookFormat] -> ShowS
$cshowList :: [NotebookFormat] -> ShowS
show :: NotebookFormat -> String
$cshow :: NotebookFormat -> String
showsPrec :: Int -> NotebookFormat -> ShowS
$cshowsPrec :: Int -> NotebookFormat -> ShowS
Show)

-- Which mode IHaskell is being invoked in.
data IHaskellMode = ShowDefault String
                  | InstallKernelSpec
                  | ConvertLhs
                  | Kernel (Maybe String)
  deriving (IHaskellMode -> IHaskellMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IHaskellMode -> IHaskellMode -> Bool
$c/= :: IHaskellMode -> IHaskellMode -> Bool
== :: IHaskellMode -> IHaskellMode -> Bool
$c== :: IHaskellMode -> IHaskellMode -> Bool
Eq, Int -> IHaskellMode -> ShowS
[IHaskellMode] -> ShowS
IHaskellMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IHaskellMode] -> ShowS
$cshowList :: [IHaskellMode] -> ShowS
show :: IHaskellMode -> String
$cshow :: IHaskellMode -> String
showsPrec :: Int -> IHaskellMode -> ShowS
$cshowsPrec :: Int -> IHaskellMode -> ShowS
Show)

-- | Given a list of command-line arguments, return the IHaskell mode and arguments to process.
parseFlags :: [String] -> Either String Args
parseFlags :: [String] -> Either String Args
parseFlags [String]
flags =
  let modeIndex :: Maybe Int
modeIndex = forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
modeFlgs) [String]
flags
  in case Maybe Int
modeIndex of
    Maybe Int
Nothing ->
      -- Treat no mode as 'console'.
      forall a. Mode a -> [String] -> Either String a
process Mode Args
ihaskellArgs [String]
flags
    Just Int
0 -> forall a. Mode a -> [String] -> Either String a
process Mode Args
ihaskellArgs [String]
flags

    Just Int
idx ->
      -- If mode not first, move it to be first.
      let ([String]
start, String
first:[String]
end) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
idx [String]
flags
      in forall a. Mode a -> [String] -> Either String a
process Mode Args
ihaskellArgs forall a b. (a -> b) -> a -> b
$ String
first forall a. a -> [a] -> [a]
: [String]
start forall a. [a] -> [a] -> [a]
++ [String]
end
  where
    modeFlgs :: [String]
modeFlgs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Mode a -> [String]
modeNames [Mode Args]
allModes

allModes :: [Mode Args]
allModes :: [Mode Args]
allModes = [Mode Args
installKernelSpec, Mode Args
kernel, Mode Args
convert]

-- | Get help text for a given IHaskell ode.
help :: IHaskellMode -> String
help :: IHaskellMode -> String
help IHaskellMode
md = TextFormat -> [Text] -> String
showText (Int -> TextFormat
Wrap Int
100) forall a b. (a -> b) -> a -> b
$ forall a. [String] -> HelpFormat -> Mode a -> [Text]
helpText [] HelpFormat
HelpFormatAll forall a b. (a -> b) -> a -> b
$ IHaskellMode -> Mode Args
chooseMode IHaskellMode
md
  where
    chooseMode :: IHaskellMode -> Mode Args
chooseMode IHaskellMode
InstallKernelSpec = Mode Args
installKernelSpec
    chooseMode (Kernel Maybe String
_) = Mode Args
kernel
    chooseMode IHaskellMode
ConvertLhs = Mode Args
convert
    chooseMode (ShowDefault String
_) = forall a. HasCallStack => String -> a
error String
"IHaskell.Flags.help: Should never happen."

ghcLibFlag :: Flag Args
ghcLibFlag :: Flag Args
ghcLibFlag = forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"ghclib", String
"l"] ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
GhcLibDir) String
"<path>" String
"Library directory for GHC."

ghcRTSFlag :: Flag Args
ghcRTSFlag :: Flag Args
ghcRTSFlag = forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"use-rtsopts"] forall {a}. IsString a => String -> Args -> Either a Args
storeRTS String
"\"<flags>\""
                  String
"Runtime options (multithreading etc.). See `ghc +RTS -?`."
 where storeRTS :: String -> Args -> Either a Args
storeRTS String
allRTSFlags (Args IHaskellMode
md [Argument]
prev)
          = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[Argument]
prev) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Argument
RTSFlags)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}.
(Eq a, IsString a, IsString a) =>
[a] -> Either a [a]
parseRTS forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'"') String
allRTSFlags
       parseRTS :: [a] -> Either a [a]
parseRTS (a
"+RTS":[a]
fs)  -- Ignore if this is included (we already wrap
           = [a] -> Either a [a]
parseRTS [a]
fs     -- the ihaskell-kernel call in +RTS <flags> -RTS anyway)
       parseRTS [a
"-RTS"] = forall a b. b -> Either a b
Right []
       parseRTS (a
"-RTS":[a]
_)  -- Evil injection of extra arguments? Unlikely, but...
           = forall a b. a -> Either a b
Left a
"Adding non-RTS options to --use-rtsopts not permitted."
       parseRTS (a
f:[a]
fs) = (a
fforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Either a [a]
parseRTS [a]
fs
       parseRTS [] = forall a b. b -> Either a b
Right []

kernelDebugFlag :: Flag Args
kernelDebugFlag :: Flag Args
kernelDebugFlag = forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"debug"] Args -> Args
addDebug String
"Print debugging output from the kernel."
  where
    addDebug :: Args -> Args
addDebug (Args IHaskellMode
md [Argument]
prev) = IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md (Argument
KernelDebug forall a. a -> [a] -> [a]
: [Argument]
prev)

kernelNameFlag :: Flag Args
kernelNameFlag :: Flag Args
kernelNameFlag =
  forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
    [String
"kernel-name"]
    ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
KernelName)
    String
"<name>"
    String
"The directory name of the kernel."

displayNameFlag :: Flag Args
displayNameFlag :: Flag Args
displayNameFlag =
  forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
    [String
"display-name"]
    ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
DisplayName)
    String
"<name>"
    String
"The display name of the kernel."

kernelCodeMirrorFlag :: Flag Args
kernelCodeMirrorFlag :: Flag Args
kernelCodeMirrorFlag = forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"codemirror"] ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
CodeMirror) String
"<codemirror>"
        String
"Specify codemirror mode that is used for syntax highlighting (default: ihaskell)."

kernelHtmlCodeWrapperClassFlag :: Flag Args
kernelHtmlCodeWrapperClassFlag :: Flag Args
kernelHtmlCodeWrapperClassFlag = forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"html-code-wrapper-class"] ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
HtmlCodeWrapperClass) String
"CodeMirror cm-s-jupyter cm-s-ipython"
        String
"Specify class name for wrapper div around HTML output (default: 'CodeMirror cm-s-jupyter cm-s-ipython')"

kernelHtmlCodeTokenPrefixFlag :: Flag Args
kernelHtmlCodeTokenPrefixFlag :: Flag Args
kernelHtmlCodeTokenPrefixFlag = forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"html-code-token-prefix"] ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
HtmlCodeTokenPrefix) String
"cm-"
        String
"Specify class name prefix for each token in HTML output (default: cm-)"

kernelStackFlag :: Flag Args
kernelStackFlag :: Flag Args
kernelStackFlag = forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"stack"] Args -> Args
addStack
                    String
"Inherit environment from `stack` when it is installed"
  where
    addStack :: Args -> Args
addStack (Args IHaskellMode
md [Argument]
prev) = IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md (Argument
KernelspecUseStack forall a. a -> [a] -> [a]
: [Argument]
prev)

kernelEnvFileFlag :: Flag Args
kernelEnvFileFlag :: Flag Args
kernelEnvFileFlag =
  forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
    [String
"env-file"]
    ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
KernelspecEnvFile)
    String
"<file>"
    String
"Load environment from this file when kernel is installed"

confFlag :: Flag Args
confFlag :: Flag Args
confFlag = forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"conf", String
"c"] ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
ConfFile) String
"<rc.hs>"
             String
"File with commands to execute at start; replaces ~/.ihaskell/rc.hs."

installPrefixFlag :: Flag Args
installPrefixFlag :: Flag Args
installPrefixFlag = forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"prefix"] ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
KernelspecInstallPrefix) String
"<install-dir>"
                      String
"Installation prefix for kernelspec (see Jupyter's --prefix option)"

helpFlag :: Flag Args
helpFlag :: Flag Args
helpFlag = forall a. (a -> a) -> Flag a
flagHelpSimple (Argument -> Args -> Args
add Argument
Help)

add :: Argument -> Args -> Args
add :: Argument -> Args -> Args
add Argument
flag (Args IHaskellMode
md [Argument]
flags) = IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md forall a b. (a -> b) -> a -> b
$ Argument
flag forall a. a -> [a] -> [a]
: [Argument]
flags

store :: (String -> Argument) -> String -> Args -> Either String Args
store :: (String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
constructor String
str (Args IHaskellMode
md [Argument]
prev) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md forall a b. (a -> b) -> a -> b
$ String -> Argument
constructor String
str forall a. a -> [a] -> [a]
: [Argument]
prev

installKernelSpec :: Mode Args
installKernelSpec :: Mode Args
installKernelSpec =
  forall a. String -> a -> String -> Arg a -> [Flag a] -> Mode a
mode String
"install" (IHaskellMode -> [Argument] -> Args
Args IHaskellMode
InstallKernelSpec []) String
"Install the Jupyter kernelspec." forall a. Arg a
noArgs
    [Flag Args
ghcLibFlag, Flag Args
ghcRTSFlag, Flag Args
kernelDebugFlag, Flag Args
kernelNameFlag, Flag Args
displayNameFlag, Flag Args
confFlag, Flag Args
installPrefixFlag, Flag Args
helpFlag, Flag Args
kernelStackFlag, Flag Args
kernelEnvFileFlag]

kernel :: Mode Args
kernel :: Mode Args
kernel = forall a. String -> a -> String -> Arg a -> [Flag a] -> Mode a
mode String
"kernel" (IHaskellMode -> [Argument] -> Args
Args (Maybe String -> IHaskellMode
Kernel forall a. Maybe a
Nothing) []) String
"Invoke the IHaskell kernel." Arg Args
kernelArg
           [Flag Args
ghcLibFlag
           , Flag Args
kernelDebugFlag
           , Flag Args
confFlag
           , Flag Args
kernelStackFlag
           , Flag Args
kernelEnvFileFlag
           , Flag Args
kernelCodeMirrorFlag
           , Flag Args
kernelHtmlCodeWrapperClassFlag
           , Flag Args
kernelHtmlCodeTokenPrefixFlag
           ]
  where
    kernelArg :: Arg Args
kernelArg = forall a. Update a -> String -> Arg a
flagArg forall {a}. String -> Args -> Either a Args
update String
"<json-kernel-file>"
    update :: String -> Args -> Either a Args
update String
filename (Args IHaskellMode
_ [Argument]
flags) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ IHaskellMode -> [Argument] -> Args
Args (Maybe String -> IHaskellMode
Kernel forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
filename) [Argument]
flags

convert :: Mode Args
convert :: Mode Args
convert = forall a. String -> a -> String -> Arg a -> [Flag a] -> Mode a
mode String
"convert" (IHaskellMode -> [Argument] -> Args
Args IHaskellMode
ConvertLhs []) String
description Arg Args
unnamedArg [Flag Args]
convertFlags
  where
    description :: String
description = String
"Convert between Literate Haskell (*.lhs) and Ipython notebooks (*.ipynb)."
    convertFlags :: [Flag Args]
convertFlags = [ forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"input", String
"i"] ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
ConvertFrom) String
"<file>" String
"File to read."
                   , forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"output", String
"o"] ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
ConvertTo) String
"<file>" String
"File to write."
                   , forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"from", String
"f"] ((NotebookFormat -> Argument)
-> String -> Args -> Either String Args
storeFormat NotebookFormat -> Argument
ConvertFromFormat) String
"lhs|ipynb"
                       String
"Format of the file to read."
                   , forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"to", String
"t"] ((NotebookFormat -> Argument)
-> String -> Args -> Either String Args
storeFormat NotebookFormat -> Argument
ConvertToFormat) String
"lhs|ipynb"
                       String
"Format of the file to write."
                   , forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"force"] Args -> Args
consForce String
"Overwrite existing files with output."
                   , forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"style", String
"s"] String -> Args -> Either String Args
storeLhs String
"bird|tex"
                       String
"Type of markup used for the literate haskell file"
                   , forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"bird"] (LhsStyle String -> Args -> Args
consStyle LhsStyle String
lhsStyleBird) String
"Literate haskell uses >"
                   , forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"tex"] (LhsStyle String -> Args -> Args
consStyle LhsStyle String
lhsStyleTex) String
"Literate haskell uses \\begin{code}"
                   , Flag Args
helpFlag
                   ]

    consForce :: Args -> Args
consForce (Args IHaskellMode
md [Argument]
prev) = IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md (Argument
OverwriteFiles forall a. a -> [a] -> [a]
: [Argument]
prev)
    unnamedArg :: Arg Args
unnamedArg = forall a. Update a -> String -> Bool -> Arg a
Arg ((String -> Argument) -> String -> Args -> Either String Args
store String -> Argument
ConvertFrom) String
"<file>" Bool
False
    consStyle :: LhsStyle String -> Args -> Args
consStyle LhsStyle String
style (Args IHaskellMode
md [Argument]
prev) = IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md (LhsStyle String -> Argument
ConvertLhsStyle LhsStyle String
style forall a. a -> [a] -> [a]
: [Argument]
prev)

    storeFormat :: (NotebookFormat -> Argument)
-> String -> Args -> Either String Args
storeFormat NotebookFormat -> Argument
constructor String
str (Args IHaskellMode
md [Argument]
prev) =
      case Text -> Text
T.toLower (String -> Text
T.pack String
str) of
        Text
"lhs"   -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md forall a b. (a -> b) -> a -> b
$ NotebookFormat -> Argument
constructor NotebookFormat
LhsMarkdown forall a. a -> [a] -> [a]
: [Argument]
prev
        Text
"ipynb" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ IHaskellMode -> [Argument] -> Args
Args IHaskellMode
md forall a b. (a -> b) -> a -> b
$ NotebookFormat -> Argument
constructor NotebookFormat
IpynbFile forall a. a -> [a] -> [a]
: [Argument]
prev
        Text
_       -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unknown format requested: " forall a. [a] -> [a] -> [a]
++ String
str

    storeLhs :: String -> Args -> Either String Args
storeLhs String
str Args
previousArgs =
      case Text -> Text
T.toLower (String -> Text
T.pack String
str) of
        Text
"bird" -> forall {a}. LhsStyle String -> Either a Args
success LhsStyle String
lhsStyleBird
        Text
"tex"  -> forall {a}. LhsStyle String -> Either a Args
success LhsStyle String
lhsStyleTex
        Text
_      -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unknown lhs style: " forall a. [a] -> [a] -> [a]
++ String
str
      where
        success :: LhsStyle String -> Either a Args
success LhsStyle String
lhsStyle = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ LhsStyle String -> Args -> Args
consStyle LhsStyle String
lhsStyle Args
previousArgs

lhsStyleBird, lhsStyleTex :: LhsStyle String
lhsStyleBird :: LhsStyle String
lhsStyleBird = forall string.
string
-> string
-> string
-> string
-> string
-> string
-> LhsStyle string
LhsStyle String
"> " String
"\n<< " String
"" String
"" String
"" String
""

lhsStyleTex :: LhsStyle String
lhsStyleTex = forall string.
string
-> string
-> string
-> string
-> string
-> string
-> LhsStyle string
LhsStyle String
"" String
"" String
"\\begin{code}" String
"\\end{code}" String
"\\begin{verbatim}" String
"\\end{verbatim}"

ihaskellArgs :: Mode Args
ihaskellArgs :: Mode Args
ihaskellArgs =
  let noMode :: Mode Args
noMode = forall a. String -> a -> String -> Arg a -> [Flag a] -> Mode a
mode String
"IHaskell" Args
defaultReport String
descr forall a. Arg a
noArgs [Flag Args
helpFlag, Flag Args
versionFlag]
      defaultReport :: Args
defaultReport = IHaskellMode -> [Argument] -> Args
Args (String -> IHaskellMode
ShowDefault String
helpStr) []
      descr :: String
descr = String
"Haskell for Interactive Computing."
      versionFlag :: Flag Args
versionFlag = forall a. (a -> a) -> Flag a
flagVersion (Argument -> Args -> Args
add Argument
Version)
      helpStr :: String
helpStr = TextFormat -> [Text] -> String
showText (Int -> TextFormat
Wrap Int
100) forall a b. (a -> b) -> a -> b
$ forall a. [String] -> HelpFormat -> Mode a -> [Text]
helpText [] HelpFormat
HelpFormatAll Mode Args
ihaskellArgs
  in Mode Args
noMode { modeGroupModes :: Group (Mode Args)
modeGroupModes = forall a. [a] -> Group a
toGroup [Mode Args]
allModes }

noArgs :: Arg a
noArgs :: forall a. Arg a
noArgs = forall a. Update a -> String -> Arg a
flagArg forall {a}. String -> a
unexpected String
""
  where
    unexpected :: String -> a
unexpected String
a = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unexpected argument: " forall a. [a] -> [a] -> [a]
++ String
a