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

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

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

instance CompilerBackend Backend where
  type AsyncWait Backend = PendingProcess
  syncCxxCommand :: Backend -> CxxCommand -> m FilePath
syncCxxCommand Backend
b CxxCommand
compile = Backend -> CxxCommand -> m (AsyncWait Backend)
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m (AsyncWait b)
asyncCxxCommand Backend
b CxxCommand
compile m PendingProcess -> (PendingProcess -> m FilePath) -> m FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PendingProcess -> m FilePath
forall (m :: * -> *).
(ErrorContextM m, MonadIO m) =>
PendingProcess -> m FilePath
waitAll where
    waitAll :: PendingProcess -> m FilePath
waitAll (PendingProcess FilePath
context ProcessID
pid Either (IO PendingProcess) FilePath
next) = do
      ProcessID -> m ()
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
ProcessID -> m ()
blockProcess ProcessID
pid m () -> FilePath -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
context
      case Either (IO PendingProcess) FilePath
next of
           Left IO PendingProcess
process -> IO PendingProcess -> m PendingProcess
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO PendingProcess
process m PendingProcess -> (PendingProcess -> m FilePath) -> m FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PendingProcess -> m FilePath
waitAll
           Right FilePath
path -> FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
  asyncCxxCommand :: Backend -> CxxCommand -> m (AsyncWait Backend)
asyncCxxCommand = Backend -> CxxCommand -> m (AsyncWait Backend)
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
Backend -> CxxCommand -> m PendingProcess
run where
    run :: Backend -> CxxCommand -> m PendingProcess
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")
      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")
      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 next :: Either (IO PendingProcess) FilePath
next = if Bool -> Bool
not Bool
e
                    then FilePath -> Either (IO PendingProcess) FilePath
forall a b. b -> Either a b
Right FilePath
objName
                    else IO PendingProcess -> Either (IO PendingProcess) FilePath
forall a b. a -> Either a b
Left (IO PendingProcess -> Either (IO PendingProcess) FilePath)
-> IO PendingProcess -> Either (IO PendingProcess) FilePath
forall a b. (a -> b) -> a -> b
$ do
                      ProcessID
pid <- FilePath -> [FilePath] -> IO ProcessID
executeProcess FilePath
ab [FilePath
"-q",FilePath
arName,FilePath
objName]
                      PendingProcess -> IO PendingProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (PendingProcess -> IO PendingProcess)
-> PendingProcess -> IO PendingProcess
forall a b. (a -> b) -> a -> b
$ PendingProcess :: FilePath
-> ProcessID
-> Either (IO PendingProcess) FilePath
-> PendingProcess
PendingProcess {
                          pcContext :: FilePath
pcContext = FilePath
"In archiving of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objName,
                          pcProcess :: ProcessID
pcProcess = ProcessID
pid,
                          pcNext :: Either (IO PendingProcess) FilePath
pcNext = FilePath -> Either (IO PendingProcess) FilePath
forall a b. b -> Either a b
Right FilePath
arName
                        }
      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
$ FilePath -> [FilePath] -> IO ProcessID
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])
      PendingProcess -> m PendingProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (PendingProcess -> m PendingProcess)
-> PendingProcess -> m PendingProcess
forall a b. (a -> b) -> a -> b
$ PendingProcess :: FilePath
-> ProcessID
-> Either (IO PendingProcess) FilePath
-> PendingProcess
PendingProcess {
          pcContext :: FilePath
pcContext = FilePath
"In compilation of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s,
          pcProcess :: ProcessID
pcProcess = ProcessID
pid,
          pcNext :: Either (IO PendingProcess) FilePath
pcNext = Either (IO PendingProcess) FilePath
next
        }
    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
      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
$ FilePath -> [FilePath] -> IO ProcessID
executeProcess FilePath
cb [FilePath]
args
      PendingProcess -> m PendingProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (PendingProcess -> m PendingProcess)
-> PendingProcess -> m PendingProcess
forall a b. (a -> b) -> a -> b
$ PendingProcess :: FilePath
-> ProcessID
-> Either (IO PendingProcess) FilePath
-> PendingProcess
PendingProcess {
          pcContext :: FilePath
pcContext = FilePath
"In linking of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
o,
          pcProcess :: ProcessID
pcProcess = ProcessID
pid,
          pcNext :: Either (IO PendingProcess) FilePath
pcNext = FilePath -> Either (IO PendingProcess) FilePath
forall a b. b -> Either a b
Right 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
      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
$ FilePath -> [FilePath] -> IO ProcessID
executeProcess FilePath
cb [FilePath]
args
      PendingProcess -> m PendingProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (PendingProcess -> m PendingProcess)
-> PendingProcess -> m PendingProcess
forall a b. (a -> b) -> a -> b
$ PendingProcess :: FilePath
-> ProcessID
-> Either (IO PendingProcess) FilePath
-> PendingProcess
PendingProcess {
          pcContext :: FilePath
pcContext = FilePath
"In linking of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
o,
          pcProcess :: ProcessID
pcProcess = ProcessID
pid,
          pcNext :: Either (IO PendingProcess) FilePath
pcNext = FilePath -> Either (IO PendingProcess) FilePath
forall a b. b -> Either a b
Right 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
  waitCxxCommand :: Backend
-> AsyncWait Backend -> m (Either (AsyncWait Backend) FilePath)
waitCxxCommand Backend
_ p :: AsyncWait Backend
p@(PendingProcess context pid next) = do
    Bool
status <- ProcessID -> m Bool
forall (m :: * -> *).
(MonadIO m, ErrorContextM m) =>
ProcessID -> m Bool
waitProcess ProcessID
pid m Bool -> FilePath -> m Bool
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
context
    if Bool
status
       then case Either (IO PendingProcess) FilePath
next of
                 Left IO PendingProcess
process -> (PendingProcess -> Either PendingProcess FilePath)
-> m PendingProcess -> m (Either PendingProcess FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PendingProcess -> Either PendingProcess FilePath
forall a b. a -> Either a b
Left (m PendingProcess -> m (Either PendingProcess FilePath))
-> m PendingProcess -> m (Either PendingProcess FilePath)
forall a b. (a -> b) -> a -> b
$ IO PendingProcess -> m PendingProcess
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO IO PendingProcess
process
                 Right FilePath
result -> Either PendingProcess FilePath
-> m (Either PendingProcess FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PendingProcess FilePath
 -> m (Either PendingProcess FilePath))
-> Either PendingProcess FilePath
-> m (Either PendingProcess FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either PendingProcess FilePath
forall a b. b -> Either a b
Right FilePath
result  -- Not the same Either.
       else Either PendingProcess FilePath
-> m (Either PendingProcess FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PendingProcess FilePath
 -> m (Either PendingProcess FilePath))
-> Either PendingProcess FilePath
-> m (Either PendingProcess FilePath)
forall a b. (a -> b) -> a -> b
$ PendingProcess -> Either PendingProcess FilePath
forall a b. a -> Either a b
Left AsyncWait Backend
PendingProcess
p
  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 ()
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 ()
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 ()
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 :: String -> [String] -> IO ProcessID
executeProcess :: FilePath -> [FilePath] -> IO ProcessID
executeProcess FilePath
c [FilePath]
os = do
  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)
  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

waitProcess :: (MonadIO m, ErrorContextM m) => ProcessID -> m Bool
waitProcess :: ProcessID -> m Bool
waitProcess ProcessID
pid = do
  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
False Bool
True ProcessID
pid
  case Maybe ProcessStatus
status of
       Maybe ProcessStatus
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
       Just (Exited ExitCode
ExitSuccess) -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       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
"Command execution failed"
         FilePath -> m Bool
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> m Bool) -> FilePath -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"Command execution failed"

blockProcess :: (MonadIO m, ErrorContextM m) => ProcessID -> m ()
blockProcess :: ProcessID -> m ()
blockProcess ProcessID
pid = do
  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
"Command execution failed"
         FilePath -> m ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Command execution 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