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
type Parser = Parsec Word ()
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
token :: (Span -> Maybe a) -> Parser a
token = tokenPrim (const "") (\pos _ _ -> pos)
satisfy :: (Char -> Bool) -> Parser Char
satisfy p = token $ \case
Char c | p c -> Just c
_ -> Nothing
except :: (Char -> Bool) -> Parser Span
except p = token $ \case
Char c | p c -> Nothing
s -> Just s
char :: Char -> Parser Char
char c = satisfy (== c)
string :: String -> Parser String
string = traverse char
oneOf :: [Char] -> Parser Char
oneOf cs = satisfy (`elem` cs)
noneOf :: [Char] -> Parser Span
noneOf cs = except (`elem` cs)
readNumber :: MonadPlus m => String -> m Int
readNumber s = case reads (dropPlus s) of
[(n, "")] -> return n
_ -> mzero
where
dropPlus ('+':t) = t
dropPlus t = t
readAlpha :: MonadPlus m => String -> m Char
readAlpha [c] | isAlpha c = return c
readAlpha _ = mzero
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
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
data TildePrefix
= Home
| UserHome String
| PWD
| OldPWD
| Dirs Int
deriving (Eq, Read, Show)
instance Pretty TildePrefix where
pretty Home = "~"
pretty (UserHome s) = "~" <> text s
pretty PWD = "~+"
pretty OldPWD = "~-"
pretty (Dirs n) = "~" <> int n
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
splitWord :: [Char] -> Word -> [Word]
splitWord ifs = parseUnsafe "splitWord" $ ifsep *> many (word <* ifsep)
where
ifsep = many (oneOf ifs)
word = many1 (noneOf ifs)