{- -----------------------------------------------------------------------------
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]

{-# LANGUAGE TypeFamilies #-}

module Config.LocalConfig (
  Backend(..),
  LocalConfig(..),
  PendingProcess,
  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
import System.Posix.Temp (mkstemps)
import System.Posix.Types (ProcessID)

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 String
rootPath = String -> IO String
getDataFileName String
""

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

data PendingProcess =
  PendingProcess {
    PendingProcess -> String
pcContext :: String,
    PendingProcess -> ProcessID
pcProcess :: ProcessID,
    PendingProcess -> Either (IO PendingProcess) String
pcNext :: Either (IO PendingProcess) FilePath
  }

instance CompilerBackend Backend where
  type AsyncWait Backend = PendingProcess
  syncCxxCommand :: forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
Backend -> CxxCommand -> m String
syncCxxCommand Backend
b CxxCommand
compile = forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m (AsyncWait b)
asyncCxxCommand Backend
b CxxCommand
compile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}.
(ErrorContextM m, MonadIO m) =>
PendingProcess -> m String
waitAll where
    waitAll :: PendingProcess -> m String
waitAll (PendingProcess String
context ProcessID
pid Either (IO PendingProcess) String
next) = do
      forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
ProcessID -> m ()
blockProcess ProcessID
pid forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
context
      case Either (IO PendingProcess) String
next of
           Left IO PendingProcess
process -> forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO PendingProcess
process forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PendingProcess -> m String
waitAll
           Right String
path -> forall (m :: * -> *) a. Monad m => a -> m a
return String
path
  asyncCxxCommand :: forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
Backend -> CxxCommand -> m (AsyncWait Backend)
asyncCxxCommand = forall {m :: * -> *}.
(MonadIO m, ErrorContextM m) =>
Backend -> CxxCommand -> m PendingProcess
run where
    run :: Backend -> CxxCommand -> m PendingProcess
run (UnixBackend String
cb [String]
ff [String]
_ [String]
_ String
ab) (CompileToObject String
s String
p [(String, Maybe String)]
ms [String]
ps Bool
e) = do
      String
objName <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath forall a b. (a -> b) -> a -> b
$ String
p String -> String -> String
</> (String -> String
takeFileName forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
s forall a. [a] -> [a] -> [a]
++ String
".o")
      String
arName  <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath forall a b. (a -> b) -> a -> b
$ String
p String -> String -> String
</> (String -> String
takeFileName forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
s forall a. [a] -> [a] -> [a]
++ String
".a")
      let otherOptions :: [String]
otherOptions = forall a b. (a -> b) -> [a] -> [b]
map ((String
"-I" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
normalise) [String]
ps forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String, Maybe String) -> String
macro [(String, Maybe String)]
ms
      let next :: Either (IO PendingProcess) String
next = if Bool -> Bool
not Bool
e
                    then forall a b. b -> Either a b
Right String
objName
                    else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ do
                      ProcessID
pid <- String -> [String] -> IO ProcessID
executeProcess String
ab [String
"-q",String
arName,String
objName]
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PendingProcess {
                          pcContext :: String
pcContext = String
"In archiving of " forall a. [a] -> [a] -> [a]
++ String
objName,
                          pcProcess :: ProcessID
pcProcess = ProcessID
pid,
                          pcNext :: Either (IO PendingProcess) String
pcNext = forall a b. b -> Either a b
Right String
arName
                        }
      ProcessID
pid <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO ProcessID
executeProcess String
cb ([String]
ff forall a. [a] -> [a] -> [a]
++ [String]
otherOptions forall a. [a] -> [a] -> [a]
++ [String
"-c", String
s, String
"-o", String
objName])
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PendingProcess {
          pcContext :: String
pcContext = String
"In compilation of " forall a. [a] -> [a] -> [a]
++ String
s,
          pcProcess :: ProcessID
pcProcess = ProcessID
pid,
          pcNext :: Either (IO PendingProcess) String
pcNext = Either (IO PendingProcess) String
next
        }
    run (UnixBackend String
cb [String]
_ [String]
ff [String]
_ String
_) (CompileToShared [String]
ss String
o [String]
lf) = do
      let arFiles :: [String]
arFiles      = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".a")       [String]
ss
      let otherFiles :: [String]
otherFiles   = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".a") [String]
ss
      let flags :: [String]
flags = forall a. Eq a => [a] -> [a]
nub [String]
lf
      let args :: [String]
args = [String]
ff forall a. [a] -> [a] -> [a]
++ [String]
otherFiles forall a. [a] -> [a] -> [a]
++ [String]
arFiles forall a. [a] -> [a] -> [a]
++ [String
"-o", String
o] forall a. [a] -> [a] -> [a]
++ [String]
flags
      ProcessID
pid <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO ProcessID
executeProcess String
cb [String]
args
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PendingProcess {
          pcContext :: String
pcContext = String
"In linking of " forall a. [a] -> [a] -> [a]
++ String
o,
          pcProcess :: ProcessID
pcProcess = ProcessID
pid,
          pcNext :: Either (IO PendingProcess) String
pcNext = forall a b. b -> Either a b
Right String
o
        }
    run (UnixBackend String
cb [String]
_ [String]
_ [String]
ff String
_) (CompileToBinary String
m [String]
ss [(String, Maybe String)]
ms String
o [String]
ps [String]
lf) = do
      let arFiles :: [String]
arFiles      = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".a")       [String]
ss
      let otherFiles :: [String]
otherFiles   = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".a") [String]
ss
      let otherOptions :: [String]
otherOptions = forall a b. (a -> b) -> [a] -> [b]
map ((String
"-I" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
normalise) [String]
ps forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String, Maybe String) -> String
macro [(String, Maybe String)]
ms
      let flags :: [String]
flags = forall a. Eq a => [a] -> [a]
nub [String]
lf
      let args :: [String]
args = [String]
ff forall a. [a] -> [a] -> [a]
++ [String]
otherOptions forall a. [a] -> [a] -> [a]
++ String
mforall a. a -> [a] -> [a]
:[String]
otherFiles forall a. [a] -> [a] -> [a]
++ [String]
arFiles forall a. [a] -> [a] -> [a]
++ [String
"-o", String
o] forall a. [a] -> [a] -> [a]
++ [String]
flags
      ProcessID
pid <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO ProcessID
executeProcess String
cb [String]
args
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PendingProcess {
          pcContext :: String
pcContext = String
"In linking of " forall a. [a] -> [a] -> [a]
++ String
o,
          pcProcess :: ProcessID
pcProcess = ProcessID
pid,
          pcNext :: Either (IO PendingProcess) String
pcNext = forall a b. b -> Either a b
Right String
o
        }
    macro :: (String, Maybe String) -> String
macro (String
n,Just String
v)  = String
"-D" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String
v
    macro (String
n,Maybe String
Nothing) = String
"-D" forall a. [a] -> [a] -> [a]
++ String
n
  waitCxxCommand :: forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
Backend
-> AsyncWait Backend -> m (Either (AsyncWait Backend) String)
waitCxxCommand Backend
_ p :: AsyncWait Backend
p@(PendingProcess String
context ProcessID
pid Either (IO PendingProcess) String
next) = do
    Bool
status <- forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
ProcessID -> m Bool
waitProcess ProcessID
pid forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
context
    if Bool
status
       then case Either (IO PendingProcess) String
next of
                 Left IO PendingProcess
process -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO PendingProcess
process
                 Right String
result -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right String
result  -- Not the same Either.
       else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left AsyncWait Backend
p
  runTestCommand :: forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
Backend -> TestCommand -> m TestCommandResult
runTestCommand Backend
_ (TestCommand String
b String
p [String]
as) = forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ do
    (String
outF,Handle
outH) <- String -> String -> IO (String, Handle)
mkstemps String
"/tmp/ztest_" String
".txt"
    (String
errF,Handle
errH) <- String -> String -> IO (String, Handle)
mkstemps String
"/tmp/ztest_" String
".txt"
    ProcessID
pid <- IO () -> IO ProcessID
forkProcess (Handle -> Handle -> IO ()
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
    String
out <- String -> IO String
readFile String
outF
    String -> IO ()
removeFile String
outF
    String
err <- String -> IO String
readFile String
errF
    String -> IO ()
removeFile String
errF
    let success :: Bool
success = case Maybe ProcessStatus
status of
                       Just (Exited ExitCode
ExitSuccess) -> Bool
True
                       Maybe ProcessStatus
_ -> Bool
False
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> [String] -> [String] -> TestCommandResult
TestCommandResult Bool
success (String -> [String]
lines String
out) (String -> [String]
lines String
err) where
      execWithCapture :: Handle -> Handle -> IO ()
execWithCapture Handle
h1 Handle
h2 = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p) forall a b. (a -> b) -> a -> b
$ String -> IO ()
setCurrentDirectory String
p
        Handle -> Handle -> IO ()
hDuplicateTo Handle
h1 Handle
stdout
        Handle -> Handle -> IO ()
hDuplicateTo Handle
h2 Handle
stderr
        forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
b Bool
True [String]
as forall a. Maybe a
Nothing
  getCompilerHash :: forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
Backend -> m VersionHash
getCompilerHash Backend
b = do
    let minorVersion :: String
minorVersion = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
version
    String
serialized <- forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m String
autoWriteConfig Backend
b
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> VersionHash
VersionHash forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Integral a, Show a) => a -> String -> String
showHex String
"" forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> Int
hash forall a b. (a -> b) -> a -> b
$ String
minorVersion forall a. [a] -> [a] -> [a]
++ String
serialized

executeProcess :: String -> [String] -> IO ProcessID
executeProcess :: String -> [String] -> IO ProcessID
executeProcess String
c [String]
os = do
  Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Executing: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
" " (String
cforall a. a -> [a] -> [a]
:[String]
os)
  IO () -> IO ProcessID
forkProcess forall a b. (a -> b) -> a -> b
$ forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
c Bool
True [String]
os forall a. Maybe a
Nothing

waitProcess :: (MonadIO m, ErrorContextM m) => ProcessID -> m Bool
waitProcess :: forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
ProcessID -> m Bool
waitProcess ProcessID
pid = do
  Maybe ProcessStatus
status <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
False Bool
True ProcessID
pid
  case Maybe ProcessStatus
status of
       Maybe ProcessStatus
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
       Just (Exited ExitCode
ExitSuccess) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       Maybe ProcessStatus
_ -> do
         forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Command execution failed"
         forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Command execution failed"

blockProcess :: (MonadIO m, ErrorContextM m) => ProcessID -> m ()
blockProcess :: forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
ProcessID -> m ()
blockProcess ProcessID
pid = do
  Maybe ProcessStatus
status <- forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO 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) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Maybe ProcessStatus
_ -> do
         forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Command execution failed"
         forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Command execution failed"

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

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

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

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