hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Monadic pretty opt desc builder

This commit is contained in:
Nikolay Yakimov 2015-12-20 13:48:47 +03:00
parent 63f05508b8
commit 92f53f7b3b
4 changed files with 143 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ghc-mod.cabal
View File

@ -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

126
src/GHCMod/Options/Commands.hs
View File

@ -13,14 +13,18 @@
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# 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<foo> 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"

23
src/GHCMod/Options/DocUtils.hs
View File

@ -15,10 +15,8 @@
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
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
(<||>) = (<|>)

67
src/GHCMod/Options/Help.hs Normal file
View File

@ -0,0 +1,67 @@
-- ghc-mod: Making Haskell development *more* fun
-- Copyright (C) 2015 Nikolay Yakimov <root@livid.pp.ru>
--
-- 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 <http://www.gnu.org/licenses/>.
{-# 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