packages feed

language-bash 0.5.0 → 0.6.0

raw patch · 5 files changed

+185/−8 lines, 5 files

Files

language-bash.cabal view
@@ -1,5 +1,5 @@ name:               language-bash-version:            0.5.0+version:            0.6.0 category:           Language license:            BSD3 license-file:       LICENSE@@ -28,6 +28,7 @@    exposed-modules:     Language.Bash.Cond+    Language.Bash.Expand     Language.Bash.Parse     Language.Bash.Parse.Word     Language.Bash.Pretty
+ src/Language/Bash/Expand.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE LambdaCase, OverloadedStrings, PatternGuards #-}+-- | Shell expansions.+module Language.Bash.Expand+    ( braceExpand+    , TildePrefix(..)+    , tildePrefix+    , splitWord+    ) where++import Control.Applicative+import Control.Monad+import Data.Char+import Data.Traversable+import Text.Parsec.Combinator hiding (optional, manyTill)+import Text.Parsec.Prim       hiding ((<|>), many, token)+import Text.Parsec.String     ()+import Text.PrettyPrint       hiding (char)++import Language.Bash.Pretty+import Language.Bash.Word++-- | A parser over words.+type Parser = Parsec Word ()++-- | Run a 'Parser', failing on a parse error.+parseUnsafe :: String -> Parser a -> Word -> a+parseUnsafe f p w = case parse p (prettyText w) w of+    Left  e -> error $ "Language.Bash.Expand." ++ f ++ ": " ++ show e+    Right a -> a++-- | Parse a general token.+token :: (Span -> Maybe a) -> Parser a+token = tokenPrim (const "") (\pos _ _ -> pos)++-- | Parse an unquoted character satisfying a predicate.+satisfy :: (Char -> Bool) -> Parser Char+satisfy p = token $ \case+    Char c | p c -> Just c+    _            -> Nothing++-- | Parse a span that is not an unquoted character satisfying a predicate.+except :: (Char -> Bool) -> Parser Span+except p = token $ \case+    Char c | p c -> Nothing+    s            -> Just s++-- | Parse an unquoted character.+char :: Char -> Parser Char+char c = satisfy (== c)++-- | Parse an unquoted string.+string :: String -> Parser String+string = traverse char++-- | Parse one of the given characters.+oneOf :: [Char] -> Parser Char+oneOf cs = satisfy (`elem` cs)++-- | Parse anything but a quoted character.+noneOf :: [Char] -> Parser Span+noneOf cs = except (`elem` cs)++-- | Read a number.+readNumber :: MonadPlus m => String -> m Int+readNumber s = case reads (dropPlus s) of+    [(n, "")] -> return n+    _         -> mzero+  where+    dropPlus ('+':t) = t+    dropPlus t       = t++-- | Read a letter.+readAlpha :: MonadPlus m => String -> m Char+readAlpha [c] | isAlpha c = return c+readAlpha _               = mzero++-- | Create a list from a start value, an end value, and an increment.+enum :: (Ord a, Enum a) => a -> a -> Maybe Int -> [a]+enum x y inc = map toEnum [fromEnum x, fromEnum x + step .. fromEnum y]+  where+    step = case inc of+        Nothing | y > x     -> 1+                | otherwise -> 1+        Just i              -> i++-- | Brace expand a word.+braceExpand :: Word -> [Word]+braceExpand = parseUnsafe "braceExpand" (go "")+  where+    go delims = try (brace delims)+            <|> (:[]) <$> many (noneOf delims)++    brace delims = do+        a  <- many (noneOf ('{':delims))+        _  <- char '{'+        bs <- try sequenceExpand <|> braceParts+        _  <- char '}'+        cs <- go delims+        return [ a ++ b ++ c | b <- bs, c <- cs ]++    braceParts = concatParts <$> go ",}" `sepBy` char ','++    concatParts []   = ["{}"]+    concatParts [xs] = map (\x -> "{" ++ x ++ "}") xs+    concatParts xss  = concat xss++    sequenceExpand = do+        a   <- sequencePart+        b   <- string ".." *> sequencePart+        c   <- optional (string ".." *> sequencePart)+        inc <- traverse readNumber c+        map fromString <$> (numExpand a b inc <|> charExpand a b inc)+      where+        sequencePart = many1 (satisfy isAlphaNum)++    charExpand a b inc = do+        x <- readAlpha a+        y <- readAlpha b+        return . map (:[]) $ enum x y inc++    numExpand a b inc = do+        x <- readNumber a+        y <- readNumber b+        return . map showPadded $ enum x y inc+      where+        width = max (length a) (length b)++        isPadded ('-':'0':_:_) = True+        isPadded ('0':_:_)     = True+        isPadded _             = False++        showPadded = if isPadded a || isPadded b then pad width else show++        pad w n+            | n < 0     = '-' : pad (w - 1) (negate n)+            | otherwise = replicate (w - length s) '0' ++ s+          where+            s = show n++-- | A tilde prefix.+data TildePrefix+    = Home              -- ^ @~/foo@+    | UserHome String   -- ^ @~fred/foo@+    | PWD               -- ^ @~+/foo@+    | OldPWD            -- ^ @~-/foo@+    | Dirs Int          -- ^ @~N@, @~+N@, @~-N@+    deriving (Eq, Read, Show)++instance Pretty TildePrefix where+    pretty Home         = "~"+    pretty (UserHome s) = "~" <> text s+    pretty PWD          = "~+"+    pretty OldPWD       = "~-"+    pretty (Dirs n)     = "~" <> int n++-- | Strip the tilde prefix of a word, if any.+tildePrefix :: Word -> Maybe (TildePrefix, Word)+tildePrefix w = case parseUnsafe "tildePrefix" split w of+    ('~':s, w') -> Just (readPrefix s, w')+    _           -> Nothing+  where+    split = (,) <$> many (satisfy (/= '/')) <*> getInput++    readPrefix s+        | s == ""                = Home+        | s == "+"               = PWD+        | s == "-"               = OldPWD+        | Just n <- readNumber s = Dirs n+        | otherwise              = UserHome s++-- | Split a word on delimiters.+splitWord :: [Char] -> Word -> [Word]+splitWord ifs = parseUnsafe "splitWord" $ ifsep *> many (word <* ifsep)+  where+    ifsep = many  (oneOf  ifs)+    word  = many1 (noneOf ifs)
src/Language/Bash/Parse.hs view
@@ -305,11 +305,11 @@   where     arithFor_ = ArithFor <$> arith <* optional listTerm <*> doGroup -    for_ = For <$> anyWord <*> wordList <*> doGroup+    for_ = For <$> name <*> wordList <*> doGroup  -- | Parse a @select@ command. selectCommand :: Parser ShellCommand-selectCommand = Select <$ word "select" <*> anyWord <*> wordList <*> doGroup+selectCommand = Select <$ word "select" <*> name <*> wordList <*> doGroup  -- | Parse an @if@ command. ifCommand :: Parser ShellCommand
src/Language/Bash/Parse/Word.hs view
@@ -294,7 +294,7 @@  -- | Parse a word. word :: Stream s m Char => ParsecT s u m Word-word = spans " \t\n$|;()<>" True wordSpan+word = spans " \t\n&|;()<>" True wordSpan  -- | Parse a here document as a word. This parses substitutions, but not -- most quoting.
src/Language/Bash/Syntax.hs view
@@ -65,14 +65,14 @@     | Arith String       -- | A Bash @[[...]]@ conditional expression.     | Cond (CondExpr Word)-      -- | A @for /word/ in /words/@ command. If @in /words/@ is absent,+      -- | A @for /name/ in /words/@ command. If @in /words/@ is absent,       -- the word list defaults to @\"$\@\"@.-    | For Word [Word] List+    | For String [Word] List       -- | An arithmetic @for ((...))@ command.     | ArithFor String List-      -- | A @select /word/ in /words/@ command. If @in /words/@ is absent,+      -- | A @select /name/ in /words/@ command. If @in /words/@ is absent,       -- the word list defaults to @\"$\@\"@.-    | Select Word [Word] List+    | Select String [Word] List       -- | A @case@ command.     | Case Word [CaseClause]       -- | An @if@ command, with a predicate, consequent, and alternative.