{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Parser for the Swarm language.  Note, you probably don't want to
-- use this directly, unless there is a good reason to parse a term
-- without also type checking it; use
-- 'Swarm.Language.Pipeline.processTerm' instead, which parses,
-- typechecks, elaborates, and capability checks a term all at once.
module Swarm.Language.Parser (
  readTerm,
  readNonemptyTerm,
  readTerm',
) where

import Control.Monad ((>=>))
import Data.Bifunctor (first, second)
import Data.Either.Extra (maybeToEither)
import Data.Sequence (Seq)
import Data.Text (Text)
import Swarm.Language.Parser.Comment (populateComments)
import Swarm.Language.Parser.Core (ParserConfig, ParserError, defaultParserConfig, runParser')
import Swarm.Language.Parser.Lex (sc)
import Swarm.Language.Parser.Term (parseTerm)
import Swarm.Language.Parser.Util (fullyMaybe)
import Swarm.Language.Syntax (Comment, Syntax)
import Text.Megaparsec.Error (errorBundlePretty)
import Witch (from)

-- | Parse some input 'Text' completely as a 'Term', consuming leading
--   whitespace and ensuring the parsing extends all the way to the
--   end of the input 'Text'.  Returns an error if the term was only
--   whitespace.
readNonemptyTerm :: Text -> Either Text Syntax
readNonemptyTerm :: Text -> Either Text Syntax
readNonemptyTerm = Text -> Either Text (Maybe Syntax)
readTerm (Text -> Either Text (Maybe Syntax))
-> (Maybe Syntax -> Either Text Syntax)
-> Text
-> Either Text Syntax
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe Syntax -> Either Text Syntax
forall a b. a -> Maybe b -> Either a b
maybeToEither Text
"Empty term"

-- | Parse some input 'Text' completely as a 'Term', consuming leading
--   whitespace and ensuring the parsing extends all the way to the
--   end of the input 'Text'.  Returns either the resulting 'Term' (or
--   'Nothing' if the input was only whitespace) or a pretty-printed
--   parse error message.
readTerm :: Text -> Either Text (Maybe Syntax)
readTerm :: Text -> Either Text (Maybe Syntax)
readTerm = (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) (Maybe Syntax)
-> Either Text (Maybe Syntax)
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
forall source target. From source target => source -> target
from (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) (Maybe Syntax)
 -> Either Text (Maybe Syntax))
-> (Text -> Either (ParseErrorBundle Text Void) (Maybe Syntax))
-> Text
-> Either Text (Maybe Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserConfig
-> Text -> Either (ParseErrorBundle Text Void) (Maybe Syntax)
readTerm' ParserConfig
defaultParserConfig

-- | A lower-level `readTerm` which allow configuring the parser and
--   returns the megaparsec bundle error for precise error reporting.
readTerm' :: ParserConfig -> Text -> Either ParserError (Maybe Syntax)
readTerm' :: ParserConfig
-> Text -> Either (ParseErrorBundle Text Void) (Maybe Syntax)
readTerm' ParserConfig
cfg = ((Maybe Syntax, Seq Comment) -> Maybe Syntax)
-> Either (ParseErrorBundle Text Void) (Maybe Syntax, Seq Comment)
-> Either (ParseErrorBundle Text Void) (Maybe Syntax)
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Maybe Syntax, Seq Comment) -> Maybe Syntax
handleComments (Either (ParseErrorBundle Text Void) (Maybe Syntax, Seq Comment)
 -> Either (ParseErrorBundle Text Void) (Maybe Syntax))
-> (Text
    -> Either (ParseErrorBundle Text Void) (Maybe Syntax, Seq Comment))
-> Text
-> Either (ParseErrorBundle Text Void) (Maybe Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserConfig
-> Parser (Maybe Syntax)
-> Text
-> Either (ParseErrorBundle Text Void) (Maybe Syntax, Seq Comment)
forall a.
ParserConfig
-> Parser a
-> Text
-> Either (ParseErrorBundle Text Void) (a, Seq Comment)
runParser' ParserConfig
cfg (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Syntax
-> Parser (Maybe Syntax)
forall e s (f :: * -> *) a.
MonadParsec e s f =>
f () -> f a -> f (Maybe a)
fullyMaybe ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
sc ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Syntax
parseTerm)
 where
  handleComments :: (Maybe Syntax, Seq Comment) -> Maybe Syntax
  handleComments :: (Maybe Syntax, Seq Comment) -> Maybe Syntax
handleComments (Maybe Syntax
s, Seq Comment
cs) = Seq Comment -> Syntax -> Syntax
populateComments Seq Comment
cs (Syntax -> Syntax) -> Maybe Syntax -> Maybe Syntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Syntax
s