Commit b1524192 authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Update the 'pattern' command to be able to show patterns

parent 9e19baba
No preview for this file type
......@@ -31,5 +31,5 @@ fi
get_url "$curly_url" | { mkdir -p "$install_dir"; trace tar -xJ --checkpoint=40 --checkpoint-action=dot -C "$install_dir"; }
if [ -n "$bin_dir" ]; then
mkdir -p "$bin_dir"
trace ln -fs "$install_dir/curly-0.59.1/curly" "$bin_dir/curly"
trace ln -fs "$install_dir/curly-0.59.1.1/curly" "$bin_dir/curly"
fi
......@@ -206,6 +206,8 @@ localServer hasLocalClient thr acc conn@(Connection clt srv) = do
["repository","branch",_,c,u] | c`elem`["fork","alias"] -> completeKeyName u
["repository","branch",_,c,u,b] | c`elem`["fork","alias"] -> completeBranchName u b
("repository":_) -> []
["clean",p] -> completeAbsPath w False p
["pattern",p] -> completeWord (keys pats) p
["configure",p] -> completeWord [show n+":"+s | (n,s) <- zip [0..] (curlyFiles ?curlyConfig)] p
["compareTypes",x] -> completeWord ["shape","constraints"] x
["cd",p] -> completeAbsPath w True p
......
......@@ -13,9 +13,12 @@ import Curly.Session.Commands.Common
cleanCmd,metaCmd,reloadCmd,fixCmd :: Interactive Command
cleanDoc = "{section {title Clean Cache} Removes all cache files}"
cleanCmd = withDoc cleanDoc $ False <$ liftIO (do sequence_ [clean c | (_,Source _ _ c) <- ?curlyPlex^.mounts]
sequence_ [clean c | (_,Resource _ c) <- ?curlyPlex^.mounts])
cleanDoc = "{section {title Clean Cache} {p {em Usage:} clean {em OR} clean PATH} {p Removes all cache files under PATH.}}"
cleanCmd = withDoc cleanDoc $ False <$ do
base <- option' [] (nbhspace >> absPath [])
let isPrefixOf p p' = take (length p) p' == p
liftIO (do sequence_ [clean c | (p,Source _ _ c) <- ?curlyPlex^.mounts, base`isPrefixOf`p]
sequence_ [clean c | (p,Resource _ c) <- ?curlyPlex^.mounts, base`isPrefixOf`p])
where clean c = do
x <- getFile c
forl_ (descendant.fileAttrs.relPath) x $ \p -> case c+p of
......
......@@ -93,8 +93,19 @@ showCmd = withDoc showDoc . fill False $ do
] zero
serveStrLn (docString ?terminal ?style (fromMaybe (nodoc $ "Cannot show pattern "+showRawDoc pat)
(evalDocWithPatterns ?patterns params pat)))
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
patternDoc = unlines [
"{section {title Define Formatting Patterns} {p {em Usage:} pattern NAME ARG... = PATTERN {em OR} pattern NAME}",
" {p Defines a new query pattern accessible with \\{pattern PATTERN PARAM...\\}}",
" {p If you only specify the pattern name, its current definition will be printed instead.}}"]
patternCmd = withDoc patternDoc . fill False $ do
ph:pt <- many1' (nbhspace >> dirArg <*= guard . (/="="))
between nbhspace nbhspace (several "=")
pat <- docLine "pat" []
liftIO $ runAtomic ?sessionState (patterns.at ph =- Just (pt,pat))
let setPat = do
between nbhspace nbhspace (several "=")
pat <- docLine "pat" []
liftIO $ runAtomic ?sessionState (patterns.at ph =- Just (pt,pat))
showPat = do
pat <- liftIO $ runAtomic ?sessionState (getl (patterns.at ph))
case pat of
Just (_,pat) -> serveStrLn (format "pattern %s%s = %s" ph (foldMap (" "+) pt) (showRawDoc pat))
Nothing -> serveStrLn (format "The pattern %s doesn't exist." ph)
setPat <+? showPat
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