{- -----------------------------------------------------------------------------
Copyright 2020-2021 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

module Config.LocalConfig (
  Backend(..),
  LocalConfig(..),
  Resolver(..),
  rootPath,
  compilerVersion,
) where

import Control.Monad (when)
import Control.Monad.IO.Class
import Data.Hashable (hash)
import Data.List (intercalate,isPrefixOf,isSuffixOf,nub)
import Data.Maybe (isJust)
import Data.Version (showVersion,versionBranch)
import GHC.IO.Handle
import Numeric (showHex)
import System.Directory
import System.Exit
import System.FilePath
import System.IO
import System.Posix.Process (ProcessStatus(..),executeFile,forkProcess,getProcessStatus)
import System.Posix.Temp (mkstemps)

import Base.CompilerError
import Cli.Programs
import Config.CompilerConfig
import Config.ParseConfig ()
import Module.ParseMetadata
import Module.Paths

import Paths_zeolite_lang (getDataFileName,version)


rootPath :: IO FilePath
rootPath :: IO FilePath
rootPath = FilePath -> IO FilePath
getDataFileName FilePath
""

compilerVersion :: String
compilerVersion :: FilePath
compilerVersion = Version -> FilePath
showVersion Version
version

instance CompilerBackend Backend where
  runCxxCommand :: Backend -> CxxCommand -> m FilePath
runCxxCommand = Backend -> CxxCommand -> m FilePath
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
Backend -> CxxCommand -> m FilePath
run where
    run :: Backend -> CxxCommand -> m FilePath
run (UnixBackend FilePath
cb [FilePath]
ff [FilePath]
_ [FilePath]
_ FilePath
ab) (CompileToObject FilePath
s FilePath
p [(FilePath, Maybe FilePath)]
ms [FilePath]
ps Bool
e) = do
      FilePath
objName <- IO FilePath -> m FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
p FilePath -> FilePath -> FilePath
</> (FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropExtension FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".o")
      let otherOptions :: [FilePath]
otherOptions = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
normalise) [FilePath]
ps [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ((FilePath, Maybe FilePath) -> FilePath)
-> [(FilePath, Maybe FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Maybe FilePath) -> FilePath
macro [(FilePath, Maybe FilePath)]
ms
      FilePath -> [FilePath] -> m ()
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
FilePath -> [FilePath] -> m ()
executeProcess FilePath
cb ([FilePath]
ff [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
otherOptions [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-c", FilePath
s, FilePath
"-o", FilePath
objName]) m () -> FilePath -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"In compilation of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
      if Bool
e
         then do
           -- Extra files are put into .a since they will be unconditionally
           -- included. This prevents unwanted symbol dependencies.
           FilePath
arName  <- IO FilePath -> m FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
p FilePath -> FilePath -> FilePath
</> (FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropExtension FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".a")
           FilePath -> [FilePath] -> m ()
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
FilePath -> [FilePath] -> m ()
executeProcess FilePath
ab [FilePath
"-q",FilePath
arName,FilePath
objName] m () -> FilePath -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"In packaging of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objName
           FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
arName
         else FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
objName
    run (UnixBackend FilePath
cb [FilePath]
_ [FilePath]
ff [FilePath]
_ FilePath
_) (CompileToShared [FilePath]
ss FilePath
o [FilePath]
lf) = do
      let arFiles :: [FilePath]
arFiles      = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".a")       [FilePath]
ss
      let otherFiles :: [FilePath]
otherFiles   = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".a") [FilePath]
ss
      let flags :: [FilePath]
flags = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
lf
      let args :: [FilePath]
args = [FilePath]
ff [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
otherFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
arFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-o", FilePath
o] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
flags
      FilePath -> [FilePath] -> m ()
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
FilePath -> [FilePath] -> m ()
executeProcess FilePath
cb [FilePath]
args m () -> FilePath -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"In linking of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
o
      FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
o
    run (UnixBackend FilePath
cb [FilePath]
_ [FilePath]
_ [FilePath]
ff FilePath
_) (CompileToBinary FilePath
m [FilePath]
ss [(FilePath, Maybe FilePath)]
ms FilePath
o [FilePath]
ps [FilePath]
lf) = do
      let arFiles :: [FilePath]
arFiles      = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".a")       [FilePath]
ss
      let otherFiles :: [FilePath]
otherFiles   = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".a") [FilePath]
ss
      let otherOptions :: [FilePath]
otherOptions = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
normalise) [FilePath]
ps [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ((FilePath, Maybe FilePath) -> FilePath)
-> [(FilePath, Maybe FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Maybe FilePath) -> FilePath
macro [(FilePath, Maybe FilePath)]
ms
      let flags :: [FilePath]
flags = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
lf
      let args :: [FilePath]
args = [FilePath]
ff [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
otherOptions [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath
mFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
otherFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
arFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-o", FilePath
o] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
flags
      FilePath -> [FilePath] -> m ()
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
FilePath -> [FilePath] -> m ()
executeProcess FilePath
cb [FilePath]
args m () -> FilePath -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"In linking of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
o
      FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
o
    macro :: (FilePath, Maybe FilePath) -> FilePath
macro (FilePath
n,Just FilePath
v)  = FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
v
    macro (FilePath
n,Maybe FilePath
Nothing) = FilePath
"-D" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n
  runTestCommand :: Backend -> TestCommand -> m TestCommandResult
runTestCommand Backend
_ (TestCommand FilePath
b FilePath
p [FilePath]
as) = IO TestCommandResult -> m TestCommandResult
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO TestCommandResult -> m TestCommandResult)
-> IO TestCommandResult -> m TestCommandResult
forall a b. (a -> b) -> a -> b
$ do
    (FilePath
outF,Handle
outH) <- FilePath -> FilePath -> IO (FilePath, Handle)
mkstemps FilePath
"/tmp/ztest_" FilePath
".txt"
    (FilePath
errF,Handle
errH) <- FilePath -> FilePath -> IO (FilePath, Handle)
mkstemps FilePath
"/tmp/ztest_" FilePath
".txt"
    ProcessID
pid <- IO () -> IO ProcessID
forkProcess (Handle -> Handle -> IO ()
forall b. Handle -> Handle -> IO b
execWithCapture Handle
outH Handle
errH)
    Handle -> IO ()
hClose Handle
outH
    Handle -> IO ()
hClose Handle
errH
    Maybe ProcessStatus
status <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
True ProcessID
pid
    FilePath
out <- FilePath -> IO FilePath
readFile FilePath
outF
    FilePath -> IO ()
removeFile FilePath
outF
    FilePath
err <- FilePath -> IO FilePath
readFile FilePath
errF
    FilePath -> IO ()
removeFile FilePath
errF
    let success :: Bool
success = case Maybe ProcessStatus
status of
                       Just (Exited ExitCode
ExitSuccess) -> Bool
True
                       Maybe ProcessStatus
_ -> Bool
False
    TestCommandResult -> IO TestCommandResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TestCommandResult -> IO TestCommandResult)
-> TestCommandResult -> IO TestCommandResult
forall a b. (a -> b) -> a -> b
$ Bool -> [FilePath] -> [FilePath] -> TestCommandResult
TestCommandResult Bool
success (FilePath -> [FilePath]
lines FilePath
out) (FilePath -> [FilePath]
lines FilePath
err) where
      execWithCapture :: Handle -> Handle -> IO b
execWithCapture Handle
h1 Handle
h2 = do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
p) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
setCurrentDirectory FilePath
p
        Handle -> Handle -> IO ()
hDuplicateTo Handle
h1 Handle
stdout
        Handle -> Handle -> IO ()
hDuplicateTo Handle
h2 Handle
stderr
        FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO b
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
b Bool
True [FilePath]
as Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
  getCompilerHash :: Backend -> m VersionHash
getCompilerHash Backend
b = do
    let minorVersion :: FilePath
minorVersion = [Int] -> FilePath
forall a. Show a => a -> FilePath
show ([Int] -> FilePath) -> [Int] -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
3 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
version
    FilePath
serialized <- Backend -> m FilePath
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m FilePath
autoWriteConfig Backend
b
    VersionHash -> m VersionHash
forall (m :: * -> *) a. Monad m => a -> m a
return (VersionHash -> m VersionHash) -> VersionHash -> m VersionHash
forall a b. (a -> b) -> a -> b
$ FilePath -> VersionHash
VersionHash (FilePath -> VersionHash) -> FilePath -> VersionHash
forall a b. (a -> b) -> a -> b
$ (Int -> FilePath -> FilePath) -> FilePath -> Int -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> FilePath -> FilePath
forall a. (Integral a, Show a) => a -> FilePath -> FilePath
showHex FilePath
"" (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ FilePath -> Int
forall a. Hashable a => a -> Int
hash (FilePath -> Int) -> FilePath -> Int
forall a b. (a -> b) -> a -> b
$ FilePath
minorVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
serialized

executeProcess :: (MonadIO m, ErrorContextM m) => String -> [String] -> m ()
executeProcess :: FilePath -> [FilePath] -> m ()
executeProcess FilePath
c [FilePath]
os = do
  IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Executing: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " (FilePath
cFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
os)
  ProcessID
pid    <- IO ProcessID -> m ProcessID
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO ProcessID -> m ProcessID) -> IO ProcessID -> m ProcessID
forall a b. (a -> b) -> a -> b
$ IO () -> IO ProcessID
forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO ()
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
c Bool
True [FilePath]
os Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
  Maybe ProcessStatus
status <- IO (Maybe ProcessStatus) -> m (Maybe ProcessStatus)
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO (Maybe ProcessStatus) -> m (Maybe ProcessStatus))
-> IO (Maybe ProcessStatus) -> m (Maybe ProcessStatus)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
True ProcessID
pid
  case Maybe ProcessStatus
status of
       Just (Exited ExitCode
ExitSuccess) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Maybe ProcessStatus
_ -> do
         IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Execution of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
c FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" failed"
         FilePath -> m ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Execution of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
c FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" failed"

instance PathIOHandler Resolver where
  resolveModule :: Resolver -> FilePath -> FilePath -> m FilePath
resolveModule Resolver
r FilePath
p FilePath
m = do
    [FilePath]
ps2 <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ Resolver -> FilePath -> IO [FilePath]
potentialSystemPaths Resolver
r FilePath
m
    FilePath -> [FilePath] -> m FilePath
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
FilePath -> [FilePath] -> m FilePath
firstExisting FilePath
m ([FilePath] -> m FilePath) -> [FilePath] -> m FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath
pFilePath -> FilePath -> FilePath
</>FilePath
m] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
ps2
  isSystemModule :: Resolver -> FilePath -> FilePath -> m Bool
isSystemModule Resolver
r FilePath
p FilePath
m = do
    Bool
isDir <- IO Bool -> m Bool
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
pFilePath -> FilePath -> FilePath
</>FilePath
m)
    if Bool
isDir
       then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
       else do
         [FilePath]
ps2 <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ Resolver -> FilePath -> IO [FilePath]
potentialSystemPaths Resolver
r FilePath
m
         Maybe FilePath
path <- IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO ([FilePath] -> IO (Maybe FilePath)
findModule [FilePath]
ps2)
         Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
path
  resolveBaseModule :: Resolver -> m FilePath
resolveBaseModule Resolver
_ = do
    let m :: FilePath
m = FilePath
"base"
    FilePath
m0 <- IO FilePath -> m FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getDataFileName FilePath
m
    FilePath -> [FilePath] -> m FilePath
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
FilePath -> [FilePath] -> m FilePath
firstExisting FilePath
m [FilePath
m0]
  isBaseModule :: Resolver -> FilePath -> m Bool
isBaseModule Resolver
r FilePath
f = do
    FilePath
b <- Resolver -> m FilePath
forall r (m :: * -> *).
(PathIOHandler r, MonadIO m, CollectErrorsM m) =>
r -> m FilePath
resolveBaseModule Resolver
r
    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b)
  zipWithContents :: Resolver -> FilePath -> [FilePath] -> m [(FilePath, FilePath)]
zipWithContents Resolver
_ FilePath
p [FilePath]
fs = ([FilePath] -> [(FilePath, FilePath)])
-> m [FilePath] -> m [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([FilePath] -> [FilePath] -> [(FilePath, FilePath)])
-> [FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
fixPath [FilePath]
fs) (m [FilePath] -> m [(FilePath, FilePath)])
-> m [FilePath] -> m [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> m FilePath) -> [FilePath] -> m [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IO FilePath -> m FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> m FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
readFile (FilePath -> IO FilePath)
-> (FilePath -> FilePath) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
p FilePath -> FilePath -> FilePath
</>)) [FilePath]
fs

potentialSystemPaths :: Resolver -> FilePath -> IO [FilePath]
potentialSystemPaths :: Resolver -> FilePath -> IO [FilePath]
potentialSystemPaths (SimpleResolver [FilePath]
ls [FilePath]
ps) FilePath
m = do
  let allowGlobal :: Bool
allowGlobal = Bool -> Bool
not (FilePath
".." FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
components)
  [FilePath]
m0 <- if Bool
allowGlobal Bool -> Bool -> Bool
&& (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\FilePath
l -> FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (FilePath
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/") FilePath
m) [FilePath]
ls
           then FilePath -> IO FilePath
getDataFileName FilePath
m IO FilePath -> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[])
           else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  let m2 :: [FilePath]
m2 = if Bool
allowGlobal
              then (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
</> FilePath
m) [FilePath]
ps
              else []
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
m0 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
m2 where
    components :: [FilePath]
components = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
stripSlash ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitPath FilePath
m
    stripSlash :: FilePath -> FilePath
stripSlash = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse

firstExisting :: (MonadIO m, ErrorContextM m) => FilePath -> [FilePath] -> m FilePath
firstExisting :: FilePath -> [FilePath] -> m FilePath
firstExisting FilePath
m [FilePath]
ps = do
  Maybe FilePath
p <- IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO (Maybe FilePath) -> m (Maybe FilePath))
-> IO (Maybe FilePath) -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO (Maybe FilePath)
findModule [FilePath]
ps
  case Maybe FilePath
p of
       Maybe FilePath
Nothing -> FilePath -> m FilePath
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not find path " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
m
       Just FilePath
p2 -> FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
p2

findModule :: [FilePath] -> IO (Maybe FilePath)
findModule :: [FilePath] -> IO (Maybe FilePath)
findModule [] = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
findModule (FilePath
p:[FilePath]
ps) = do
  Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
p
  if Bool
isDir
     then (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (IO FilePath -> IO (Maybe FilePath))
-> IO FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
p
     else [FilePath] -> IO (Maybe FilePath)
findModule [FilePath]
ps