{- |
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                 (unless)
import           Control.Monad.Except         (throwError)
import           Control.Monad.IO.Class       (liftIO)
import           Control.Monad.Trans.Class    (lift)

import           System.Directory             (doesFileExist, getCurrentDirectory, getHomeDirectory)
import           System.FilePath              (takeDirectory, (</>))
import           System.IO

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

readTopExprs :: String -> EvalM [TopExpr]
readTopExprs :: String -> EvalM [TopExpr]
readTopExprs String
expr = do
  Either String [TopExpr]
r <- ExceptT EgisonError RuntimeM (Either String [TopExpr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [TopExpr])
forall (m :: * -> *) a. Monad m => m a -> StateT EvalState m a
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 (m :: * -> *) a. Monad m => m a -> ExceptT EgisonError m a
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.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 a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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 a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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 -> RuntimeM (Either String TopExpr)
NonS.parseTopExpr

readTopExpr :: String -> EvalM TopExpr
readTopExpr :: String -> EvalM TopExpr
readTopExpr String
expr = do
  Either String TopExpr
r <- ExceptT EgisonError RuntimeM (Either String TopExpr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String TopExpr)
forall (m :: * -> *) a. Monad m => m a -> StateT EvalState m a
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 (m :: * -> *) a. Monad m => m a -> ExceptT EgisonError m a
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 a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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 a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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
  Either String [Expr]
r <- ExceptT EgisonError RuntimeM (Either String [Expr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr])
forall (m :: * -> *) a. Monad m => m a -> StateT EvalState m a
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]))
-> (RuntimeM (Either String [Expr])
    -> ExceptT EgisonError RuntimeM (Either String [Expr]))
-> RuntimeM (Either String [Expr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeM (Either String [Expr])
-> ExceptT EgisonError RuntimeM (Either String [Expr])
forall (m :: * -> *) a. Monad m => m a -> ExceptT EgisonError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RuntimeM (Either String [Expr])
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr]))
-> RuntimeM (Either String [Expr])
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String [Expr])
forall a b. (a -> b) -> a -> b
$ String -> RuntimeM (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 a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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 a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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
  Either String Expr
r <- ExceptT EgisonError RuntimeM (Either String Expr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String Expr)
forall (m :: * -> *) a. Monad m => m a -> StateT EvalState m a
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))
-> (RuntimeM (Either String Expr)
    -> ExceptT EgisonError RuntimeM (Either String Expr))
-> RuntimeM (Either String Expr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeM (Either String Expr)
-> ExceptT EgisonError RuntimeM (Either String Expr)
forall (m :: * -> *) a. Monad m => m a -> ExceptT EgisonError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RuntimeM (Either String Expr)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (Either String Expr))
-> RuntimeM (Either String Expr)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (Either String Expr)
forall a b. (a -> b) -> a -> b
$ String -> RuntimeM (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 a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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 a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Expr
r

-- |Load a libary file
-- Priority order:
-- 1. ~/.egison/lib/ (user customizations)
-- 2. Project lib/ directory (development - current directory or parent directories)
-- 3. Installed data files (getDataFileName)
loadLibraryFile :: FilePath -> EvalM [TopExpr]
loadLibraryFile :: String -> EvalM [TopExpr]
loadLibraryFile String
file = do
  String
homeDir <- IO String -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getHomeDirectory
  let userLibPath :: String
userLibPath = String
homeDir String -> String -> String
</> String
".egison" String -> String -> String
</> String
file
  Bool
userExists <- IO Bool -> StateT EvalState (ExceptT EgisonError RuntimeM) Bool
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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
userLibPath
  if Bool
userExists
    then String -> EvalM [TopExpr]
loadFile String
userLibPath
    else do
      -- Try project lib directory (for development)
      -- Start from current directory and go up to find lib directory
      Maybe String
projectLibPath <- IO (Maybe String)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Maybe String)
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
 -> StateT EvalState (ExceptT EgisonError RuntimeM) (Maybe String))
-> IO (Maybe String)
-> StateT EvalState (ExceptT EgisonError RuntimeM) (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
        String
currentDir <- IO String
getCurrentDirectory
        let findLibDir :: String -> IO (Maybe String)
findLibDir String
dir = do
              let libPath :: String
libPath = String
dir String -> String -> String
</> String
"lib" String -> String -> String
</> String
file
              Bool
exists <- String -> IO Bool
doesFileExist String
libPath
              if Bool
exists
                then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
libPath)
                else do
                  let parentDir :: String
parentDir = String -> String
takeDirectory String
dir
                  if String
parentDir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
dir  -- reached root
                    then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    else String -> IO (Maybe String)
findLibDir String
parentDir
        String -> IO (Maybe String)
findLibDir String
currentDir
      case Maybe String
projectLibPath of
        Just String
path -> String -> EvalM [TopExpr]
loadFile String
path
        Maybe String
Nothing -> do
          -- Fall back to installed data files
          -- This may fail if not installed, but that's expected in development
          String
installedPath <- IO String -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO String
getDataFileName String
file)
          String -> EvalM [TopExpr]
loadFile String
installedPath

-- |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 a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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 a.
EgisonError -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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 a. IO a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
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
  [TopExpr]
exprs <- String -> EvalM [TopExpr]
readTopExprs (String -> String
removeShebang 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return [TopExpr
expr]

removeShebang :: String -> String
removeShebang :: String -> String
removeShebang cs :: String
cs@(Char
'#':Char
'!':String
_) = String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs
removeShebang 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