-- | Parsing of format strings.
module Futhark.Format (parseFormatString) where

import Data.Bifunctor
import Data.Text qualified as T
import Data.Void
import Text.Megaparsec

pFormatString :: Parsec Void T.Text [Either T.Text T.Text]
pFormatString :: Parsec Void Text [Either Text Text]
pFormatString =
  ParsecT Void Text Identity (Either Text Text)
-> Parsec Void Text [Either Text Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([ParsecT Void Text Identity (Either Text Text)]
-> ParsecT Void Text Identity (Either Text Text)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Either Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
pLiteral, Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Either Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
pInterpolation]) Parsec Void Text [Either Text Text]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [Either Text Text]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  where
    pInterpolation :: ParsecT Void Text Identity (Tokens Text)
pInterpolation = ParsecT Void Text Identity Text
"{" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
braces) ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
"}"
    pLiteral :: ParsecT Void Text Identity (Tokens Text)
pLiteral = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
braces)
    braces :: String
braces = String
"{}" :: String

-- | The Lefts are pure text; the Rights are the contents of
-- interpolations.
parseFormatString :: T.Text -> Either T.Text [Either T.Text T.Text]
parseFormatString :: Text -> Either Text [Either Text Text]
parseFormatString =
  (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) [Either Text Text]
-> Either Text [Either Text Text]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
T.pack (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) (Either (ParseErrorBundle Text Void) [Either Text Text]
 -> Either Text [Either Text Text])
-> (Text -> Either (ParseErrorBundle Text Void) [Either Text Text])
-> Text
-> Either Text [Either Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text [Either Text Text]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [Either Text Text]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text [Either Text Text]
pFormatString String
""