{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}

-- | Handles finding imports and compiling them recursively.
-- This is done for each full AST traversal the copmiler does
-- which at this point is InitialPass's preprocessing
-- and Compiler's code generation
module Fay.Compiler.Import
  ( startCompile
  , compileWith
  ) where

import           Fay.Compiler.Prelude

import           Fay.Compiler.Misc
import           Fay.Compiler.Parse
import           Fay.Config
import qualified Fay.Exts                        as F
import           Fay.Exts.NoAnnotation           (unAnn)
import           Fay.Types

import           Control.Monad.Except            (throwError)
import           Control.Monad.RWS               (ask, get, gets, lift, listen, modify)
import           Language.Haskell.Exts hiding (name)
import           System.Directory
import           System.FilePath

-- | Start the compilation process using `compileModule` to compile a file.
startCompile :: (FilePath -> String -> Compile a) -> FilePath -> Compile a
startCompile :: (FilePath -> FilePath -> Compile a) -> FilePath -> Compile a
startCompile FilePath -> FilePath -> Compile a
compileModule FilePath
filein = do
  (CompileState -> CompileState) -> Compile ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompileState -> CompileState) -> Compile ())
-> (CompileState -> CompileState) -> Compile ()
forall a b. (a -> b) -> a -> b
$ \CompileState
s -> CompileState
s { stateImported :: [(ModuleName, FilePath)]
stateImported = [] }
  ((a, CompileWriter) -> a)
-> Compile (a, CompileWriter) -> Compile a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, CompileWriter) -> a
forall a b. (a, b) -> a
fst (Compile (a, CompileWriter) -> Compile a)
-> (Compile a -> Compile (a, CompileWriter))
-> Compile a
-> Compile a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compile a -> Compile (a, CompileWriter)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (Compile a -> Compile a) -> Compile a -> Compile a
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath -> Compile a) -> FilePath -> Compile a
forall a.
(FilePath -> FilePath -> Compile a) -> FilePath -> Compile a
compileModuleFromFile FilePath -> FilePath -> Compile a
compileModule FilePath
filein

-- | Compile a module
compileWith
  :: (Monoid a, Semigroup a)
  => FilePath
  -> (a -> F.Module -> Compile a)
  -> (FilePath -> String -> Compile a)
  -> (F.X -> F.Module -> IO (Either CompileError F.Module))
  -> String
  -> Compile (a, CompileState, CompileWriter)
compileWith :: FilePath
-> (a -> Module -> Compile a)
-> (FilePath -> FilePath -> Compile a)
-> (X -> Module -> IO (Either CompileError Module))
-> FilePath
-> Compile (a, CompileState, CompileWriter)
compileWith FilePath
filepath a -> Module -> Compile a
with FilePath -> FilePath -> Compile a
compileModule X -> Module -> IO (Either CompileError Module)
before FilePath
from = do
  CompileReader
rd <- Compile CompileReader
forall r (m :: * -> *). MonadReader r m => m r
ask
  CompileState
st <- Compile CompileState
forall s (m :: * -> *). MonadState s m => m s
get
  Either CompileError (a, CompileState, CompileWriter)
res <- RWST
  CompileReader
  CompileWriter
  CompileState
  (ExceptT CompileError (ModuleT Symbols IO))
  (Either CompileError (a, CompileState, CompileWriter))
-> Compile (Either CompileError (a, CompileState, CompileWriter))
forall a.
RWST
  CompileReader
  CompileWriter
  CompileState
  (ExceptT CompileError (ModuleT (ModuleInfo Compile) IO))
  a
-> Compile a
Compile (RWST
   CompileReader
   CompileWriter
   CompileState
   (ExceptT CompileError (ModuleT Symbols IO))
   (Either CompileError (a, CompileState, CompileWriter))
 -> Compile (Either CompileError (a, CompileState, CompileWriter)))
-> (ModuleT
      Symbols IO (Either CompileError (a, CompileState, CompileWriter))
    -> RWST
         CompileReader
         CompileWriter
         CompileState
         (ExceptT CompileError (ModuleT Symbols IO))
         (Either CompileError (a, CompileState, CompileWriter)))
-> ModuleT
     Symbols IO (Either CompileError (a, CompileState, CompileWriter))
-> Compile (Either CompileError (a, CompileState, CompileWriter))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  CompileError
  (ModuleT Symbols IO)
  (Either CompileError (a, CompileState, CompileWriter))
-> RWST
     CompileReader
     CompileWriter
     CompileState
     (ExceptT CompileError (ModuleT Symbols IO))
     (Either CompileError (a, CompileState, CompileWriter))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT
   CompileError
   (ModuleT Symbols IO)
   (Either CompileError (a, CompileState, CompileWriter))
 -> RWST
      CompileReader
      CompileWriter
      CompileState
      (ExceptT CompileError (ModuleT Symbols IO))
      (Either CompileError (a, CompileState, CompileWriter)))
-> (ModuleT
      Symbols IO (Either CompileError (a, CompileState, CompileWriter))
    -> ExceptT
         CompileError
         (ModuleT Symbols IO)
         (Either CompileError (a, CompileState, CompileWriter)))
-> ModuleT
     Symbols IO (Either CompileError (a, CompileState, CompileWriter))
-> RWST
     CompileReader
     CompileWriter
     CompileState
     (ExceptT CompileError (ModuleT Symbols IO))
     (Either CompileError (a, CompileState, CompileWriter))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleT
  Symbols IO (Either CompileError (a, CompileState, CompileWriter))
-> ExceptT
     CompileError
     (ModuleT Symbols IO)
     (Either CompileError (a, CompileState, CompileWriter))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ModuleT
   Symbols IO (Either CompileError (a, CompileState, CompileWriter))
 -> Compile (Either CompileError (a, CompileState, CompileWriter)))
-> ModuleT
     Symbols IO (Either CompileError (a, CompileState, CompileWriter))
-> Compile (Either CompileError (a, CompileState, CompileWriter))
forall a b. (a -> b) -> a -> b
$
    CompileReader
-> CompileState
-> Compile a
-> ModuleT
     Symbols IO (Either CompileError (a, CompileState, CompileWriter))
forall a.
CompileReader -> CompileState -> Compile a -> CompileModule a
runCompileModule
      CompileReader
rd
      CompileState
st
      (((SrcLoc, FilePath) -> Compile a)
-> (Module -> Compile a) -> ParseResult Module -> Compile a
forall b a.
((SrcLoc, FilePath) -> b) -> (a -> b) -> ParseResult a -> b
parseResult (CompileError -> Compile a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> Compile a)
-> ((SrcLoc, FilePath) -> CompileError)
-> (SrcLoc, FilePath)
-> Compile a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcLoc -> FilePath -> CompileError)
-> (SrcLoc, FilePath) -> CompileError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SrcLoc -> FilePath -> CompileError
ParseError)
                   (\Module
mod' -> do
                     ~mod :: Module
mod@(Module X
_ Maybe (ModuleHead X)
_ [ModulePragma X]
_ [ImportDecl X]
imports [Decl X]
_) <-
                       (CompileError -> Compile Module)
-> (Module -> Compile Module)
-> Either CompileError Module
-> Compile Module
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CompileError -> Compile Module
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Module -> Compile Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CompileError Module -> Compile Module)
-> Compile (Either CompileError Module) -> Compile Module
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either CompileError Module)
-> Compile (Either CompileError Module)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (X -> Module -> IO (Either CompileError Module)
before X
F.noI Module
mod')
                     a
res <- (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) a
forall a. Monoid a => a
mempty ([a] -> a) -> Compile [a] -> Compile a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportDecl X -> Compile a) -> [ImportDecl X] -> Compile [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((FilePath -> FilePath -> Compile a) -> ImportDecl X -> Compile a
forall a.
Monoid a =>
(FilePath -> FilePath -> Compile a) -> ImportDecl X -> Compile a
compileImport FilePath -> FilePath -> Compile a
compileModule) [ImportDecl X]
imports
                     (CompileState -> CompileState) -> Compile ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompileState -> CompileState) -> Compile ())
-> (CompileState -> CompileState) -> Compile ()
forall a b. (a -> b) -> a -> b
$ \CompileState
s -> CompileState
s { stateModuleName :: ModuleName
stateModuleName = ModuleName X -> ModuleName
forall (f :: * -> *) a. Functor f => f a -> f ()
unAnn (ModuleName X -> ModuleName) -> ModuleName X -> ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName X
forall a. SrcInfo a => Module a -> ModuleName a
F.moduleName Module
mod }
                     a -> Module -> Compile a
with a
res Module
mod
                   )
                   (FilePath -> FilePath -> ParseResult Module
forall ast.
Parseable ast =>
FilePath -> FilePath -> ParseResult ast
parseFay FilePath
filepath FilePath
from))
  (CompileError -> Compile (a, CompileState, CompileWriter))
-> ((a, CompileState, CompileWriter)
    -> Compile (a, CompileState, CompileWriter))
-> Either CompileError (a, CompileState, CompileWriter)
-> Compile (a, CompileState, CompileWriter)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CompileError -> Compile (a, CompileState, CompileWriter)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (a, CompileState, CompileWriter)
-> Compile (a, CompileState, CompileWriter)
forall (m :: * -> *) a. Monad m => a -> m a
return Either CompileError (a, CompileState, CompileWriter)
res

-- | Compile a module given its file path
compileModuleFromFile
  :: (FilePath -> String -> Compile a)
  -> FilePath
  -> Compile a
compileModuleFromFile :: (FilePath -> FilePath -> Compile a) -> FilePath -> Compile a
compileModuleFromFile FilePath -> FilePath -> Compile a
compileModule FilePath
fp = IO FilePath -> Compile FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (FilePath -> IO FilePath
readFile FilePath
fp) Compile FilePath -> (FilePath -> Compile a) -> Compile a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FilePath -> Compile a
compileModule FilePath
fp

-- | Lookup a module from include directories and compile.
compileModuleFromName
  :: Monoid a
  => (FilePath -> String -> Compile a)
  -> F.ModuleName
  -> Compile a
compileModuleFromName :: (FilePath -> FilePath -> Compile a) -> ModuleName X -> Compile a
compileModuleFromName FilePath -> FilePath -> Compile a
compileModule ModuleName X
nm =
  ModuleName X -> (FilePath -> FilePath -> Compile a) -> Compile a
forall a l.
Monoid a =>
ModuleName l -> (FilePath -> FilePath -> Compile a) -> Compile a
unlessImported ModuleName X
nm FilePath -> FilePath -> Compile a
compileModule
    where
      unlessImported
        :: Monoid a
        => ModuleName l
        -> (FilePath -> String -> Compile a)
        -> Compile a
      unlessImported :: ModuleName l -> (FilePath -> FilePath -> Compile a) -> Compile a
unlessImported (ModuleName l
_ FilePath
"Fay.Types") FilePath -> FilePath -> Compile a
_ = a -> Compile a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
      unlessImported (ModuleName l -> ModuleName
forall (f :: * -> *) a. Functor f => f a -> f ()
unAnn -> ModuleName
name) FilePath -> FilePath -> Compile a
importIt = do
        [(ModuleName, FilePath)]
imported <- (CompileState -> [(ModuleName, FilePath)])
-> Compile [(ModuleName, FilePath)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompileState -> [(ModuleName, FilePath)]
stateImported
        case ModuleName -> [(ModuleName, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ModuleName
name [(ModuleName, FilePath)]
imported of
          Just FilePath
_  -> a -> Compile a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
          Maybe FilePath
Nothing -> do
            [FilePath]
dirs <- Config -> [FilePath]
configDirectoryIncludePaths (Config -> [FilePath]) -> Compile Config -> Compile [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Config -> Config) -> Compile Config
forall a. (Config -> a) -> Compile a
config Config -> Config
forall a. a -> a
id
            (FilePath
filepath,FilePath
contents) <- [FilePath] -> ModuleName -> Compile (FilePath, FilePath)
forall a.
[FilePath] -> ModuleName a -> Compile (FilePath, FilePath)
findImport [FilePath]
dirs ModuleName
name
            (CompileState -> CompileState) -> Compile ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompileState -> CompileState) -> Compile ())
-> (CompileState -> CompileState) -> Compile ()
forall a b. (a -> b) -> a -> b
$ \CompileState
s -> CompileState
s { stateImported :: [(ModuleName, FilePath)]
stateImported = (ModuleName
name,FilePath
filepath) (ModuleName, FilePath)
-> [(ModuleName, FilePath)] -> [(ModuleName, FilePath)]
forall a. a -> [a] -> [a]
: [(ModuleName, FilePath)]
imported }
            FilePath -> FilePath -> Compile a
importIt FilePath
filepath FilePath
contents

-- | Compile an import.
compileImport
  :: Monoid a
  => (FilePath -> String -> Compile a)
  -> F.ImportDecl
  -> Compile a
compileImport :: (FilePath -> FilePath -> Compile a) -> ImportDecl X -> Compile a
compileImport FilePath -> FilePath -> Compile a
compileModule ImportDecl X
i = case ImportDecl X
i of
  -- Trickery in fay-base needs this special case
  ImportDecl X
_ ModuleName X
_    Bool
_ Bool
_ Bool
_ (Just FilePath
"base") Maybe (ModuleName X)
_ Maybe (ImportSpecList X)
_ -> a -> Compile a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
  ImportDecl X
_ ModuleName X
name Bool
_ Bool
_ Bool
_ Maybe FilePath
_ Maybe (ModuleName X)
_ Maybe (ImportSpecList X)
_ -> (FilePath -> FilePath -> Compile a) -> ModuleName X -> Compile a
forall a.
Monoid a =>
(FilePath -> FilePath -> Compile a) -> ModuleName X -> Compile a
compileModuleFromName FilePath -> FilePath -> Compile a
compileModule ModuleName X
name

-- | Find an import's filepath and contents from its module name.
findImport :: [FilePath] -> ModuleName a -> Compile (FilePath,String)
findImport :: [FilePath] -> ModuleName a -> Compile (FilePath, FilePath)
findImport [FilePath]
alldirs (ModuleName a -> ModuleName
forall (f :: * -> *) a. Functor f => f a -> f ()
unAnn -> ModuleName
mname) = [FilePath] -> ModuleName -> Compile (FilePath, FilePath)
forall a.
[FilePath] -> ModuleName a -> Compile (FilePath, FilePath)
go [FilePath]
alldirs ModuleName
mname where
  go :: [FilePath] -> ModuleName a -> Compile (FilePath,String)
  go :: [FilePath] -> ModuleName a -> Compile (FilePath, FilePath)
go [FilePath]
_ (ModuleName a
_ FilePath
"Fay.Types") = (FilePath, FilePath) -> Compile (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"Fay/Types.hs", FilePath
"newtype Fay a = Fay (Identity a)\n\nnewtype Identity a = Identity a")
  go (FilePath
dir:[FilePath]
dirs) ModuleName a
name = do
    Bool
exists <- IO Bool -> Compile Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (FilePath -> IO Bool
doesFileExist FilePath
path)
    if Bool
exists
      then (FilePath
path,) (FilePath -> (FilePath, FilePath))
-> (FilePath -> FilePath) -> FilePath -> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
stdlibHack (FilePath -> (FilePath, FilePath))
-> Compile FilePath -> Compile (FilePath, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> Compile FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (FilePath -> IO FilePath
readFile FilePath
path)
      else [FilePath] -> ModuleName a -> Compile (FilePath, FilePath)
forall a.
[FilePath] -> ModuleName a -> Compile (FilePath, FilePath)
go [FilePath]
dirs ModuleName a
name
    where
      path :: FilePath
path = FilePath
dir FilePath -> FilePath -> FilePath
</> Char -> Char -> FilePath -> FilePath
forall b. Eq b => b -> b -> [b] -> [b]
replace Char
'.' Char
'/' (ModuleName a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint ModuleName a
name) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".hs"
      replace :: b -> b -> [b] -> [b]
replace b
c b
r = (b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> if b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
c then b
r else b
x)
  go [] ModuleName a
name =
    CompileError -> Compile (FilePath, FilePath)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> Compile (FilePath, FilePath))
-> CompileError -> Compile (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ ModuleName -> [FilePath] -> CompileError
Couldn'tFindImport (ModuleName a -> ModuleName
forall (f :: * -> *) a. Functor f => f a -> f ()
unAnn ModuleName a
name) [FilePath]
alldirs

  stdlibHack :: FilePath -> FilePath
stdlibHack = case ModuleName
mname of
    ModuleName ()
_ FilePath
"Fay.FFI" -> FilePath -> FilePath -> FilePath
forall a b. a -> b -> a
const FilePath
"module Fay.FFI where\n\ndata Nullable a = Nullable a | Null\n\ndata Defined a = Defined a | Undefined"
    ModuleName
_ -> FilePath -> FilePath
forall a. a -> a
id