diff --git a/ghc-mod.cabal b/ghc-mod.cabal
index 7c52d46..0f4c39e 100644
--- a/ghc-mod.cabal
+++ b/ghc-mod.cabal
@@ -193,6 +193,7 @@ Executable ghc-mod
, GHCMod.Version
, GHCMod.Options.DocUtils
, GHCMod.Options.ShellParse
+ , GHCMod.Options.Help
GHC-Options: -Wall -fno-warn-deprecations -threaded
Default-Extensions: ConstraintKinds, FlexibleContexts
HS-Source-Dirs: src
diff --git a/src/GHCMod/Options/Commands.hs b/src/GHCMod/Options/Commands.hs
index 1a774a6..0a6adb7 100644
--- a/src/GHCMod/Options/Commands.hs
+++ b/src/GHCMod/Options/Commands.hs
@@ -13,14 +13,18 @@
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see .
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
+
module GHCMod.Options.Commands where
import Options.Applicative
import Options.Applicative.Types
import Options.Applicative.Builder.Internal
import Language.Haskell.GhcMod.Types
-import GHCMod.Options.DocUtils
import Language.Haskell.GhcMod.Read
+import GHCMod.Options.DocUtils
+import GHCMod.Options.Help
type Symbol = String
type Expr = String
@@ -71,12 +75,14 @@ commands =
$$ progDesc "List GHC -f flags"
<> command "debug"
$$ info (pure CmdDebug)
- $$ progDesc
- "Print debugging information. Please include the output in any bug\
- \ reports you submit"
+ $$ progDesc' $$$ do
+ "Print debugging information. Please include"
+ \\ "the output in any bug reports you submit"
<> command "debug-component"
$$ info debugComponentArgSpec
- $$ progDesc "Debugging information related to cabal component resolution"
+ $$ progDesc' $$$ do
+ "Debugging information related to cabal component"
+ \\ "resolution"
<> command "boot"
$$ info (pure CmdBoot)
$$ progDesc "Internal command used by the emacs frontend"
@@ -84,12 +90,14 @@ commands =
-- $$ info (pure CmdNukeCaches) idm
<> command "root"
$$ info (pure CmdRoot)
- $$ progDesc
- "Try to find the project directory. For Cabal projects this is the\
- \ directory containing the cabal file, for projects that use a cabal\
- \ sandbox but have no cabal file this is the directory containing the\
- \ cabal.sandbox.config file and otherwise this is the current\
- \ directory"
+ $$ progDesc'
+ "Try to find the project directory."
+ <=> desc $$$ do
+ "For Cabal projects this is the"
+ \\ "directory containing the cabal file, for projects"
+ \\ "that use a cabal sandbox but have no cabal file"
+ \\ "this is the directory containing the cabal.sandbox.config"
+ \\ "file and otherwise this is the current directory"
<> command "legacy-interactive"
$$ info legacyInteractiveArgSpec
$$ progDesc "ghc-modi compatibility mode"
@@ -106,7 +114,9 @@ commands =
$$ progDesc "List all modules that define SYMBOL"
<> command "doc"
$$ info docArgSpec
- $$ progDesc "Try finding the html documentation directory for the given MODULE"
+ $$ progDesc' $$$ do
+ "Try finding the html documentation directory"
+ \\ "for the given MODULE"
<> command "lint"
$$ info lintArgSpec
$$ progDesc "Check files using `hlint'"
@@ -115,18 +125,17 @@ commands =
$$ progDesc "List symbols in a module"
<> command "check"
$$ info checkArgSpec
- $$ progDesc
- "Load the given files using GHC and report errors/warnings,\
- \ but don't produce output files"
+ $$ progDesc' $$$ do
+ "Load the given files using GHC and report errors/warnings,"
+ \\ "but don't produce output files"
<> command "expand"
$$ info expandArgSpec
$$ progDesc "Like `check' but also pass `-ddump-splices' to GHC"
<> command "info"
$$ info infoArgSpec
- $$ progDesc
- "Look up an identifier in the context of FILE (like ghci's `:info')\
- \ MODULE is completely ignored and only allowed for backwards\
- \ compatibility"
+ $$ progDesc' $$$ do
+ "Look up an identifier in the context"
+ \\ "of FILE (like ghci's `:info')"
<> command "type"
$$ info typeArgSpec
$$ progDesc "Get the type of the expression under (LINE,COL)"
@@ -134,50 +143,44 @@ commands =
$$ info splitArgSpec
$$ progDesc
"Split a function case by examining a type's constructors"
- <=> desc [
- text "For example given the following code snippet:"
- , code [
- "f :: [a] -> a"
- , "f x = _body"
- ]
- , text "would be replaced by:"
- , code [
- "f :: [a] -> a"
- , "f [] = _body"
- , "f (x:xs) = _body"
- ]
- , text "(See https://github.com/kazu-yamamoto/ghc-mod/pull/274)"
- ]
+ <=> desc $$$ do
+ "For example given the following code snippet:"
+ code $ do
+ "f :: [a] -> a"
+ "f x = _body"
+ "would be replaced by:"
+ code $ do
+ "f :: [a] -> a"
+ "f [] = _body"
+ "f (x:xs) = _body"
+ "(See https://github.com/kazu-yamamoto/ghc-mod/pull/274)"
<> command "sig"
$$ info sigArgSpec
$$ progDesc "Generate initial code given a signature"
- <=> desc [
- text "For example when (LINE,COL) is on the signature in the following\
- \ code snippet:"
- , code ["func :: [a] -> Maybe b -> (a -> b) -> (a,b)"]
- , text "ghc-mod would add the following on the next line:"
- , code ["func x y z f = _func_body"]
- , text "(See: https://github.com/kazu-yamamoto/ghc-mod/pull/274)"
- ]
+ <=> desc $$$ do
+ "For example when (LINE,COL) is on the"
+ \\ "signature in the following code snippet:"
+ code "func :: [a] -> Maybe b -> (a -> b) -> (a,b)"
+ "ghc-mod would add the following on the next line:"
+ code "func x y z f = _func_body"
+ "(See: https://github.com/kazu-yamamoto/ghc-mod/pull/274)"
<> command "auto"
$$ info autoArgSpec
$$ progDesc "Try to automatically fill the contents of a hole"
<> command "refine"
$$ info refineArgSpec
$$ progDesc "Refine the typed hole at (LINE,COL) given EXPR"
- <=> desc [
- text "For example if EXPR is `filter', which has type `(a -> Bool) -> [a]\
- \ -> [a]' and (LINE,COL) is on the hole `_body' in the following\
- \ code snippet:"
- , code [
- "filterNothing :: [Maybe a] -> [a]"
- , "filterNothing xs = _body"
- ]
- , text "ghc-mod changes the code to get a value of type `[a]', which\
- \ results in:"
- , code [ "filterNothing xs = filter _body_1 _body_2" ]
- , text "(See also: https://github.com/kazu-yamamoto/ghc-mod/issues/311)"
- ]
+ <=> desc $$$ do
+ "For example if EXPR is `filter', which has type"
+ \\ "`(a -> Bool) -> [a] -> [a]' and (LINE,COL) is on"
+ \\ " the hole `_body' in the following code snippet:"
+ code $ do
+ "filterNothing :: [Maybe a] -> [a]"
+ "filterNothing xs = _body"
+ "ghc-mod changes the code to get a value of type"
+ \\ " `[a]', which results in:"
+ code "filterNothing xs = filter _body_1 _body_2"
+ "(See also: https://github.com/kazu-yamamoto/ghc-mod/issues/311)"
interactiveCommandsSpec :: Parser GhcModCommands
interactiveCommandsSpec =
@@ -186,14 +189,17 @@ interactiveCommandsSpec =
<> command "map-file"
$$ info (helper <*> mapArgSpec)
$$ progDesc "tells ghc-modi to read `file.hs` source from stdin"
- <=> footer "File end marker is `\\n\\EOT\\n`,\
- \ i.e. `\\x0A\\x04\\x0A`. `file.hs` may or may not exist, and should be\
- \ either full path, or relative to project root."
+ <=> desc $$$ do
+ "Works the same as second form of"
+ \\ "`--map-file` CLI option."
<> command "unmap-file"
$$ info (helper <*> unmapArgSpec)
- $$ progDesc "unloads previously mapped file, so that it's no longer mapped."
- <=> footer "`file.hs` can be full path or relative to\
- \ project root, either will work."
+ $$ progDesc' $$$ do
+ "unloads previously mapped file,"
+ \\ "so that it's no longer mapped."
+ <=> desc $$$ do
+ "`file.hs` can be full path or relative"
+ \\ "to project root, either will work."
<> command "quit"
$$ info (pure CmdQuit)
$$ progDesc "Exit interactive mode"
diff --git a/src/GHCMod/Options/DocUtils.hs b/src/GHCMod/Options/DocUtils.hs
index dd5122d..4adcf2b 100644
--- a/src/GHCMod/Options/DocUtils.hs
+++ b/src/GHCMod/Options/DocUtils.hs
@@ -15,10 +15,8 @@
-- along with this program. If not, see .
module GHCMod.Options.DocUtils (
- module PP,
- desc,
- code,
($$),
+ ($$$),
(<=>),
(<$$>),
(<||>)
@@ -26,22 +24,19 @@ module GHCMod.Options.DocUtils (
import Options.Applicative
import Data.Monoid (Monoid) -- for ghc<7.10
-import Options.Applicative.Help.Pretty as PP hiding ((<$$>), int)
-desc :: [Doc] -> InfoMod a
-desc = footerDoc . Just . indent 2 . vsep
-
-code :: [String] -> Doc
-code x = vsep [line, indent 4 $ vsep $ map text x, line]
-
-infixl 7 <||>
-infixr 8 <$$>
-infixr 8 $$
-infixr 9 <=>
+infixl 6 <||>
+infixr 7 <$$>
+infixr 7 $$
+infixr 8 <=>
+infixr 9 $$$
($$) :: (a -> b) -> a -> b
($$) = ($)
+($$$) :: (a -> b) -> a -> b
+($$$) = ($)
+
(<||>) :: Alternative a => a b -> a b -> a b
(<||>) = (<|>)
diff --git a/src/GHCMod/Options/Help.hs b/src/GHCMod/Options/Help.hs
new file mode 100644
index 0000000..2a81e16
--- /dev/null
+++ b/src/GHCMod/Options/Help.hs
@@ -0,0 +1,67 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015 Nikolay Yakimov
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program. If not, see .
+{-# LANGUAGE OverloadedStrings, FlexibleInstances, GeneralizedNewtypeDeriving #-}
+
+module GHCMod.Options.Help where
+
+import Options.Applicative
+import Options.Applicative.Help.Pretty (Doc)
+import qualified Options.Applicative.Help.Pretty as PP
+import Control.Monad.State
+import GHC.Exts( IsString(..) )
+import Data.Maybe
+
+newtype MyDocM s a = MyDoc {unwrapState :: State s a}
+ deriving (Monad, Functor, Applicative, MonadState s)
+type MyDoc = MyDocM (Maybe Doc) ()
+
+instance IsString (MyDocM (Maybe Doc) a) where
+ fromString = append . para
+
+para :: String -> Doc
+para = PP.fillSep . map PP.text . words
+
+append :: Doc -> MyDocM (Maybe Doc) a
+append s = modify' m >> return undefined
+ where
+ m :: Maybe Doc -> Maybe Doc
+ m Nothing = Just s
+ m (Just old) = Just $ old PP..$. s
+
+infixr 7 \\
+(\\) :: MyDoc -> MyDoc -> MyDoc
+(\\) a b = append $ doc a PP.<+> doc b
+
+doc :: MyDoc -> Doc
+doc = fromMaybe PP.empty . flip execState Nothing . unwrapState
+
+help' :: MyDoc -> Mod f a
+help' = helpDoc . Just . doc
+
+desc :: MyDoc -> InfoMod a
+desc = footerDoc . Just . doc . indent 2
+
+code :: MyDoc -> MyDoc
+code x = do
+ _ <- " "
+ indent 4 x
+ " "
+
+progDesc' :: MyDoc -> InfoMod a
+progDesc' = progDescDoc . Just . doc
+
+indent :: Int -> MyDoc -> MyDoc
+indent n = append . PP.indent n . doc