Parser.hs

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 (Show, Eq)

parseUrlPieces :: String -> Either String [ParsedUrlPiece]
parseUrlPieces = runParser (manyTill parseUrlPiece eof)

parseUrlPiece :: ReadP ParsedUrlPiece
parseUrlPiece =
  choice
    [ InterpolatedName <$> between (string "#{") (string "}") (many1 $ anySingleBut '}')
    , RawString <$> many1 (notFollowedBy (string "#{") >> 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 p s =
  case filter (null . snd) (readP_to_S p s) of
    [(x, "")] -> Right x
    [] -> Left "Could not parse input"
    result -> Left $ "Ambiguous parse: " ++ show result

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

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

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

-- | Same as ReadP's 'many1', except using (<++) instead of (+++)
many1 :: ReadP a -> ReadP [a]
many1 p = (:) <$> p <*> (many1 p <++ return [])

-- | See megaparsec's 'notFollowedBy'.
notFollowedBy :: ReadP a -> ReadP ()
notFollowedBy p = do
  failed <- (p >> pure False) <++ pure True
  unless failed pfail