{- |
Module      : Language.Egison.Parser
Licence     : MIT

This module provides the parser interface.
-}

module Language.Egison.Parser
       (
       -- * Parse
         readTopExprs
       , readTopExpr
       , readExprs
       , readExpr
       , parseTopExpr
       -- * Parse a file
       , loadLibraryFile
       , loadFile
       -- * Parser utils (for translator)
       , removeShebang
       , readUTF8File
       ) where

import           Control.Monad.Except         (lift, liftIO, throwError)
import           Control.Monad.Reader         (asks, local)
import           Control.Monad.State          (unless)

import           System.Directory             (doesFileExist, getHomeDirectory)
import           System.IO

import           Language.Egison.AST
import           Language.Egison.CmdOptions
import           Language.Egison.Data
import qualified Language.Egison.Parser.NonS  as NonS
import qualified Language.Egison.Parser.SExpr as SExpr
import           Language.Egison.RState
import           Paths_egison                 (getDataFileName)

readTopExprs :: String -> EvalM [TopExpr]
readTopExprs :: String -> EvalM [TopExpr]
readTopExprs String
expr = do
  Bool
isSExpr <- (EgisonOpts -> Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EgisonOpts -> Bool
optSExpr
  if Bool
isSExpr
     then (String -> EvalM [TopExpr])
-> ([TopExpr] -> EvalM [TopExpr])
-> Either String [TopExpr]
-> EvalM [TopExpr]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EgisonError -> EvalM [TopExpr]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM [TopExpr])
-> (String -> EgisonError) -> String -> EvalM [TopExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EgisonError
Parser) [TopExpr] -> EvalM [TopExpr]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String [TopExpr]
SExpr.parseTopExprs String
expr)
     else do Either String [TopExpr]
r <- ExceptT EgisonError RuntimeM (Either String [TopExpr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [TopExpr])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT EgisonError RuntimeM (Either String [TopExpr])
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String [TopExpr]))
-> (ReaderT EgisonOpts (StateT RState IO) (Either String [TopExpr])
    -> ExceptT EgisonError RuntimeM (Either String [TopExpr]))
-> ReaderT EgisonOpts (StateT RState IO) (Either String [TopExpr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [TopExpr])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT EgisonOpts (StateT RState IO) (Either String [TopExpr])
-> ExceptT EgisonError RuntimeM (Either String [TopExpr])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT EgisonOpts (StateT RState IO) (Either String [TopExpr])
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String [TopExpr]))
-> ReaderT EgisonOpts (StateT RState IO) (Either String [TopExpr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [TopExpr])
forall a b. (a -> b) -> a -> b
$ String
-> ReaderT EgisonOpts (StateT RState IO) (Either String [TopExpr])
NonS.parseTopExprs String
expr
             (String -> EvalM [TopExpr])
-> ([TopExpr] -> EvalM [TopExpr])
-> Either String [TopExpr]
-> EvalM [TopExpr]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EgisonError -> EvalM [TopExpr]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM [TopExpr])
-> (String -> EgisonError) -> String -> EvalM [TopExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EgisonError
Parser) [TopExpr] -> EvalM [TopExpr]
forall (m :: * -> *) a. Monad m => a -> m a
return Either String [TopExpr]
r

parseTopExpr :: String -> RuntimeM (Either String TopExpr)
parseTopExpr :: String -> RuntimeM (Either String TopExpr)
parseTopExpr String
expr = do
  Bool
isSExpr <- (EgisonOpts -> Bool) -> ReaderT EgisonOpts (StateT RState IO) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EgisonOpts -> Bool
optSExpr
  if Bool
isSExpr
     then Either String TopExpr -> RuntimeM (Either String TopExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String TopExpr
SExpr.parseTopExpr String
expr)
     else String -> RuntimeM (Either String TopExpr)
NonS.parseTopExpr String
expr

readTopExpr :: String -> EvalM TopExpr
readTopExpr :: String -> EvalM TopExpr
readTopExpr String
expr = do
  Bool
isSExpr <- (EgisonOpts -> Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EgisonOpts -> Bool
optSExpr
  if Bool
isSExpr
     then (String -> EvalM TopExpr)
-> (TopExpr -> EvalM TopExpr)
-> Either String TopExpr
-> EvalM TopExpr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EgisonError -> EvalM TopExpr
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM TopExpr)
-> (String -> EgisonError) -> String -> EvalM TopExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EgisonError
Parser) TopExpr -> EvalM TopExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String TopExpr
SExpr.parseTopExpr String
expr)
     else do Either String TopExpr
r <- ExceptT EgisonError RuntimeM (Either String TopExpr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String TopExpr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT EgisonError RuntimeM (Either String TopExpr)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String TopExpr))
-> (RuntimeM (Either String TopExpr)
    -> ExceptT EgisonError RuntimeM (Either String TopExpr))
-> RuntimeM (Either String TopExpr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String TopExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeM (Either String TopExpr)
-> ExceptT EgisonError RuntimeM (Either String TopExpr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RuntimeM (Either String TopExpr)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String TopExpr))
-> RuntimeM (Either String TopExpr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String TopExpr)
forall a b. (a -> b) -> a -> b
$ String -> RuntimeM (Either String TopExpr)
NonS.parseTopExpr String
expr
             (String -> EvalM TopExpr)
-> (TopExpr -> EvalM TopExpr)
-> Either String TopExpr
-> EvalM TopExpr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EgisonError -> EvalM TopExpr
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM TopExpr)
-> (String -> EgisonError) -> String -> EvalM TopExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EgisonError
Parser) TopExpr -> EvalM TopExpr
forall (m :: * -> *) a. Monad m => a -> m a
return Either String TopExpr
r

readExprs :: String -> EvalM [Expr]
readExprs :: String -> EvalM [Expr]
readExprs String
expr = do
  Bool
isSExpr <- (EgisonOpts -> Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EgisonOpts -> Bool
optSExpr
  if Bool
isSExpr
     then (String -> EvalM [Expr])
-> ([Expr] -> EvalM [Expr]) -> Either String [Expr] -> EvalM [Expr]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EgisonError -> EvalM [Expr]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM [Expr])
-> (String -> EgisonError) -> String -> EvalM [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EgisonError
Parser) [Expr] -> EvalM [Expr]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String [Expr]
SExpr.parseExprs String
expr)
     else do Either String [Expr]
r <- ExceptT EgisonError RuntimeM (Either String [Expr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT EgisonError RuntimeM (Either String [Expr])
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr]))
-> (ReaderT EgisonOpts (StateT RState IO) (Either String [Expr])
    -> ExceptT EgisonError RuntimeM (Either String [Expr]))
-> ReaderT EgisonOpts (StateT RState IO) (Either String [Expr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT EgisonOpts (StateT RState IO) (Either String [Expr])
-> ExceptT EgisonError RuntimeM (Either String [Expr])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT EgisonOpts (StateT RState IO) (Either String [Expr])
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr]))
-> ReaderT EgisonOpts (StateT RState IO) (Either String [Expr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr])
forall a b. (a -> b) -> a -> b
$ String
-> ReaderT EgisonOpts (StateT RState IO) (Either String [Expr])
NonS.parseExprs String
expr
             (String -> EvalM [Expr])
-> ([Expr] -> EvalM [Expr]) -> Either String [Expr] -> EvalM [Expr]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EgisonError -> EvalM [Expr]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM [Expr])
-> (String -> EgisonError) -> String -> EvalM [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EgisonError
Parser) [Expr] -> EvalM [Expr]
forall (m :: * -> *) a. Monad m => a -> m a
return Either String [Expr]
r

readExpr :: String -> EvalM Expr
readExpr :: String -> EvalM Expr
readExpr String
expr = do
  Bool
isSExpr <- (EgisonOpts -> Bool)
-> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EgisonOpts -> Bool
optSExpr
  if Bool
isSExpr
     then (String -> EvalM Expr)
-> (Expr -> EvalM Expr) -> Either String Expr -> EvalM Expr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EgisonError -> EvalM Expr
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM Expr)
-> (String -> EgisonError) -> String -> EvalM Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EgisonError
Parser) Expr -> EvalM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String Expr
SExpr.parseExpr String
expr)
     else do Either String Expr
r <- ExceptT EgisonError RuntimeM (Either String Expr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String Expr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT EgisonError RuntimeM (Either String Expr)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String Expr))
-> (ReaderT EgisonOpts (StateT RState IO) (Either String Expr)
    -> ExceptT EgisonError RuntimeM (Either String Expr))
-> ReaderT EgisonOpts (StateT RState IO) (Either String Expr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT EgisonOpts (StateT RState IO) (Either String Expr)
-> ExceptT EgisonError RuntimeM (Either String Expr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT EgisonOpts (StateT RState IO) (Either String Expr)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String Expr))
-> ReaderT EgisonOpts (StateT RState IO) (Either String Expr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String Expr)
forall a b. (a -> b) -> a -> b
$ String
-> ReaderT EgisonOpts (StateT RState IO) (Either String Expr)
NonS.parseExpr String
expr
             (String -> EvalM Expr)
-> (Expr -> EvalM Expr) -> Either String Expr -> EvalM Expr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EgisonError -> EvalM Expr
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> EvalM Expr)
-> (String -> EgisonError) -> String -> EvalM Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EgisonError
Parser) Expr -> EvalM Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Expr
r

-- |Load a libary file
loadLibraryFile :: FilePath -> EvalM [TopExpr]
loadLibraryFile :: String -> EvalM [TopExpr]
loadLibraryFile String
file = do
  String
homeDir <- IO String -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getHomeDirectory
  Bool
doesExist <- IO Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool)
-> IO Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
homeDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/.egison/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
  if Bool
doesExist
    then String -> EvalM [TopExpr]
loadFile (String -> EvalM [TopExpr]) -> String -> EvalM [TopExpr]
forall a b. (a -> b) -> a -> b
$ String
homeDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/.egison/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
    else IO String -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO String
getDataFileName String
file) StateT EvalState (ExceptT EgisonError RuntimeM) String
-> (String -> EvalM [TopExpr]) -> EvalM [TopExpr]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> EvalM [TopExpr]
loadFile

-- |Load a file
loadFile :: FilePath -> EvalM [TopExpr]
loadFile :: String -> EvalM [TopExpr]
loadFile String
file = do
  Bool
doesExist <- IO Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool)
-> IO Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
file
  Bool
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
doesExist (StateT EvalState (ExceptT EgisonError RuntimeM) ()
 -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) ())
-> EgisonError
-> StateT EvalState (ExceptT EgisonError RuntimeM) ()
forall a b. (a -> b) -> a -> b
$ String -> EgisonError
Default (String
"file does not exist: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file)
  String
input <- IO String -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String
 -> StateT EvalState (ExceptT EgisonError RuntimeM) String)
-> IO String
-> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readUTF8File String
file
  let useSExpr :: Bool
useSExpr = String -> Bool
checkIfUseSExpr String
file
  [TopExpr]
exprs <- (EgisonOpts -> EgisonOpts) -> EvalM [TopExpr] -> EvalM [TopExpr]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\EgisonOpts
opt -> EgisonOpts
opt { optSExpr :: Bool
optSExpr = Bool
useSExpr })
                 (String -> EvalM [TopExpr]
readTopExprs (Bool -> String -> String
removeShebang Bool
useSExpr String
input))
  [[TopExpr]] -> [TopExpr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TopExpr]] -> [TopExpr])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [[TopExpr]]
-> EvalM [TopExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TopExpr -> EvalM [TopExpr])
-> [TopExpr]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [[TopExpr]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TopExpr -> EvalM [TopExpr]
recursiveLoad [TopExpr]
exprs
 where
  recursiveLoad :: TopExpr -> EvalM [TopExpr]
recursiveLoad (Load String
file)     = String -> EvalM [TopExpr]
loadLibraryFile String
file
  recursiveLoad (LoadFile String
file) = String -> EvalM [TopExpr]
loadFile String
file
  recursiveLoad TopExpr
expr            = [TopExpr] -> EvalM [TopExpr]
forall (m :: * -> *) a. Monad m => a -> m a
return [TopExpr
expr]

removeShebang :: Bool -> String -> String
removeShebang :: Bool -> String -> String
removeShebang Bool
useSExpr cs :: String
cs@(Char
'#':Char
'!':String
_) = if Bool
useSExpr then Char
';' Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs else String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs
removeShebang Bool
_        String
cs             = String
cs

readUTF8File :: FilePath -> IO String
readUTF8File :: String -> IO String
readUTF8File String
name = do
  Handle
h <- String -> IOMode -> IO Handle
openFile String
name IOMode
ReadMode
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
  Handle -> IO String
hGetContents Handle
h

checkIfUseSExpr :: String -> Bool
checkIfUseSExpr :: String -> Bool
checkIfUseSExpr String
file = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
file Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".segi"