mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 16:56:29 +03:00
Fix color output when run through gren-in-gren. Also add option to override haskell binary called from wrapper.
This commit is contained in:
Robin Heggelund Hansen
parent
50585fa0da
commit
8170550967
@ -18,12 +18,14 @@ where
|
||||
import GHC.IO.Handle (hIsTerminalDevice)
|
||||
import Json.Encode ((==>))
|
||||
import Json.Encode qualified as E
|
||||
import Data.Maybe qualified as Maybe
|
||||
import Reporting.Doc ((<+>))
|
||||
import Reporting.Doc qualified as D
|
||||
import Reporting.Error qualified as Error
|
||||
import Reporting.Error.Syntax qualified as Error.Syntax
|
||||
import Reporting.Render.Code qualified as Code
|
||||
import Reporting.Report qualified as Report
|
||||
import System.Environment qualified
|
||||
import System.IO (Handle, hPutStr, stderr, stdout)
|
||||
|
||||
-- REPORT
|
||||
@ -116,6 +118,8 @@ toHandle :: Handle -> D.Doc -> IO ()
|
||||
toHandle handle doc =
|
||||
do
|
||||
isTerminal <- hIsTerminalDevice handle
|
||||
if isTerminal
|
||||
forceColorEnv <- System.Environment.lookupEnv "FORCE_COLOR"
|
||||
let forceColor = Maybe.isJust forceColorEnv
|
||||
if isTerminal || forceColor
|
||||
then D.toAnsi handle doc
|
||||
else hPutStr handle (toString doc)
|
||||
|
||||
@ -10,6 +10,7 @@ import FileSystem
|
||||
import FileSystem.Path as Path exposing (Path)
|
||||
import HttpClient
|
||||
import Bytes exposing (Bytes)
|
||||
import Terminal
|
||||
|
||||
|
||||
main : Node.Program Model Msg
|
||||
@ -25,11 +26,13 @@ type alias Model =
|
||||
{ args : Array String
|
||||
, stdout : Stream
|
||||
, stderr : Stream
|
||||
, useColor : Bool
|
||||
, fsPermission : FileSystem.Permission
|
||||
, cpPermission : ChildProcess.Permission
|
||||
, httpPermission : HttpClient.Permission
|
||||
, remotePath : String
|
||||
, remotePath : Maybe String
|
||||
, localPath : Path
|
||||
, pathToString : Path -> String
|
||||
}
|
||||
|
||||
|
||||
@ -43,19 +46,49 @@ init env =
|
||||
Init.await FileSystem.initialize <| \fsPermission ->
|
||||
Init.await ChildProcess.initialize <| \cpPermission ->
|
||||
Init.await HttpClient.initialize <| \httpPermission ->
|
||||
Init.await Terminal.initialize <| \terminalConfig ->
|
||||
Init.awaitTask Node.getEnvironmentVariables <| \envVars ->
|
||||
Init.awaitTask (FileSystem.homeDirectory fsPermission) <| \homeDir ->
|
||||
let
|
||||
userArgs =
|
||||
Array.dropFirst 2 env.args
|
||||
|
||||
useColor =
|
||||
case terminalConfig of
|
||||
Nothing ->
|
||||
False
|
||||
|
||||
Just _ ->
|
||||
case Dict.get "NO_COLOR" envVars of
|
||||
Just _ ->
|
||||
False
|
||||
|
||||
Nothing ->
|
||||
True
|
||||
|
||||
maybePaths =
|
||||
case { platform = env.platform, arch = env.cpuArchitecture } of
|
||||
case { platform = env.platform, arch = env.cpuArchitecture, override = Dict.get "GREN_BIN" envVars } of
|
||||
{ override = Just overridePath, platform = Node.Win32 } ->
|
||||
Just <|
|
||||
{ args = userArgs
|
||||
, stdout = env.stdout
|
||||
, remotePath = Nothing
|
||||
, localPath = Path.fromWin32String overridePath
|
||||
}
|
||||
|
||||
{ override = Just overridePath } ->
|
||||
Just <|
|
||||
{ args = userArgs
|
||||
, stdout = env.stdout
|
||||
, remotePath = Nothing
|
||||
, localPath = Path.fromPosixString overridePath
|
||||
}
|
||||
|
||||
{ platform = Node.Win32, arch = Node.X64 } ->
|
||||
Just <|
|
||||
{ args = userArgs
|
||||
, stdout = env.stdout
|
||||
, remotePath = makeRemotePath "gren.exe"
|
||||
, remotePath = Just <| makeRemotePath "gren.exe"
|
||||
, localPath = makeLocalPath env.platform homeDir envVars
|
||||
}
|
||||
|
||||
@ -63,7 +96,7 @@ init env =
|
||||
Just <|
|
||||
{ args = userArgs
|
||||
, stdout = env.stdout
|
||||
, remotePath = makeRemotePath "gren_mac"
|
||||
, remotePath = Just <| makeRemotePath "gren_mac"
|
||||
, localPath = makeLocalPath env.platform homeDir envVars
|
||||
}
|
||||
|
||||
@ -71,7 +104,7 @@ init env =
|
||||
Just <|
|
||||
{ args = userArgs
|
||||
, stdout = env.stdout
|
||||
, remotePath = makeRemotePath "gren_linux"
|
||||
, remotePath = Just <| makeRemotePath "gren_linux"
|
||||
, localPath = makeLocalPath env.platform homeDir envVars
|
||||
}
|
||||
|
||||
@ -84,11 +117,17 @@ init env =
|
||||
{ args = userArgs
|
||||
, stdout = env.stdout
|
||||
, stderr = env.stderr
|
||||
, useColor = useColor
|
||||
, fsPermission = fsPermission
|
||||
, cpPermission = cpPermission
|
||||
, httpPermission = httpPermission
|
||||
, remotePath = paths.remotePath
|
||||
, localPath = paths.localPath
|
||||
, pathToString =
|
||||
if env.platform == Node.Win32 then
|
||||
Path.toWin32String
|
||||
else
|
||||
Path.toPosixString
|
||||
}
|
||||
|
||||
Nothing ->
|
||||
@ -96,11 +135,13 @@ init env =
|
||||
{ args = []
|
||||
, stdout = env.stdout
|
||||
, stderr = env.stderr
|
||||
, useColor = useColor
|
||||
, fsPermission = fsPermission
|
||||
, cpPermission = cpPermission
|
||||
, httpPermission = httpPermission
|
||||
, remotePath = ""
|
||||
, remotePath = Nothing
|
||||
, localPath = Path.empty
|
||||
, pathToString = Path.toPosixString
|
||||
}
|
||||
in
|
||||
Node.startProgram
|
||||
@ -185,15 +226,21 @@ update msg model =
|
||||
ExistanceChecked (Err _) ->
|
||||
{ model = model
|
||||
, command =
|
||||
Stream.sendLine model.stdout ("Compiler not found at " ++ Path.toPosixString model.localPath ++ ". Downloading...")
|
||||
|> Task.andThen (\{} -> downloadBinary model.httpPermission model.remotePath)
|
||||
|> Task.attempt CompilerDownloaded
|
||||
case model.remotePath of
|
||||
Just remotePath ->
|
||||
Stream.sendLine model.stdout ("Compiler not found at " ++ model.pathToString model.localPath ++ ". Downloading...")
|
||||
|> Task.andThen (\{} -> downloadBinary model.httpPermission remotePath)
|
||||
|> Task.attempt CompilerDownloaded
|
||||
|
||||
Nothing ->
|
||||
Stream.sendLine model.stderr ("Compiler not found at " ++ model.pathToString model.localPath)
|
||||
|> Task.execute
|
||||
}
|
||||
|
||||
ExistanceChecked (Ok _) ->
|
||||
{ model = model
|
||||
, command =
|
||||
ChildProcess.runWithDefaultOptions model.cpPermission (Path.toPosixString model.localPath) model.args
|
||||
runCompiler model
|
||||
|> Task.attempt CompilerExecuted
|
||||
}
|
||||
|
||||
@ -261,7 +308,7 @@ update msg model =
|
||||
CompilerInstalled (Ok {}) ->
|
||||
{ model = model
|
||||
, command =
|
||||
ChildProcess.runWithDefaultOptions model.cpPermission (Path.toPosixString model.localPath) model.args
|
||||
runCompiler model
|
||||
|> Task.attempt CompilerExecuted
|
||||
}
|
||||
|
||||
@ -287,3 +334,20 @@ downloadBinary permission url =
|
||||
HttpClient.get url
|
||||
|> HttpClient.expectBytes
|
||||
|> HttpClient.send permission
|
||||
|
||||
|
||||
runCompiler : Model -> Task ChildProcess.FailedRun ChildProcess.SuccessfulRun
|
||||
runCompiler model =
|
||||
let
|
||||
colorEnvVar =
|
||||
if model.useColor then
|
||||
Dict.singleton "FORCE_COLOR" "1"
|
||||
else
|
||||
Dict.singleton "NO_COLOR" "1"
|
||||
in
|
||||
ChildProcess.run model.cpPermission (model.pathToString model.localPath) model.args <|
|
||||
{ ChildProcess.defaultRunOptions
|
||||
| maximumBytesWrittenToStreams = 1024 * 1024 -- 1Mb
|
||||
, environmentVariables =
|
||||
ChildProcess.MergeWithEnvironmentVariables colorEnvVar
|
||||
}
|
||||
|
||||
@ -23,6 +23,7 @@ import System.Environment qualified as Env
|
||||
import System.Exit qualified as Exit
|
||||
import System.FilePath qualified as FP
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import System.Environment qualified
|
||||
import Terminal.Internal
|
||||
import Text.PrettyPrint.ANSI.Leijen qualified as P
|
||||
|
||||
@ -62,7 +63,9 @@ exitWith :: Exit.ExitCode -> [P.Doc] -> IO a
|
||||
exitWith code docs =
|
||||
do
|
||||
isTerminal <- hIsTerminalDevice stderr
|
||||
let adjust = if isTerminal then id else P.plain
|
||||
forceColorEnv <- System.Environment.lookupEnv "FORCE_COLOR"
|
||||
let forceColor = Maybe.isJust forceColorEnv
|
||||
let adjust = if isTerminal || forceColor then id else P.plain
|
||||
D.toAnsi stderr $
|
||||
adjust $
|
||||
P.vcat $
|
||||
|
||||
Loading…
Reference in New Issue
Block a user