{-# LANGUAGE FlexibleContexts #-}
-- | Builder-based parsing. This is useful for parsing Bash\'s complicated
-- words.
module Language.Bash.Parse.Builder
    ( -- * Builders
      Builder
    , fromChar
    , fromString
    , toString
      -- * Monoid parsing
    , (<+>)
    , many
    , many1
      -- * Characters
    , oneOf
    , noneOf
    , char
    , anyChar
    , satisfy
    , string
      -- * Spans
    , span
    , matchedPair
    ) where

import           Prelude                hiding (span)

import           Control.Applicative    ((<|>), liftA2)
import           Data.Monoid            (Endo (..))
import           Text.Parsec            (ParsecT, Stream)
import qualified Text.Parsec.Char       as P
import qualified Text.Parsec.Prim       as P

infixr 4 <+>

-- | An efficient 'String' builder.
type Builder = Endo String

-- | Construct a 'Builder' from a 'Char'.
fromChar :: Char -> Builder
fromChar :: Char -> Builder
fromChar = (String -> String) -> Builder
forall a. (a -> a) -> Endo a
Endo ((String -> String) -> Builder)
-> (Char -> String -> String) -> Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar

-- | Construct a 'Builder' from a 'String'.
fromString :: String -> Builder
fromString :: String -> Builder
fromString = (String -> String) -> Builder
forall a. (a -> a) -> Endo a
Endo ((String -> String) -> Builder)
-> (String -> String -> String) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString

-- | Convert a 'Builder' to a 'String'.
toString :: Builder -> String
toString :: Builder -> String
toString = (Builder -> String -> String) -> String -> Builder -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> String -> String
forall a. Endo a -> a -> a
appEndo String
""

-- | Append two monoidal results.
(<+>) :: (Applicative f, Monoid a) => f a -> f a -> f a
<+> :: forall (f :: * -> *) a.
(Applicative f, Monoid a) =>
f a -> f a -> f a
(<+>) = (a -> a -> a) -> f a -> f a -> f a
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend

-- | Concat zero or more monoidal results.
many :: Monoid a => ParsecT s u m a -> ParsecT s u m a
many :: forall a s u (m :: * -> *).
Monoid a =>
ParsecT s u m a -> ParsecT s u m a
many = ([a] -> a) -> ParsecT s u m [a] -> ParsecT s u m a
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (ParsecT s u m [a] -> ParsecT s u m a)
-> (ParsecT s u m a -> ParsecT s u m [a])
-> ParsecT s u m a
-> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
P.many

-- | Concat one or more monoidal results.
many1 :: Monoid a => ParsecT s u m a -> ParsecT s u m a
many1 :: forall a s u (m :: * -> *).
Monoid a =>
ParsecT s u m a -> ParsecT s u m a
many1 = ([a] -> a) -> ParsecT s u m [a] -> ParsecT s u m a
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (ParsecT s u m [a] -> ParsecT s u m a)
-> (ParsecT s u m a -> ParsecT s u m [a])
-> ParsecT s u m a
-> ParsecT s u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
P.many1

-- | 'Builder' version of 'P.oneOf'.
oneOf :: Stream s m Char => [Char] -> ParsecT s u m Builder
oneOf :: forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Builder
oneOf String
cs = Char -> Builder
fromChar (Char -> Builder) -> ParsecT s u m Char -> ParsecT s u m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
cs

-- | 'Builder' version of 'P.noneOf'.
noneOf :: Stream s m Char => [Char] -> ParsecT s u m Builder
noneOf :: forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Builder
noneOf String
cs = Char -> Builder
fromChar (Char -> Builder) -> ParsecT s u m Char -> ParsecT s u m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
cs

-- | 'Builder' version of 'P.char'.
char :: Stream s m Char => Char -> ParsecT s u m Builder
char :: forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Builder
char Char
c = Char -> Builder
fromChar Char
c Builder -> ParsecT s u m Char -> ParsecT s u m Builder
forall a b. a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
c

-- | 'Builder' version of 'P.anyChar'.
anyChar :: Stream s m Char => ParsecT s u m Builder
anyChar :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Builder
anyChar = Char -> Builder
fromChar (Char -> Builder) -> ParsecT s u m Char -> ParsecT s u m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar

-- | 'Builder' version of 'P.satisfy'.
satisfy :: Stream s m Char => (Char -> Bool) -> ParsecT s u m Builder
satisfy :: forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Builder
satisfy Char -> Bool
p = Char -> Builder
fromChar (Char -> Builder) -> ParsecT s u m Char -> ParsecT s u m Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy Char -> Bool
p

-- | 'Builder' version of 'P.string'.
string :: Stream s m Char => String -> ParsecT s u m Builder
string :: forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Builder
string String
s = String -> Builder
fromString String
s Builder -> ParsecT s u m String -> ParsecT s u m Builder
forall a b. a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
s

-- | @span start end escape@ parses a span of text starting with @start@ and
-- ending with @end@, with possible @escape@ sequences inside.
span
    :: Stream s m Char
    => Char
    -> Char
    -> ParsecT s u m Builder
    -> ParsecT s u m Builder
span :: forall s (m :: * -> *) u.
Stream s m Char =>
Char -> Char -> ParsecT s u m Builder -> ParsecT s u m Builder
span Char
start Char
end ParsecT s u m Builder
esc = Char -> ParsecT s u m Builder
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Builder
char Char
start ParsecT s u m Builder
-> ParsecT s u m Builder -> ParsecT s u m Builder
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT s u m Builder -> ParsecT s u m Builder
forall a s u (m :: * -> *).
Monoid a =>
ParsecT s u m a -> ParsecT s u m a
many ParsecT s u m Builder
inner ParsecT s u m Builder
-> ParsecT s u m Builder -> ParsecT s u m Builder
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT s u m Builder
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Builder
char Char
end
  where
    inner :: ParsecT s u m Builder
inner = ParsecT s u m Builder
esc ParsecT s u m Builder
-> ParsecT s u m Builder -> ParsecT s u m Builder
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
<|> (Char -> Bool) -> ParsecT s u m Builder
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Builder
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
end)

-- | @matchedPair start end escape@ parses @span start end escape@, including
-- the surrounding @start@ and @end@ characters.
matchedPair
    :: Stream s m Char
    => Char
    -> Char
    -> ParsecT s u m Builder
    -> ParsecT s u m Builder
matchedPair :: forall s (m :: * -> *) u.
Stream s m Char =>
Char -> Char -> ParsecT s u m Builder -> ParsecT s u m Builder
matchedPair Char
start Char
end ParsecT s u m Builder
esc = Char -> ParsecT s u m Builder
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Builder
char Char
start ParsecT s u m Builder
-> ParsecT s u m Builder -> ParsecT s u m Builder
forall (f :: * -> *) a.
(Applicative f, Monoid a) =>
f a -> f a -> f a
<+> ParsecT s u m Builder -> ParsecT s u m Builder
forall a s u (m :: * -> *).
Monoid a =>
ParsecT s u m a -> ParsecT s u m a
many ParsecT s u m Builder
inner ParsecT s u m Builder
-> ParsecT s u m Builder -> ParsecT s u m Builder
forall (f :: * -> *) a.
(Applicative f, Monoid a) =>
f a -> f a -> f a
<+> Char -> ParsecT s u m Builder
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Builder
char Char
end
  where
    inner :: ParsecT s u m Builder
inner = ParsecT s u m Builder
esc ParsecT s u m Builder
-> ParsecT s u m Builder -> ParsecT s u m Builder
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
<|> (Char -> Bool) -> ParsecT s u m Builder
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Builder
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
end)