module Snail.IO where

import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Snail.Ast
import Snail.Lexer
import Text.Megaparsec

-- | Given a 'FilePath', attempt to parse 'SnailAst' from a file.
readSnailFile :: FilePath -> IO (Either String [SnailAst])
readSnailFile :: FilePath -> IO (Either FilePath [SnailAst])
readSnailFile FilePath
fp = do
    Text
contents <- FilePath -> IO Text
Text.readFile FilePath
fp
    Either FilePath [SnailAst] -> IO (Either FilePath [SnailAst])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath [SnailAst] -> IO (Either FilePath [SnailAst]))
-> Either FilePath [SnailAst] -> IO (Either FilePath [SnailAst])
forall a b. (a -> b) -> a -> b
$ case Parsec Void Text [SnailAst]
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) [SnailAst]
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text [SnailAst]
snailAst (FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fp) Text
contents of
        Left ParseErrorBundle Text Void
parseErrorBundle -> FilePath -> Either FilePath [SnailAst]
forall a b. a -> Either a b
Left (FilePath -> Either FilePath [SnailAst])
-> FilePath -> Either FilePath [SnailAst]
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
parseErrorBundle
        Right [SnailAst]
asts -> [SnailAst] -> Either FilePath [SnailAst]
forall a b. b -> Either a b
Right [SnailAst]
asts

parseSnail :: Text -> Either String [SnailAst]
parseSnail :: Text -> Either FilePath [SnailAst]
parseSnail Text
input =
    case Parsec Void Text [SnailAst]
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) [SnailAst]
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text [SnailAst]
snailAst (Text -> FilePath
Text.unpack Text
input) Text
input of
        Left ParseErrorBundle Text Void
parseErrorBundle -> FilePath -> Either FilePath [SnailAst]
forall a b. a -> Either a b
Left (FilePath -> Either FilePath [SnailAst])
-> FilePath -> Either FilePath [SnailAst]
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
parseErrorBundle
        Right [SnailAst]
asts -> [SnailAst] -> Either FilePath [SnailAst]
forall a b. b -> Either a b
Right [SnailAst]
asts