Commit 828f754f authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Version bump: curly 0.58

parent 9fc537a8
......@@ -2,7 +2,7 @@
-- see http://haskell.org/cabal/users-guide/
name: curly
version: 0.57.1
version: 0.58
-- synopsis:
-- description:
license: MIT
......@@ -70,4 +70,4 @@ executable curly
GeneralizedNewtypeDeriving
RankNTypes
TypeFamilies
build-depends: base >=4.9 && <4.10,cryptohash >=0.11 && <0.12,curly >=0.57 && <0.58,curly-core >=0.5 && <0.6,curly-system >=0.3 && <0.4,curly-terminfo >=0.4 && <0.5,deepseq >=1.4 && <1.5,definitive-base >=2.6 && <2.7,definitive-filesystem >=2.1 && <2.2,definitive-network >=1.4 && <1.5,definitive-parser >=2.5 && <2.6,directory >=1.3 && <1.4,filepath >=1.4 && <1.5,process >=1.4 && <1.5,readline >=1.0 && <1.1,unix >=2.7 && <2.8
build-depends: base >=4.9 && <4.10,cryptohash >=0.11 && <0.12,curly >=0.58 && <0.59,curly-core >=0.5 && <0.6,curly-system >=0.3 && <0.4,curly-terminfo >=0.4 && <0.5,deepseq >=1.4 && <1.5,definitive-base >=2.6 && <2.7,definitive-filesystem >=2.1 && <2.2,definitive-network >=1.4 && <1.5,definitive-parser >=2.5 && <2.6,directory >=1.3 && <1.4,filepath >=1.4 && <1.5,process >=1.4 && <1.5,readline >=1.0 && <1.1,unix >=2.7 && <2.8
......@@ -153,8 +153,8 @@ localServer hasLocalClient thr acc conn@(Connection clt srv) = do
else if not onlyDirs
then [[s']] else []]
Nothing -> []
completeAbsPath _ ('.':p) = map ('.':) $ completePath [] True p
completeAbsPath b p = completePath b True p
completeAbsPath _ x ('.':p) = map ('.':) $ completePath [] x p
completeAbsPath b x p = completePath b x p
completeWord l s = [s' | s' <- l, s`isPrefix`s']
completeCommand = completeWord (commandNames + ["import","define","type","family"])
completeKeyName = completeWord (keys ks)
......@@ -186,8 +186,8 @@ localServer hasLocalClient thr acc conn@(Connection clt srv) = do
["key","del","client",k] -> completeClientKeyName k
["key","del","server",k] -> completeKeyName k
("key":_) -> []
["format",k] -> completeWord [p | (p,Pure _) <- pats^.ascList] k
["format",_,p] -> completePath w False p
["show",p] -> completeAbsPath w False p
["show",_,k] -> completeWord [p | (p,Pure _) <- pats^.ascList] k
["vcs",c] -> completeWord ["list","get","commit","checkout","branch"] c
["vcs","list",k] -> completeKeyName k
["vcs","list",k,b] -> completeBranchName k b
......@@ -197,15 +197,15 @@ localServer hasLocalClient thr acc conn@(Connection clt srv) = do
["vcs","branch",_,c,u] | c`elem`["fork","link"] -> completeKeyName u
["vcs","branch",_,c,u,b] | c`elem`["fork","link"] -> completeBranchName u b
["vcs","commit",b] -> completeBranchName curlyPublisher b
["vcs","commit",_,p] -> completePath w False p
["vcs","commit",_,p] -> completeAbsPath w False p
("vcs":_) -> []
["configure",p] -> completeWord [show n+":"+s | (n,s) <- curlyFiles ?curlyConfig^.ascList] p
["repository",cmd] -> completeWord ["list","add","contents","browse"] cmd
("repository":_) -> []
["compareTypes",x] -> completeWord ["shape","constraints"] x
["cd",p] -> completeAbsPath w p
("import":t) -> completePath [] False (last t)
(_:t) -> completePath w False (last t)
["cd",p] -> completeAbsPath w True p
("import":t) -> completeAbsPath [] False (last t)
(_:t) -> completeAbsPath w False (last t)
return True
EndOfTransmission -> return False
BannerRequest b -> True <$ do
......
......@@ -37,19 +37,10 @@ import Curly.Session.Commands.VCS
commands :: Interactive [(String,[(String,Command)])]
commands = [
("Control",[
("key",keyCmd),
("clean",cleanCmd),
("configure",configCmd),
("fix",fixCmd),
("repository",repoCmd),
("vcs",vcsCmd),
("quit",quitCmd),
("kill-server",killCmd)]),
("Navigation",[
("cd",cdCmd),
("ls",lsCmd),
("edit",editCmd),
("tree",treeCmd),
("wd",wdCmd)]),
......@@ -57,20 +48,23 @@ commands = [
("help",helpCmd),
("meta",metaCmd),
("style",styleCmd),
("why",whyCmd),
("how",howCmd),
("what",whatCmd),
("whence",whenceCmd),
("pattern",patternCmd),
("format",formatCmd),
("show",showCmd),
("compareTypes",compareTypesCmd),
("showInstances",showInstancesCmd),
("where",whereCmd)]),
("Utilities",[
("instances",showInstancesCmd)]),
("Control",[
("key",keyCmd),
("clean",cleanCmd),
("reload",reloadCmd),
("run",runCmd)])
]
("configure",configCmd),
("run",runCmd),
("fix",fixCmd),
("repository",repoCmd),
("vcs",vcsCmd),
("quit",quitCmd),
("kill-server",killCmd)])]
commandNames :: [String]
commandNames = let
?sessionState = undefined
......@@ -170,7 +164,7 @@ interactiveSession ack = while sessionLine
parseCmd = hspace >> do
e <- optimized =<< accessorExpr HorizSpaces
lookingAt (hspace >> eol)
serveHow e
serveStrLn (showImpl e)
return False
cmdLine = do
s <- remaining
......
......@@ -127,4 +127,5 @@ dirArg :: (MonadParser s m p, ParseStream c s, TokenPayload c ~ Char, Monad m) =
dirArg = many1' $ noneOf " \t\n(){}"
absPath :: (?sessionState :: IORef SessionState, MonadParser s m p, ParseStream c s, TokenPayload c ~ Char, Monad m, MonadIO p)
=> String -> p [String]
absPath lim = liftA2 subPath (getSession wd) (symPath lim)
absPath lim = (single '.' >> symPath lim)
<+? (liftA2 subPath (getSession wd) (symPath lim))
......@@ -45,12 +45,8 @@ cdDoc = unlines [
]
cdCmd = withDoc cdDoc (fill False $ withargs <+? noarg)
where noarg = liftIO (modifyIORef ?sessionState (wd %- []))
inRoot m = do
old <- liftIO $ runAtomic ?sessionState (wd <~ \x -> ([],x))
m <* liftIO (modifyIORef ?sessionState (set wd old))
withargs = nbhspace >> do
isAbs <- option' False (True <$ single '.')
newpath <- (if isAbs then inRoot else id) (absPath "")
newpath <- absPath ""
withMountain $ do
let m = c'list (localContext^??atMs newpath)
liftIOWarn $ if nonempty (fold $ c'list (m^??each.t'Join))
......
......@@ -11,7 +11,19 @@ import Curly.Style
import Language.Format hiding (space)
import Curly.Session.Commands.Common
whereCmd,whyCmd,whenceCmd,whatCmd,howCmd,formatCmd,patternCmd :: Interactive Command
editCmd,showCmd,patternCmd :: Interactive Command
data VerboseVar = VerboseVar GlobalID (Maybe Int)
instance Documented VerboseVar where
document (VerboseVar v n) = Pure $ pretty v+maybe "" (\x -> "["+show x+"]") n
showImpl v | envLogLevel>=Verbose = pretty (map withSym (semantic v) :: Expression GlobalID VerboseVar)
| otherwise = pretty (map fst (semantic v) :: Expression GlobalID GlobalID)
where withSym (s,Pure (Argument n)) = VerboseVar s (Just n)
withSym (s,_) = VerboseVar s Nothing
rangeFile :: Traversal' SourceRange String
rangeFile k (SourceRange (Just s) a b) = k s <&> \s' -> SourceRange (Just s') a b
rangeFile _ x = pure x
viewCmd doc onExpr onPath showV = withDoc doc . fill False $ (several "'s" >> viewSym) <+? viewPath
where viewPath = nbsp >> do
......@@ -28,61 +40,12 @@ viewCmd doc onExpr onPath showV = withDoc doc . fill False $ (several "'s" >> vi
Just s -> showV [] s
_ -> serveStrLn $ "Error: "+n+": no such symbol."
whyDoc = unlines [
"{section {title Show Function Documentation}"
,"{p {em Usage:} why PATH {em OR} why's NAME}"
,"{p Show the documentation for the function at PATH, or of the symbol NAME.}}"
]
whyCmd = viewCmd whyDoc zero (const zero) $ \_ (by leafDoc -> d) ->
withStyle (serveStrLn $ docString ?terminal ?style d)
whenceDoc = unlines [
"{section {title Show Function Strictness}"
,"{p {em Usage:} whence PATH {em OR} whence's NAME}"
,"{p Show the strictness for the function at PATH, or of the symbol NAME.}}"
]
whenceCmd = viewCmd whenceDoc zero (const zero) $ \_ (by leafVal -> v) ->
serveStrLn (pretty (snd $ exprStrictness v))
howDoc = unlines [
"{section {title Show Function Implementation}"
,"{p {em Usage:} how PATH {em OR} how's EXPR}"
,"{p Show the implementation of the function at PATH, or an expression EXPR in the local context.}}"
]
data VerboseVar = VerboseVar GlobalID (Maybe Int)
instance Documented VerboseVar where
document (VerboseVar v n) = Pure $ pretty v+maybe "" (\x -> "["+show x+"]") n
serveHow v | envLogLevel>=Verbose = serveStrLn (pretty (map withSym (semantic v) :: Expression GlobalID VerboseVar))
| otherwise = serveStrLn (pretty (map fst (semantic v) :: Expression GlobalID GlobalID))
where withSym (s,Pure (Argument n)) = VerboseVar s (Just n)
withSym (s,_) = VerboseVar s Nothing
howCmd = viewCmd howDoc onExpr (const zero) $ \_ (by leafVal -> v) -> serveHow v
where onExpr = do
e <- optimized =<< accessorExpr HorizSpaces
serveHow e
whatDoc = unlines [
"{section {title Show Function Type}"
,"{p {em Usage:} what PATH {em OR} what's EXPR}"
,"{p Show the type of the function at PATH, or an expression EXPR in the local context.}}"
]
whatCmd = viewCmd whatDoc onExpr (const zero) $ \_ (by leafVal -> v) -> serveWhat v
where serveWhat v = serveStrLn (show (exprType v))
onExpr = do
e <- optimized =<< accessorExpr HorizSpaces
serveWhat e
rangeFile :: Traversal' SourceRange String
rangeFile k (SourceRange (Just s) a b) = k s <&> \s' -> SourceRange (Just s') a b
rangeFile _ x = pure x
whereDoc = unlines [
"{section {title Go To Function}"
,"{p {em Usage:} where PATH}"
editDoc = unlines [
"{section {title Edit Function}"
,"{p {em Usage:} edit PATH}"
,"{p Start an editing session for the function at PATH.}}"
]
whereCmd = viewCmd whereDoc zero onPath $ \path (by leafPos -> r) -> case r of
editCmd = viewCmd editDoc zero onPath $ \path (by leafPos -> r) -> case r of
SourceRange (Just f) (_,l,c) _ -> editSource f (l,c) reloadMountain
_ -> serveStrLn $ "No source position available for "+showPath path
where onPath p = withMountain $ do
......@@ -90,22 +53,24 @@ whereCmd = viewCmd whereDoc zero onPath $ \path (by leafPos -> r) -> case r of
Just s -> liftIOWarn $ editSource s (0,0) reloadMountain
_ -> zero
formatDoc = "{section {title Formatted Query} {p {em Usage:} format PATTERN PATH} {p Show the function at PATH according to the pattern PAT}}"
formatCmd = withDoc formatDoc . fill False $ do
pat <- nbhspace >> ((docAtom <*= guard . has t'Join) <+? map (docTag' "pattern" . pure . Pure) dirArg)
path <- nbhspace >> absPath ""
showDoc = "{section {title Formatted Query} {p {em Usage:} show PATH PATTERN} {p Show the function at PATH according to the given pattern}}"
showCmd = withDoc showDoc . fill False $ do
path <- (nbhspace >> ((several "{}" >> getSession wd) <+? absPath ""))
<+? getSession wd
pat <- option' (docTag' "pattern" [Pure "default"])
(nbhspace >> ((docAtom <*= guard . has t'Join) <+? map (docTag' "pattern" . pure . Pure) dirArg))
withMountain $ let ctx = fold $ c'list $ localContext^??atMs path in do
let params (n,v) = let Join p = composing (uncurry insert) [
(["type"],Pure $ document (exprType (v^.leafVal))),
(["name"],Pure $ Pure (identName n)),
(["name"],Pure $ Pure $ identName n),
(["doc"],Pure $ v^.leafDoc),
(["impl"],Pure $ Pure $ showImpl (v^.leafVal)),
(["strictness"],Pure $ document (snd $ exprStrictness $ v^.leafVal))
] zero
in p
withStyle $ withPatterns $ serveStrLn (docString ?terminal ?style (document (map (\v -> fromMaybe (nodoc (format "Unmatched pattern %s" (show pat))) (evalDocWithPatterns ?patterns (params v) pat)) ctx)))
patternCmd = withDoc "{section {title Define Patterns} {p {em Usage:} pattern PATH = PATTERN} {p Defines a new query pattern accessible with \\{pattern PATH\\}}}" . fill False $ do
patternCmd = withDoc "{section {title Define Formatting Patterns} {p {em Usage:} pattern PATH = PATTERN} {p Defines a new query pattern accessible with \\{pattern PATH\\}}}" . fill False $ do
ph:pt <- many1' (nbhspace >> dirArg <*= guard . (/="="))
between nbhspace nbhspace (several "=")
pat <- docLine "pat" []
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment