module Web.HttpApiData.QQ.Parser (
  ParsedUrlPiece (..),
  parseUrlPieces,
) where

import Control.Monad (unless)
import Text.ParserCombinators.ReadP hiding (choice, many1)

data ParsedUrlPiece
  = RawString String
  | InterpolatedName String
  deriving (Int -> ParsedUrlPiece -> ShowS
[ParsedUrlPiece] -> ShowS
ParsedUrlPiece -> String
(Int -> ParsedUrlPiece -> ShowS)
-> (ParsedUrlPiece -> String)
-> ([ParsedUrlPiece] -> ShowS)
-> Show ParsedUrlPiece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedUrlPiece] -> ShowS
$cshowList :: [ParsedUrlPiece] -> ShowS
show :: ParsedUrlPiece -> String
$cshow :: ParsedUrlPiece -> String
showsPrec :: Int -> ParsedUrlPiece -> ShowS
$cshowsPrec :: Int -> ParsedUrlPiece -> ShowS
Show, ParsedUrlPiece -> ParsedUrlPiece -> Bool
(ParsedUrlPiece -> ParsedUrlPiece -> Bool)
-> (ParsedUrlPiece -> ParsedUrlPiece -> Bool) -> Eq ParsedUrlPiece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsedUrlPiece -> ParsedUrlPiece -> Bool
$c/= :: ParsedUrlPiece -> ParsedUrlPiece -> Bool
== :: ParsedUrlPiece -> ParsedUrlPiece -> Bool
$c== :: ParsedUrlPiece -> ParsedUrlPiece -> Bool
Eq)

parseUrlPieces :: String -> Either String [ParsedUrlPiece]
parseUrlPieces :: String -> Either String [ParsedUrlPiece]
parseUrlPieces = ReadP [ParsedUrlPiece] -> String -> Either String [ParsedUrlPiece]
forall a. Show a => ReadP a -> String -> Either String a
runParser (ReadP ParsedUrlPiece -> ReadP () -> ReadP [ParsedUrlPiece]
forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP ParsedUrlPiece
parseUrlPiece ReadP ()
eof)

parseUrlPiece :: ReadP ParsedUrlPiece
parseUrlPiece :: ReadP ParsedUrlPiece
parseUrlPiece =
  [ReadP ParsedUrlPiece] -> ReadP ParsedUrlPiece
forall a. [ReadP a] -> ReadP a
choice
    [ String -> ParsedUrlPiece
InterpolatedName (String -> ParsedUrlPiece) -> ReadP String -> ReadP ParsedUrlPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP String -> ReadP String -> ReadP String -> ReadP String
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (String -> ReadP String
string String
"#{") (String -> ReadP String
string String
"}") (ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
anySingleBut Char
'}')
    , String -> ParsedUrlPiece
RawString (String -> ParsedUrlPiece) -> ReadP String -> ReadP ParsedUrlPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 (ReadP String -> ReadP ()
forall a. ReadP a -> ReadP ()
notFollowedBy (String -> ReadP String
string String
"#{") ReadP () -> ReadP Char -> ReadP Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Char
anySingle)
    ]

{--
Parser utilities

Using ReadP since it's in base, to avoid pulling down extra dependencies,
but defining helpers here to roughly mimic megaparsec's API, which is more
readable than ReadP's API.
--}

runParser :: Show a => ReadP a -> String -> Either String a
runParser :: ReadP a -> String -> Either String a
runParser ReadP a
p String
s =
  case ((a, String) -> Bool) -> [(a, String)] -> [(a, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> ((a, String) -> String) -> (a, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a b. (a, b) -> b
snd) (ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
p String
s) of
    [(a
x, String
"")] -> a -> Either String a
forall a b. b -> Either a b
Right a
x
    [] -> String -> Either String a
forall a b. a -> Either a b
Left String
"Could not parse input"
    [(a, String)]
result -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Ambiguous parse: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(a, String)] -> String
forall a. Show a => a -> String
show [(a, String)]
result

-- | Same as ReadP's 'choice', except using (<++) instead of (+++)
choice :: [ReadP a] -> ReadP a
choice :: [ReadP a] -> ReadP a
choice = (ReadP a -> ReadP a -> ReadP a) -> ReadP a -> [ReadP a] -> ReadP a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ReadP a -> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a -> ReadP a
(<++) ReadP a
forall a. ReadP a
pfail

-- | See megaparsec's 'anySingle'.
anySingle :: ReadP Char
anySingle :: ReadP Char
anySingle = ReadP Char
get

-- | See megaparsec's 'anySingleBut'.
anySingleBut :: Char -> ReadP Char
anySingleBut :: Char -> ReadP Char
anySingleBut Char
c = (Char -> Bool) -> ReadP Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c)

-- | Same as ReadP's 'many1', except using (<++) instead of (+++)
many1 :: ReadP a -> ReadP [a]
many1 :: ReadP a -> ReadP [a]
many1 ReadP a
p = (:) (a -> [a] -> [a]) -> ReadP a -> ReadP ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP a
p ReadP ([a] -> [a]) -> ReadP [a] -> ReadP [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadP a -> ReadP [a]
forall a. ReadP a -> ReadP [a]
many1 ReadP a
p ReadP [a] -> ReadP [a] -> ReadP [a]
forall a. ReadP a -> ReadP a -> ReadP a
<++ [a] -> ReadP [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])

-- | See megaparsec's 'notFollowedBy'.
notFollowedBy :: ReadP a -> ReadP ()
notFollowedBy :: ReadP a -> ReadP ()
notFollowedBy ReadP a
p = do
  Bool
failed <- (ReadP a
p ReadP a -> ReadP Bool -> ReadP Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ReadP Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) ReadP Bool -> ReadP Bool -> ReadP Bool
forall a. ReadP a -> ReadP a -> ReadP a
<++ Bool -> ReadP Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  Bool -> ReadP () -> ReadP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
failed ReadP ()
forall a. ReadP a
pfail