{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module:      Data.Configurator.Parser
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable
--
-- A parser for configuration files.

module Data.Configurator.Parser
    (
      topLevel
    , interp
    ) where

import Control.Applicative
import Control.Exception (throw)
import Control.Monad (when)
import Data.Attoparsec.Text as A
import Data.Bits (shiftL)
import Data.Char (chr, isAlpha, isAlphaNum, isSpace)
import Data.Configurator.Types.Internal
import Data.Monoid (Monoid(..))
import Data.Text (Text)
import Data.Text.Lazy.Builder (fromText, singleton, toLazyText)
import qualified Data.Text as T
import qualified Data.Text.Lazy as L

topLevel :: Parser [Directive]
topLevel :: Parser [Directive]
topLevel = Parser [Directive]
directives Parser [Directive] -> Parser Text () -> Parser [Directive]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS Parser [Directive] -> Parser Text () -> Parser [Directive]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput
  
directive :: Parser Directive
directive :: Parser Directive
directive =
  [Parser Directive] -> Parser Directive
forall a. Monoid a => [a] -> a
mconcat [
    Text -> Parser Text
string Text
"import" Parser Text -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
skipLWS Parser Text () -> Parser Directive -> Parser Directive
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Directive
Import (Text -> Directive) -> Parser Text -> Parser Directive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
string_)
  , Text -> Value -> Directive
Bind (Text -> Value -> Directive)
-> Parser Text -> Parser Text (Value -> Directive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
try (Parser Text
ident Parser Text -> Parser Text () -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS Parser Text -> Parser Text Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'=' Parser Text -> Parser Text () -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS) Parser Text (Value -> Directive)
-> Parser Value -> Parser Directive
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Value
value
  , Text -> [Directive] -> Directive
Group (Text -> [Directive] -> Directive)
-> Parser Text -> Parser Text ([Directive] -> Directive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
try (Parser Text
ident Parser Text -> Parser Text () -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS Parser Text -> Parser Text Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'{' Parser Text -> Parser Text () -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS)
          Parser Text ([Directive] -> Directive)
-> Parser [Directive] -> Parser Directive
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Directive]
directives Parser Directive -> Parser Text () -> Parser Directive
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS Parser Directive -> Parser Text Char -> Parser Directive
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'}'
  ]

directives :: Parser [Directive]
directives :: Parser [Directive]
directives = (Parser Text ()
skipLWS Parser Text () -> Parser Directive -> Parser Directive
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Directive
directive Parser Directive -> Parser Text () -> Parser Directive
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipHWS) Parser Directive -> Parser Text Char -> Parser [Directive]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy`
             ((Char -> Bool) -> Parser Text Char
satisfy ((Char -> Bool) -> Parser Text Char)
-> (Char -> Bool) -> Parser Text Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

data Skip = Space | Comment

-- | Skip lines, comments, or horizontal white space.
skipLWS :: Parser ()
skipLWS :: Parser Text ()
skipLWS = Skip -> (Skip -> Char -> Maybe Skip) -> Parser Text
forall s. s -> (s -> Char -> Maybe s) -> Parser Text
scan Skip
Space Skip -> Char -> Maybe Skip
go Parser Text -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where go :: Skip -> Char -> Maybe Skip
go Skip
Space Char
c | Char -> Bool
isSpace Char
c = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Space
        go Skip
Space Char
'#'           = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Comment
        go Skip
Space Char
_             = Maybe Skip
forall a. Maybe a
Nothing
        go Skip
Comment Char
'\r'        = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Space
        go Skip
Comment Char
'\n'        = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Space
        go Skip
Comment Char
_           = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Comment

-- | Skip comments or horizontal white space.
skipHWS :: Parser ()
skipHWS :: Parser Text ()
skipHWS = Skip -> (Skip -> Char -> Maybe Skip) -> Parser Text
forall s. s -> (s -> Char -> Maybe s) -> Parser Text
scan Skip
Space Skip -> Char -> Maybe Skip
go Parser Text -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where go :: Skip -> Char -> Maybe Skip
go Skip
Space Char
' '           = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Space
        go Skip
Space Char
'\t'          = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Space
        go Skip
Space Char
'#'           = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Comment
        go Skip
Space Char
_             = Maybe Skip
forall a. Maybe a
Nothing
        go Skip
Comment Char
'\r'        = Maybe Skip
forall a. Maybe a
Nothing
        go Skip
Comment Char
'\n'        = Maybe Skip
forall a. Maybe a
Nothing
        go Skip
Comment Char
_           = Skip -> Maybe Skip
forall a. a -> Maybe a
Just Skip
Comment

ident :: Parser Name
ident :: Parser Text
ident = do
  Text
n <- Char -> Text -> Text
T.cons (Char -> Text -> Text)
-> Parser Text Char -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Char
satisfy Char -> Bool
isAlpha Parser Text (Text -> Text) -> Parser Text -> Parser Text
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser Text
A.takeWhile Char -> Bool
isCont
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"import") (Parser Text () -> Parser Text ())
-> Parser Text () -> Parser Text ()
forall a b. (a -> b) -> a -> b
$
    ConfigError -> Parser Text ()
forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> ConfigError
ParseError [Char]
"" ([Char] -> ConfigError) -> [Char] -> ConfigError
forall a b. (a -> b) -> a -> b
$ [Char]
"reserved word (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") used as identifier")
  Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
n
 where
  isCont :: Char -> Bool
isCont Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

value :: Parser Value
value :: Parser Value
value = [Parser Value] -> Parser Value
forall a. Monoid a => [a] -> a
mconcat [
          Text -> Parser Text
string Text
"on" Parser Text -> Parser Value -> Parser Value
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value
Bool Bool
True)
        , Text -> Parser Text
string Text
"off" Parser Text -> Parser Value -> Parser Value
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value
Bool Bool
False)
        , Text -> Parser Text
string Text
"true" Parser Text -> Parser Value -> Parser Value
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value
Bool Bool
True)
        , Text -> Parser Text
string Text
"false" Parser Text -> Parser Value -> Parser Value
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value
Bool Bool
False)
        , Text -> Value
String (Text -> Value) -> Parser Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
string_
        , Rational -> Value
Number (Rational -> Value) -> Parser Text Rational -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Rational
forall a. Fractional a => Parser a
rational
        , [Value] -> Value
List ([Value] -> Value) -> Parser Text [Value] -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Char -> Parser Text [Value] -> Parser Text [Value]
forall a. Char -> Char -> Parser a -> Parser a
brackets Char
'[' Char
']'
                   ((Parser Value
value Parser Value -> Parser Text () -> Parser Value
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS) Parser Value -> Parser Text Char -> Parser Text [Value]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` (Char -> Parser Text Char
char Char
',' Parser Text Char -> Parser Text () -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipLWS))
        ]

string_ :: Parser Text
string_ :: Parser Text
string_ = do
  Text
s <- Char -> Parser Text Char
char Char
'"' Parser Text Char -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> (Bool -> Char -> Maybe Bool) -> Parser Text
forall s. s -> (s -> Char -> Maybe s) -> Parser Text
scan Bool
False Bool -> Char -> Maybe Bool
isChar Parser Text -> Parser Text Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'"'
  if Text
"\\" Text -> Text -> Bool
`T.isInfixOf` Text
s
    then Text -> Parser Text
unescape Text
s
    else Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
 where
  isChar :: Bool -> Char -> Maybe Bool
isChar Bool
True Char
_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  isChar Bool
_ Char
'"'  = Maybe Bool
forall a. Maybe a
Nothing
  isChar Bool
_ Char
c    = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')

brackets :: Char -> Char -> Parser a -> Parser a
brackets :: forall a. Char -> Char -> Parser a -> Parser a
brackets Char
open Char
close Parser a
p = Char -> Parser Text Char
char Char
open Parser Text Char -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
skipLWS Parser Text () -> Parser a -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser Text Char -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
close

embed :: Parser a -> Text -> Parser a
embed :: forall a. Parser a -> Text -> Parser a
embed Parser a
p Text
s = case Parser a -> Text -> Either [Char] a
forall a. Parser a -> Text -> Either [Char] a
parseOnly Parser a
p Text
s of
              Left [Char]
err -> [Char] -> Parser a
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err
              Right a
v  -> a -> Parser a
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v

unescape :: Text -> Parser Text
unescape :: Text -> Parser Text
unescape = (Builder -> Text) -> Parser Text Builder -> Parser Text
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
L.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText) (Parser Text Builder -> Parser Text)
-> (Text -> Parser Text Builder) -> Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text Builder -> Text -> Parser Text Builder
forall a. Parser a -> Text -> Parser a
embed (Builder -> Parser Text Builder
p Builder
forall a. Monoid a => a
mempty)
 where
  p :: Builder -> Parser Text Builder
p Builder
acc = do
    Text
h <- (Char -> Bool) -> Parser Text
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\\')
    let rest :: Parser Text Builder
rest = do
          let cont :: Char -> Parser Text Builder
cont Char
c = Builder -> Parser Text Builder
p (Builder
acc Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Text -> Builder
fromText Text
h Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
singleton Char
c)
          Char
c <- Char -> Parser Text Char
char Char
'\\' Parser Text Char -> Parser Text Char -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Char
satisfy ([Char] -> Char -> Bool
inClass [Char]
"ntru\"\\")
          case Char
c of
            Char
'n'  -> Char -> Parser Text Builder
cont Char
'\n'
            Char
't'  -> Char -> Parser Text Builder
cont Char
'\t'
            Char
'r'  -> Char -> Parser Text Builder
cont Char
'\r'
            Char
'"'  -> Char -> Parser Text Builder
cont Char
'"'
            Char
'\\' -> Char -> Parser Text Builder
cont Char
'\\'
            Char
_    -> Char -> Parser Text Builder
cont (Char -> Parser Text Builder)
-> Parser Text Char -> Parser Text Builder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Char
hexQuad
    Bool
done <- Parser Text Bool
forall t. Chunk t => Parser t Bool
atEnd
    if Bool
done
      then Builder -> Parser Text Builder
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder
acc Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Text -> Builder
fromText Text
h)
      else Parser Text Builder
rest

hexQuad :: Parser Char
hexQuad :: Parser Text Char
hexQuad = do
  Int
a <- Parser Int -> Text -> Parser Int
forall a. Parser a -> Text -> Parser a
embed Parser Int
forall a. (Integral a, Bits a) => Parser a
hexadecimal (Text -> Parser Int) -> Parser Text -> Parser Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Parser Text
A.take Int
4
  if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xd800 Bool -> Bool -> Bool
|| Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xdfff
    then Char -> Parser Text Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr Int
a)
    else do
      Int
b <- Parser Int -> Text -> Parser Int
forall a. Parser a -> Text -> Parser a
embed Parser Int
forall a. (Integral a, Bits a) => Parser a
hexadecimal (Text -> Parser Int) -> Parser Text -> Parser Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Parser Text
string Text
"\\u" Parser Text -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Text
A.take Int
4
      if Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdbff Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xdc00 Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdfff
        then Char -> Parser Text Char
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser Text Char) -> Char -> Parser Text Char
forall a b. (a -> b) -> a -> b
$! Int -> Char
chr (((Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xd800) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
10) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xdc00) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x10000)
        else [Char] -> Parser Text Char
forall a. [Char] -> Parser Text a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid UTF-16 surrogates"
                   
-- | Parse a string interpolation spec.
--
-- The sequence @$$@ is treated as a single @$@ character.  The
-- sequence @$(@ begins a section to be interpolated, and @)@ ends it.
interp :: Parser [Interpolate]
interp :: Parser [Interpolate]
interp = [Interpolate] -> [Interpolate]
forall a. [a] -> [a]
reverse ([Interpolate] -> [Interpolate])
-> Parser [Interpolate] -> Parser [Interpolate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Interpolate] -> Parser [Interpolate]
p []
 where
  p :: [Interpolate] -> Parser [Interpolate]
p [Interpolate]
acc = do
    Interpolate
h <- Text -> Interpolate
Literal (Text -> Interpolate) -> Parser Text -> Parser Text Interpolate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'$')
    let rest :: Parser [Interpolate]
rest = do
          let cont :: Interpolate -> Parser [Interpolate]
cont Interpolate
x = [Interpolate] -> Parser [Interpolate]
p (Interpolate
x Interpolate -> [Interpolate] -> [Interpolate]
forall a. a -> [a] -> [a]
: Interpolate
h Interpolate -> [Interpolate] -> [Interpolate]
forall a. a -> [a] -> [a]
: [Interpolate]
acc)
          Char
c <- Char -> Parser Text Char
char Char
'$' Parser Text Char -> Parser Text Char -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Char
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(')
          case Char
c of
            Char
'$' -> Interpolate -> Parser [Interpolate]
cont (Text -> Interpolate
Literal (Char -> Text
T.singleton Char
'$'))
            Char
_   -> (Interpolate -> Parser [Interpolate]
cont (Interpolate -> Parser [Interpolate])
-> (Text -> Interpolate) -> Text -> Parser [Interpolate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Interpolate
Interpolate) (Text -> Parser [Interpolate])
-> Parser Text -> Parser [Interpolate]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> Parser Text
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
')') Parser Text -> Parser Text Char -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
')'
    Bool
done <- Parser Text Bool
forall t. Chunk t => Parser t Bool
atEnd
    if Bool
done
      then [Interpolate] -> Parser [Interpolate]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Interpolate
h Interpolate -> [Interpolate] -> [Interpolate]
forall a. a -> [a] -> [a]
: [Interpolate]
acc)
      else Parser [Interpolate]
rest