{-# LANGUAGE OverloadedStrings, PatternGuards, DeriveGeneric #-}
-- | Shell expansions.
module Language.Bash.Expand
    ( braceExpand
    , TildePrefix(..)
    , tildePrefix
    , splitWord
    ) where

import Prelude hiding (Word)

import Control.Applicative
import Control.Monad
import Data.Char
import Text.Parsec.Combinator hiding (optional, manyTill)
import Text.Parsec.Prim       hiding ((<|>), many, token)
import Text.Parsec.String     ()
import Prettyprinter          (Pretty(..))

import Language.Bash.Pretty
import Language.Bash.Word     hiding (prefix)

-- | A parser over words.
type Parser = Parsec Word ()

infixl 3 </>

-- | Backtracking choice.
(</>) :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
ParsecT s u m a
p </> :: forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> ParsecT s u m a
q = ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m a
p ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT s u m a
q

-- | Run a 'Parser', failing on a parse error.
parseUnsafe :: String -> Parser a -> Word -> a
parseUnsafe :: forall a. String -> Parser a -> Word -> a
parseUnsafe String
f Parser a
p Word
w = case Parser a -> String -> Word -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser a
p (Word -> String
forall a. Pretty a => a -> String
prettyText Word
w) Word
w of
    Left  ParseError
e -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Language.Bash.Expand." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
    Right a
a -> a
a

-- | Parse a general token.
token :: (Span -> Maybe a) -> Parser a
token :: forall a. (Span -> Maybe a) -> Parser a
token = (Span -> String)
-> (SourcePos -> Span -> Word -> SourcePos)
-> (Span -> Maybe a)
-> ParsecT Word () Identity a
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim (String -> Span -> String
forall a b. a -> b -> a
const String
"") (\SourcePos
pos Span
_ Word
_ -> SourcePos
pos)

-- | Parse an unquoted character satisfying a predicate.
satisfy :: (Char -> Bool) -> Parser Span
satisfy :: (Char -> Bool) -> Parser Span
satisfy Char -> Bool
p = (Span -> Maybe Span) -> Parser Span
forall a. (Span -> Maybe a) -> Parser a
token ((Span -> Maybe Span) -> Parser Span)
-> (Span -> Maybe Span) -> Parser Span
forall a b. (a -> b) -> a -> b
$ \Span
t -> case Span
t of
    Char Char
c | Char -> Bool
p Char
c -> Span -> Maybe Span
forall a. a -> Maybe a
Just Span
t
    Span
_            -> Maybe Span
forall a. Maybe a
Nothing

-- | Parse an unquoted character satisfying a predicate.
satisfy' :: (Char -> Bool) -> Parser Char
satisfy' :: (Char -> Bool) -> Parser Char
satisfy' Char -> Bool
p = (Span -> Maybe Char) -> Parser Char
forall a. (Span -> Maybe a) -> Parser a
token ((Span -> Maybe Char) -> Parser Char)
-> (Span -> Maybe Char) -> Parser Char
forall a b. (a -> b) -> a -> b
$ \Span
t -> case Span
t of
    Char Char
c | Char -> Bool
p Char
c -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
    Span
_            -> Maybe Char
forall a. Maybe a
Nothing

-- | Parse a span that is not an unquoted character satisfying a predicate.
except :: (Char -> Bool) -> Parser Span
except :: (Char -> Bool) -> Parser Span
except Char -> Bool
p = (Span -> Maybe Span) -> Parser Span
forall a. (Span -> Maybe a) -> Parser a
token ((Span -> Maybe Span) -> Parser Span)
-> (Span -> Maybe Span) -> Parser Span
forall a b. (a -> b) -> a -> b
$ \Span
t -> case Span
t of
    Char Char
c | Char -> Bool
p Char
c -> Maybe Span
forall a. Maybe a
Nothing
    Span
_            -> Span -> Maybe Span
forall a. a -> Maybe a
Just Span
t

-- | Parse an unquoted character.
char :: Char -> Parser Span
char :: Char -> Parser Span
char Char
c = (Span -> Maybe Span) -> Parser Span
forall a. (Span -> Maybe a) -> Parser a
token ((Span -> Maybe Span) -> Parser Span)
-> (Span -> Maybe Span) -> Parser Span
forall a b. (a -> b) -> a -> b
$ \Span
t -> case Span
t of
    Char Char
d | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
d -> Span -> Maybe Span
forall a. a -> Maybe a
Just Span
t
    Span
_               -> Maybe Span
forall a. Maybe a
Nothing

-- | Parse an unquoted string.
string :: String -> Parser Word
string :: String -> Parser Word
string = (Char -> Parser Span) -> String -> Parser Word
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Char -> Parser Span
char

-- | Parse one of the given characters.
oneOf :: [Char] -> Parser Span
oneOf :: String -> Parser Span
oneOf String
cs = (Char -> Bool) -> Parser Span
satisfy (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
cs)

-- | Parse anything but a quoted character.
noneOf :: [Char] -> Parser Span
noneOf :: String -> Parser Span
noneOf String
cs = (Char -> Bool) -> Parser Span
except (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
cs)

-- | Read a number.
readNumber :: MonadPlus m => String -> m Int
readNumber :: forall (m :: * -> *). MonadPlus m => String -> m Int
readNumber String
s = case ReadS Int
forall a. Read a => ReadS a
reads (String -> String
dropPlus String
s) of
    [(Int
n, String
"")] -> Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
    [(Int, String)]
_         -> m Int
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  where
    dropPlus :: String -> String
dropPlus (Char
'+':String
t) = String
t
    dropPlus String
t       = String
t

-- | Read a letter.
readAlpha :: MonadPlus m => String -> m Char
readAlpha :: forall (m :: * -> *). MonadPlus m => String -> m Char
readAlpha [Char
c] | Char -> Bool
isAlpha Char
c = Char -> m Char
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
readAlpha String
_               = m Char
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
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 :: forall a. (Ord a, Enum a) => a -> a -> Maybe Int -> [a]
enum a
x a
y Maybe Int
inc = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a. Enum a => Int -> a
toEnum [a -> Int
forall a. Enum a => a -> Int
fromEnum a
x, a -> Int
forall a. Enum a => a -> Int
fromEnum a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step .. a -> Int
forall a. Enum a => a -> Int
fromEnum a
y]
  where
    step :: Int
step = case Maybe Int
inc of
        Maybe Int
Nothing | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x     -> Int
1
                | Bool
otherwise -> Int
1
        Just Int
i              -> Int
i

-- | Brace expand a word.
braceExpand :: Word -> [Word]
braceExpand :: Word -> [Word]
braceExpand = String -> Parser [Word] -> Word -> [Word]
forall a. String -> Parser a -> Word -> a
parseUnsafe String
"braceExpand" Parser [Word]
start
  where
    prefix :: [a] -> [[a]] -> [[a]]
prefix [a]
a [[a]]
bs = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) [[a]]
bs
    cross :: [[a]] -> [[a]] -> [[a]]
cross [[a]]
as [[a]]
bs = [[a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
b | [a]
a <- [[a]]
as, [a]
b <- [[a]]
bs]

    -- A beginning empty brace is ignored.
    start :: Parser [Word]
start = Word -> [Word] -> [Word]
forall {a}. [a] -> [[a]] -> [[a]]
prefix (Word -> [Word] -> [Word])
-> Parser Word -> ParsecT Word () Identity ([Word] -> [Word])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Word
string String
"{}" ParsecT Word () Identity ([Word] -> [Word])
-> Parser [Word] -> Parser [Word]
forall a b.
ParsecT Word () Identity (a -> b)
-> ParsecT Word () Identity a -> ParsecT Word () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser [Word]
expr String
""
        Parser [Word] -> Parser [Word] -> Parser [Word]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> String -> Parser [Word]
expr String
""

    expr :: String -> Parser [Word]
expr String
delims = (([Word] -> [Word]) -> [Word] -> [Word])
-> [Word] -> [[Word] -> [Word]] -> [Word]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Word] -> [Word]) -> [Word] -> [Word]
forall a b. (a -> b) -> a -> b
($) [[]] ([[Word] -> [Word]] -> [Word])
-> ParsecT Word () Identity [[Word] -> [Word]] -> Parser [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Word () Identity ([Word] -> [Word])
-> ParsecT Word () Identity [[Word] -> [Word]]
forall a.
ParsecT Word () Identity a -> ParsecT Word () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> ParsecT Word () Identity ([Word] -> [Word])
exprPart String
delims)

    exprPart :: String -> ParsecT Word () Identity ([Word] -> [Word])
exprPart String
delims = [Word] -> [Word] -> [Word]
forall {a}. [[a]] -> [[a]] -> [[a]]
cross ([Word] -> [Word] -> [Word])
-> Parser Span
-> ParsecT Word () Identity ([Word] -> [Word] -> [Word])
forall a b.
a -> ParsecT Word () Identity b -> ParsecT Word () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Span
char Char
'{' ParsecT Word () Identity ([Word] -> [Word] -> [Word])
-> Parser [Word] -> ParsecT Word () Identity ([Word] -> [Word])
forall a b.
ParsecT Word () Identity (a -> b)
-> ParsecT Word () Identity a -> ParsecT Word () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser [Word]
brace String
delims ParsecT Word () Identity ([Word] -> [Word])
-> Parser Span -> ParsecT Word () Identity ([Word] -> [Word])
forall a b.
ParsecT Word () Identity a
-> ParsecT Word () Identity b -> ParsecT Word () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Span
char Char
'}'
                  ParsecT Word () Identity ([Word] -> [Word])
-> ParsecT Word () Identity ([Word] -> [Word])
-> ParsecT Word () Identity ([Word] -> [Word])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> Word -> [Word] -> [Word]
forall {a}. [a] -> [[a]] -> [[a]]
prefix (Word -> [Word] -> [Word])
-> Parser Word -> ParsecT Word () Identity ([Word] -> [Word])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word
emptyBrace
                  ParsecT Word () Identity ([Word] -> [Word])
-> ParsecT Word () Identity ([Word] -> [Word])
-> ParsecT Word () Identity ([Word] -> [Word])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> Word -> [Word] -> [Word]
forall {a}. [a] -> [[a]] -> [[a]]
prefix (Word -> [Word] -> [Word])
-> (Span -> Word) -> Span -> [Word] -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span -> Word -> Word
forall a. a -> [a] -> [a]
:[]) (Span -> [Word] -> [Word])
-> Parser Span -> ParsecT Word () Identity ([Word] -> [Word])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Span
noneOf String
delims

    brace :: String -> Parser [Word]
brace String
delims = [[Word]] -> [Word]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Word]] -> [Word])
-> ParsecT Word () Identity [[Word]] -> Parser [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Word () Identity [[Word]]
braceParts String
delims
               Parser [Word] -> Parser [Word] -> Parser [Word]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> Parser [Word]
sequenceExpand
               Parser [Word] -> Parser [Word] -> Parser [Word]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
</> (Word -> Word) -> [Word] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (\Word
s -> String -> Word
stringToWord String
"{" Word -> Word -> Word
forall a. [a] -> [a] -> [a]
++ Word
s Word -> Word -> Word
forall a. [a] -> [a] -> [a]
++ String -> Word
stringToWord String
"}") ([Word] -> [Word]) -> Parser [Word] -> Parser [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser [Word]
expr String
",}"

    -- The first part of the outermost brace expression is not delimited by
    -- a close brace.
    braceParts :: String -> ParsecT Word () Identity [[Word]]
braceParts String
delims =
        (:) ([Word] -> [[Word]] -> [[Word]])
-> Parser [Word] -> ParsecT Word () Identity ([[Word]] -> [[Word]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser [Word]
expr (if Char
',' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
delims then String
",}" else String
",") ParsecT Word () Identity ([[Word]] -> [[Word]])
-> Parser Span -> ParsecT Word () Identity ([[Word]] -> [[Word]])
forall a b.
ParsecT Word () Identity a
-> ParsecT Word () Identity b -> ParsecT Word () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Span
char Char
','
            ParsecT Word () Identity ([[Word]] -> [[Word]])
-> ParsecT Word () Identity [[Word]]
-> ParsecT Word () Identity [[Word]]
forall a b.
ParsecT Word () Identity (a -> b)
-> ParsecT Word () Identity a -> ParsecT Word () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser [Word]
expr String
",}" Parser [Word] -> Parser Span -> ParsecT Word () Identity [[Word]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` Char -> Parser Span
char Char
','

    emptyBrace :: Parser Word
emptyBrace = do
        Span
a <- (Span -> Maybe Span) -> Parser Span
forall a. (Span -> Maybe a) -> Parser a
token ((Span -> Maybe Span) -> Parser Span)
-> (Span -> Maybe Span) -> Parser Span
forall a b. (a -> b) -> a -> b
$ \Span
t -> case Span
t of
            Char Char
c   | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
ws -> Span -> Maybe Span
forall a. a -> Maybe a
Just Span
t
            Escape Char
c | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
ws -> Span -> Maybe Span
forall a. a -> Maybe a
Just Span
t
            Span
_                      -> Maybe Span
forall a. Maybe a
Nothing
        Span
b <- Char -> Parser Span
char Char
'{'
        Span
c <- Char -> Parser Span
char Char
'}' Parser Span -> Parser Span -> Parser Span
forall a.
ParsecT Word () Identity a
-> ParsecT Word () Identity a -> ParsecT Word () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Span
oneOf String
ws
        Word -> Parser Word
forall a. a -> ParsecT Word () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Span
a, Span
b, Span
c]
      where
        ws :: String
ws = String
" \t\r\n"

    sequenceExpand :: Parser [Word]
sequenceExpand = do
        String
a   <- ParsecT Word () Identity String
sequencePart
        String
b   <- String -> Parser Word
string String
".." Parser Word
-> ParsecT Word () Identity String
-> ParsecT Word () Identity String
forall a b.
ParsecT Word () Identity a
-> ParsecT Word () Identity b -> ParsecT Word () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Word () Identity String
sequencePart
        Maybe String
c   <- ParsecT Word () Identity String
-> ParsecT Word () Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Parser Word
string String
".." Parser Word
-> ParsecT Word () Identity String
-> ParsecT Word () Identity String
forall a b.
ParsecT Word () Identity a
-> ParsecT Word () Identity b -> ParsecT Word () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Word () Identity String
sequencePart)
        Maybe Int
inc <- (String -> ParsecT Word () Identity Int)
-> Maybe String -> ParsecT Word () Identity (Maybe Int)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse String -> ParsecT Word () Identity Int
forall (m :: * -> *). MonadPlus m => String -> m Int
readNumber Maybe String
c
        (String -> Word) -> [String] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map String -> Word
stringToWord ([String] -> [Word])
-> ParsecT Word () Identity [String] -> Parser [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> Maybe Int -> ParsecT Word () Identity [String]
forall {m :: * -> *}.
MonadPlus m =>
String -> String -> Maybe Int -> m [String]
numExpand String
a String
b Maybe Int
inc ParsecT Word () Identity [String]
-> ParsecT Word () Identity [String]
-> ParsecT Word () Identity [String]
forall a.
ParsecT Word () Identity a
-> ParsecT Word () Identity a -> ParsecT Word () Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe Int -> ParsecT Word () Identity [String]
forall {m :: * -> *}.
MonadPlus m =>
String -> String -> Maybe Int -> m [String]
charExpand String
a String
b Maybe Int
inc)
      where
        sequencePart :: ParsecT Word () Identity String
sequencePart = Parser Char -> ParsecT Word () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> Parser Char
satisfy' Char -> Bool
isAlphaNum)

    charExpand :: String -> String -> Maybe Int -> m [String]
charExpand String
a String
b Maybe Int
inc = do
        Char
x <- String -> m Char
forall (m :: * -> *). MonadPlus m => String -> m Char
readAlpha String
a
        Char
y <- String -> m Char
forall (m :: * -> *). MonadPlus m => String -> m Char
readAlpha String
b
        [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String])
-> (String -> [String]) -> String -> m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (String -> m [String]) -> String -> m [String]
forall a b. (a -> b) -> a -> b
$ Char -> Char -> Maybe Int -> String
forall a. (Ord a, Enum a) => a -> a -> Maybe Int -> [a]
enum Char
x Char
y Maybe Int
inc

    numExpand :: String -> String -> Maybe Int -> m [String]
numExpand String
a String
b Maybe Int
inc = do
        Int
x <- String -> m Int
forall (m :: * -> *). MonadPlus m => String -> m Int
readNumber String
a
        Int
y <- String -> m Int
forall (m :: * -> *). MonadPlus m => String -> m Int
readNumber String
b
        [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String])
-> ([Int] -> [String]) -> [Int] -> m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
showPadded ([Int] -> m [String]) -> [Int] -> m [String]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Maybe Int -> [Int]
forall a. (Ord a, Enum a) => a -> a -> Maybe Int -> [a]
enum Int
x Int
y Maybe Int
inc
      where
        width :: Int
width = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a) (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
b)

        isPadded :: String -> Bool
isPadded (Char
'-':Char
'0':Char
_:String
_) = Bool
True
        isPadded (Char
'0':Char
_:String
_)     = Bool
True
        isPadded String
_             = Bool
False

        showPadded :: Int -> String
showPadded = if String -> Bool
isPadded String
a Bool -> Bool -> Bool
|| String -> Bool
isPadded String
b then Int -> Int -> String
forall {t}. (Ord t, Num t, Show t) => Int -> t -> String
pad Int
width else Int -> String
forall a. Show a => a -> String
show

        pad :: Int -> t -> String
pad Int
w t
n
            | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0     = Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> t -> String
pad (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (t -> t
forall a. Num a => a -> a
negate t
n)
            | Bool
otherwise = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
          where
            s :: String
s = t -> String
forall a. Show a => a -> String
show t
n

-- | A tilde prefix.
data TildePrefix
    = Home              -- ^ @~/foo@
    | UserHome String   -- ^ @~fred/foo@
    | PWD               -- ^ @~+/foo@
    | OldPWD            -- ^ @~-/foo@
    | Dirs Int          -- ^ @~N@, @~+N@, @~-N@
    deriving (TildePrefix -> TildePrefix -> Bool
(TildePrefix -> TildePrefix -> Bool)
-> (TildePrefix -> TildePrefix -> Bool) -> Eq TildePrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TildePrefix -> TildePrefix -> Bool
== :: TildePrefix -> TildePrefix -> Bool
$c/= :: TildePrefix -> TildePrefix -> Bool
/= :: TildePrefix -> TildePrefix -> Bool
Eq, ReadPrec [TildePrefix]
ReadPrec TildePrefix
Int -> ReadS TildePrefix
ReadS [TildePrefix]
(Int -> ReadS TildePrefix)
-> ReadS [TildePrefix]
-> ReadPrec TildePrefix
-> ReadPrec [TildePrefix]
-> Read TildePrefix
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TildePrefix
readsPrec :: Int -> ReadS TildePrefix
$creadList :: ReadS [TildePrefix]
readList :: ReadS [TildePrefix]
$creadPrec :: ReadPrec TildePrefix
readPrec :: ReadPrec TildePrefix
$creadListPrec :: ReadPrec [TildePrefix]
readListPrec :: ReadPrec [TildePrefix]
Read, Int -> TildePrefix -> String -> String
[TildePrefix] -> String -> String
TildePrefix -> String
(Int -> TildePrefix -> String -> String)
-> (TildePrefix -> String)
-> ([TildePrefix] -> String -> String)
-> Show TildePrefix
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TildePrefix -> String -> String
showsPrec :: Int -> TildePrefix -> String -> String
$cshow :: TildePrefix -> String
show :: TildePrefix -> String
$cshowList :: [TildePrefix] -> String -> String
showList :: [TildePrefix] -> String -> String
Show)

instance Pretty TildePrefix where
    pretty :: forall ann. TildePrefix -> Doc ann
pretty TildePrefix
Home         = Doc ann
"~"
    pretty (UserHome String
s) = Doc ann
"~" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
s
    pretty TildePrefix
PWD          = Doc ann
"~+"
    pretty TildePrefix
OldPWD       = Doc ann
"~-"
    pretty (Dirs Int
n)     = Doc ann
"~" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
n

-- | Strip the tilde prefix of a word, if any.
tildePrefix :: Word -> Maybe (TildePrefix, Word)
tildePrefix :: Word -> Maybe (TildePrefix, Word)
tildePrefix Word
w = case String -> Parser (String, Word) -> Word -> (String, Word)
forall a. String -> Parser a -> Word -> a
parseUnsafe String
"tildePrefix" Parser (String, Word)
split Word
w of
    (Char
'~':String
s, Word
w') -> (TildePrefix, Word) -> Maybe (TildePrefix, Word)
forall a. a -> Maybe a
Just (String -> TildePrefix
readPrefix String
s, Word
w')
    (String, Word)
_           -> Maybe (TildePrefix, Word)
forall a. Maybe a
Nothing
  where
    split :: Parser (String, Word)
split = (,) (String -> Word -> (String, Word))
-> ParsecT Word () Identity String
-> ParsecT Word () Identity (Word -> (String, Word))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT Word () Identity String
forall a.
ParsecT Word () Identity a -> ParsecT Word () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char
satisfy' (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/')) ParsecT Word () Identity (Word -> (String, Word))
-> Parser Word -> Parser (String, Word)
forall a b.
ParsecT Word () Identity (a -> b)
-> ParsecT Word () Identity a -> ParsecT Word () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput

    readPrefix :: String -> TildePrefix
readPrefix String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""                = TildePrefix
Home
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+"               = TildePrefix
PWD
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-"               = TildePrefix
OldPWD
        | Just Int
n <- String -> Maybe Int
forall (m :: * -> *). MonadPlus m => String -> m Int
readNumber String
s = Int -> TildePrefix
Dirs Int
n
        | Bool
otherwise              = String -> TildePrefix
UserHome String
s

-- | Split a word on delimiters.
splitWord :: [Char] -> Word -> [Word]
splitWord :: String -> Word -> [Word]
splitWord String
ifs = String -> Parser [Word] -> Word -> [Word]
forall a. String -> Parser a -> Word -> a
parseUnsafe String
"splitWord" (Parser [Word] -> Word -> [Word])
-> Parser [Word] -> Word -> [Word]
forall a b. (a -> b) -> a -> b
$ Parser Word
ifsep Parser Word -> Parser [Word] -> Parser [Word]
forall a b.
ParsecT Word () Identity a
-> ParsecT Word () Identity b -> ParsecT Word () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word -> Parser [Word]
forall a.
ParsecT Word () Identity a -> ParsecT Word () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Word
word Parser Word -> Parser Word -> Parser Word
forall a b.
ParsecT Word () Identity a
-> ParsecT Word () Identity b -> ParsecT Word () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word
ifsep)
  where
    ifsep :: Parser Word
ifsep = Parser Span -> Parser Word
forall a.
ParsecT Word () Identity a -> ParsecT Word () Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many  (String -> Parser Span
oneOf  String
ifs)
    word :: Parser Word
word  = Parser Span -> Parser Word
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> Parser Span
noneOf String
ifs)