{-# LANGUAGE RecordWildCards, CPP #-}
module HIE.Bios.Environment (initSession, getRuntimeGhcLibDir, getRuntimeGhcVersion, makeDynFlagsAbsolute, makeTargetsAbsolute, getCacheDir, addCmdOpts) where

import GHC (GhcMonad)
import qualified GHC as G

import Control.Applicative
import Control.Monad (void)
import Control.Monad.IO.Class

import System.Directory
import System.FilePath
import System.Environment (lookupEnv)

import qualified Crypto.Hash.SHA1 as H
import Colog.Core (LogAction, WithSeverity)
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Base16
import Data.List
import Data.Char (isSpace)
import Text.ParserCombinators.ReadP hiding (optional)

import HIE.Bios.Types
import qualified HIE.Bios.Ghc.Gap as Gap

-- | Start a GHC session and set some sensible options for tooling to use.
-- Creates a folder in the cache directory to cache interface files to make
-- reloading faster.
initSession :: (GhcMonad m)
    => ComponentOptions
    -> m [G.Target]
initSession :: forall (m :: * -> *). GhcMonad m => ComponentOptions -> m [Target]
initSession  ComponentOptions {String
[String]
componentOptions :: [String]
componentRoot :: String
componentDependencies :: [String]
componentOptions :: ComponentOptions -> [String]
componentRoot :: ComponentOptions -> String
componentDependencies :: ComponentOptions -> [String]
..} = do
    DynFlags
df <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
G.getSessionDynFlags
    -- Create a unique folder per set of different GHC options, assuming that each different set of
    -- GHC options will create incompatible interface files.
    let opts_hash :: String
opts_hash = ByteString -> String
B.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString
H.finalize (Ctx -> ByteString) -> Ctx -> ByteString
forall a b. (a -> b) -> a -> b
$ Ctx -> [ByteString] -> Ctx
H.updates Ctx
H.init ((String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
B.pack [String]
componentOptions)
    String
cache_dir <- IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getCacheDir String
opts_hash
    -- Add the user specified options to a fresh GHC session.
    (DynFlags
df', [Target]
targets) <- [String] -> DynFlags -> m (DynFlags, [Target])
forall (m :: * -> *).
GhcMonad m =>
[String] -> DynFlags -> m (DynFlags, [Target])
addCmdOpts [String]
componentOptions DynFlags
df
    let df'' :: DynFlags
df'' = String -> DynFlags -> DynFlags
makeDynFlagsAbsolute String
componentRoot DynFlags
df'
    m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> m ()
forall (m :: * -> *).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
G.setSessionDynFlags
        (DynFlags -> DynFlags
disableOptimisation -- Compile with -O0 as we are not going to produce object files.
        (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags -> DynFlags
setIgnoreInterfacePragmas            -- Ignore any non-essential information in interface files such as unfoldings changing.
        (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ Maybe String -> DynFlags -> DynFlags
writeInterfaceFiles (String -> Maybe String
forall a. a -> Maybe a
Just String
cache_dir) -- Write interface files to the cache
        (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ Int -> DynFlags -> DynFlags
setVerbosity Int
0                       -- Set verbosity to zero just in case the user specified `-vx` in the options.
        (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags -> DynFlags
Gap.setWayDynamicIfHostIsDynamic     -- Add dynamic way if GHC is built with dynamic linking
        (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags -> DynFlags
setLinkerOptions DynFlags
df''                -- Set `-fno-code` to avoid generating object files, unless we have to.
        )

    let targets' :: [Target]
targets' = String -> [Target] -> [Target]
makeTargetsAbsolute String
componentRoot [Target]
targets
    -- Unset the default log action to avoid output going to stdout.
    m ()
forall (m :: * -> *). GhcMonad m => m ()
Gap.unsetLogAction
    [Target] -> m [Target]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Target]
targets'

----------------------------------------------------------------

makeTargetsAbsolute :: FilePath -> [G.Target] -> [G.Target]
makeTargetsAbsolute :: String -> [Target] -> [Target]
makeTargetsAbsolute String
wdir = (Target -> Target) -> [Target] -> [Target]
forall a b. (a -> b) -> [a] -> [b]
map (\Target
target -> Target
target {targetId :: TargetId
G.targetId = String -> TargetId -> TargetId
makeTargetIdAbsolute String
wdir (Target -> TargetId
G.targetId Target
target)})

makeTargetIdAbsolute :: FilePath -> G.TargetId -> G.TargetId
makeTargetIdAbsolute :: String -> TargetId -> TargetId
makeTargetIdAbsolute String
wdir (G.TargetFile String
fp Maybe Phase
phase) = String -> Maybe Phase -> TargetId
G.TargetFile (String
wdir String -> String -> String
</> String
fp) Maybe Phase
phase
makeTargetIdAbsolute String
_ TargetId
tid = TargetId
tid

----------------------------------------------------------------

-- | @getRuntimeGhcLibDir cradle@ will give you the ghc libDir:
-- __do not__ use 'runGhcCmd' directly.
--
--
-- Obtains libdir by calling 'runCradleGhc' on the provided cradle.
getRuntimeGhcLibDir :: Cradle a
                    -> IO (CradleLoadResult FilePath)
getRuntimeGhcLibDir :: forall a. Cradle a -> IO (CradleLoadResult String)
getRuntimeGhcLibDir Cradle a
cradle = (CradleLoadResult String -> CradleLoadResult String)
-> IO (CradleLoadResult String) -> IO (CradleLoadResult String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String)
-> CradleLoadResult String -> CradleLoadResult String
forall a b. (a -> b) -> CradleLoadResult a -> CradleLoadResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
trim) (IO (CradleLoadResult String) -> IO (CradleLoadResult String))
-> IO (CradleLoadResult String) -> IO (CradleLoadResult String)
forall a b. (a -> b) -> a -> b
$
      CradleAction a -> [String] -> IO (CradleLoadResult String)
forall a.
CradleAction a -> [String] -> IO (CradleLoadResult String)
runGhcCmd (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
cradle) [String
"--print-libdir"]

-- | Gets the version of ghc used when compiling the cradle. It is based off of
-- 'getRuntimeGhcLibDir'. If it can't work out the verison reliably, it will
-- return a 'CradleError'
getRuntimeGhcVersion :: Cradle a
                     -> IO (CradleLoadResult String)
getRuntimeGhcVersion :: forall a. Cradle a -> IO (CradleLoadResult String)
getRuntimeGhcVersion Cradle a
cradle =
  (CradleLoadResult String -> CradleLoadResult String)
-> IO (CradleLoadResult String) -> IO (CradleLoadResult String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String)
-> CradleLoadResult String -> CradleLoadResult String
forall a b. (a -> b) -> CradleLoadResult a -> CradleLoadResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
trim) (IO (CradleLoadResult String) -> IO (CradleLoadResult String))
-> IO (CradleLoadResult String) -> IO (CradleLoadResult String)
forall a b. (a -> b) -> a -> b
$ CradleAction a -> [String] -> IO (CradleLoadResult String)
forall a.
CradleAction a -> [String] -> IO (CradleLoadResult String)
runGhcCmd (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
cradle) [String
"--numeric-version"]

----------------------------------------------------------------

-- | What to call the cache directory in the cache folder.
cacheDir :: String
cacheDir :: String
cacheDir = String
"hie-bios"

{- |
Back in the day we used to clear the cache at the start of each session,
however, it's not really necessary as
1. There is one cache dir for any change in options.
2. Interface files are resistent to bad option changes anyway.

> clearInterfaceCache :: FilePath -> IO ()
> clearInterfaceCache fp = do
>   cd <- getCacheDir fp
>   res <- doesPathExist cd
>   when res (removeDirectoryRecursive cd)
-}

-- | Prepends the cache directory used by the library to the supplied file path.
-- It tries to use the path under the environment variable `$HIE_BIOS_CACHE_DIR`
-- and falls back to the standard `$XDG_CACHE_HOME/hie-bios` if the former is not set
getCacheDir :: FilePath -> IO FilePath
getCacheDir :: String -> IO String
getCacheDir String
fp = do
  Maybe String
mbEnvCacheDirectory <- String -> IO (Maybe String)
lookupEnv String
"HIE_BIOS_CACHE_DIR"
  String
cacheBaseDir <- IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgCache String
cacheDir) String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
                         Maybe String
mbEnvCacheDirectory
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
cacheBaseDir String -> String -> String
</> String
fp)

----------------------------------------------------------------

-- we don't want to generate object code so we compile to bytecode
-- (HscInterpreted) which implies LinkInMemory
-- HscInterpreted
setLinkerOptions :: G.DynFlags -> G.DynFlags
setLinkerOptions :: DynFlags -> DynFlags
setLinkerOptions DynFlags
df = DynFlags -> DynFlags
Gap.setNoCode (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags
df {
    ghcLink :: GhcLink
G.ghcLink = GhcLink
G.LinkInMemory
  , ghcMode :: GhcMode
G.ghcMode = GhcMode
G.CompManager
  }

setIgnoreInterfacePragmas :: G.DynFlags -> G.DynFlags
setIgnoreInterfacePragmas :: DynFlags -> DynFlags
setIgnoreInterfacePragmas DynFlags
df = DynFlags -> GeneralFlag -> DynFlags
Gap.gopt_set DynFlags
df GeneralFlag
G.Opt_IgnoreInterfacePragmas

setVerbosity :: Int -> G.DynFlags -> G.DynFlags
setVerbosity :: Int -> DynFlags -> DynFlags
setVerbosity Int
n DynFlags
df = DynFlags
df { verbosity :: Int
G.verbosity = Int
n }

writeInterfaceFiles :: Maybe FilePath -> G.DynFlags -> G.DynFlags
writeInterfaceFiles :: Maybe String -> DynFlags -> DynFlags
writeInterfaceFiles Maybe String
Nothing DynFlags
df = DynFlags
df
writeInterfaceFiles (Just String
hi_dir) DynFlags
df = String -> DynFlags -> DynFlags
setHiDir String
hi_dir (DynFlags -> GeneralFlag -> DynFlags
Gap.gopt_set DynFlags
df GeneralFlag
G.Opt_WriteInterface)

setHiDir :: FilePath -> G.DynFlags -> G.DynFlags
setHiDir :: String -> DynFlags -> DynFlags
setHiDir String
f DynFlags
d = DynFlags
d { hiDir :: Maybe String
G.hiDir      = String -> Maybe String
forall a. a -> Maybe a
Just String
f}


-- | Interpret and set the specific command line options.
-- A lot of this code is just copied from ghc/Main.hs
-- It would be good to move this code into a library module so we can just use it
-- rather than copy it.
addCmdOpts :: (GhcMonad m)
           => [String] -> G.DynFlags -> m (G.DynFlags, [G.Target])
addCmdOpts :: forall (m :: * -> *).
GhcMonad m =>
[String] -> DynFlags -> m (DynFlags, [Target])
addCmdOpts [String]
cmdOpts DynFlags
df1 = do
  Logger
logger <- HscEnv -> Logger
Gap.getLogger (HscEnv -> Logger) -> m HscEnv -> m Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
G.getSession
  (DynFlags
df2, [Located String]
leftovers', [Warn]
_warns) <- Logger
-> DynFlags
-> [Located String]
-> m (DynFlags, [Located String], [Warn])
forall (m :: * -> *).
MonadIO m =>
Logger
-> DynFlags
-> [Located String]
-> m (DynFlags, [Located String], [Warn])
Gap.parseDynamicFlags Logger
logger DynFlags
df1 ((String -> Located String) -> [String] -> [Located String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Located String
forall e. e -> Located e
G.noLoc [String]
cmdOpts)
  -- parse targets from ghci-scripts. Only extract targets that have been ":add"'ed.
  [String]
additionalTargets <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> m [[String]] -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m [String]) -> [String] -> m [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String])
-> (String -> IO [String]) -> String -> m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
getTargetsFromGhciScript) (DynFlags -> [String]
G.ghciScripts DynFlags
df2)

  -- leftovers contains all Targets from the command line
  let leftovers :: [String]
leftovers = (Located String -> String) -> [Located String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Located String -> String
forall l e. GenLocated l e -> e
G.unLoc [Located String]
leftovers' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
additionalTargets

  let (DynFlags
df3, [(String, Maybe Phase)]
srcs, [String]
_objs) = DynFlags
-> [String] -> (DynFlags, [(String, Maybe Phase)], [String])
Gap.parseTargetFiles DynFlags
df2 [String]
leftovers
  [Target]
ts <- ((String, Maybe Phase) -> m Target)
-> [(String, Maybe Phase)] -> m [Target]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((String -> Maybe Phase -> m Target)
-> (String, Maybe Phase) -> m Target
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (\String
f Maybe Phase
phase -> String -> Maybe UnitId -> Maybe Phase -> m Target
forall (m :: * -> *).
GhcMonad m =>
String -> Maybe UnitId -> Maybe Phase -> m Target
Gap.guessTarget String
f (UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ DynFlags -> UnitId
Gap.homeUnitId_ DynFlags
df3) Maybe Phase
phase) ) [(String, Maybe Phase)]
srcs
  (DynFlags, [Target]) -> m (DynFlags, [Target])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags
df3, [Target]
ts)

-- | Make filepaths in the given 'DynFlags' absolute.
-- This makes the 'DynFlags' independent of the current working directory.
makeDynFlagsAbsolute :: FilePath -> G.DynFlags -> G.DynFlags
makeDynFlagsAbsolute :: String -> DynFlags -> DynFlags
makeDynFlagsAbsolute String
root DynFlags
df =
  (String -> String) -> DynFlags -> DynFlags
Gap.mapOverIncludePaths String -> String
makeAbs
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags
df
    { importPaths :: [String]
G.importPaths = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
makeAbs (DynFlags -> [String]
G.importPaths DynFlags
df)
    , packageDBFlags :: [PackageDBFlag]
G.packageDBFlags =
        (PackageDBFlag -> PackageDBFlag)
-> [PackageDBFlag] -> [PackageDBFlag]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> PackageDBFlag -> PackageDBFlag
Gap.overPkgDbRef String -> String
makeAbs) (DynFlags -> [PackageDBFlag]
G.packageDBFlags DynFlags
df)
    }
  where
    makeAbs :: String -> String
makeAbs =
#if __GLASGOW_HASKELL__ >= 903
      case DynFlags -> Maybe String
G.workingDirectory DynFlags
df of
        Just String
fp -> ((String
root String -> String -> String
</> String
fp) String -> String -> String
</>)
        Maybe String
Nothing ->
#endif
          (String
root String -> String -> String
</>)

-- --------------------------------------------------------

disableOptimisation :: G.DynFlags -> G.DynFlags
disableOptimisation :: DynFlags -> DynFlags
disableOptimisation DynFlags
df = Int -> DynFlags -> DynFlags
Gap.updOptLevel Int
0 DynFlags
df

-- --------------------------------------------------------

-- | Read a ghci script and extract all targets to load form it.
-- The ghci script is expected to have the following format:
-- @
--  :add Foo Bar Main.hs
-- @
--
-- We strip away ":add" and parse the Targets.
getTargetsFromGhciScript :: FilePath -> IO [String]
getTargetsFromGhciScript :: String -> IO [String]
getTargetsFromGhciScript String
script = do
  [String]
contents <- String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
script
  let parseGhciLine :: String -> [String]
parseGhciLine = (([String], String) -> [String])
-> [([String], String)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String], String) -> [String]
forall a b. (a, b) -> a
fst ([([String], String)] -> [String])
-> (String -> [([String], String)]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], String) -> Bool)
-> [([String], String)] -> [([String], String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> (([String], String) -> String) -> ([String], String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], String) -> String
forall a b. (a, b) -> b
snd) ([([String], String)] -> [([String], String)])
-> (String -> [([String], String)])
-> String
-> [([String], String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP [String] -> String -> [([String], String)]
forall a. ReadP a -> ReadS a
readP_to_S ReadP [String]
parser
  [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
parseGhciLine [String]
contents

-- |This parser aims to parse targets and double-quoted filepaths that are separated by spaces
-- and prefixed with the literal ":add"
--
-- >>> filter (null . snd) $ readP_to_S parser ":add Lib Lib2"
-- [(["Lib","Lib2"],"")]
--
-- >>> filter (null . snd) $ readP_to_S parser ":add Lib Lib2 \"Test Example.hs\""
-- [(["Lib","Lib2","Test Example.hs"],"")]
--
-- >>> filter (null . snd) $ readP_to_S parser ":add Lib Lib2 \"Test Exa\\\"mple.hs\""
-- [(["Lib","Lib2","Test Exa\"mple.hs"],"")]
parser :: ReadP [String]
parser :: ReadP [String]
parser = do
  String
_ <- String -> ReadP String
string String
":add" ReadP String -> ReadP String -> ReadP String
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP String
space1
  ReadP String
scriptword ReadP String -> ReadP String -> ReadP [String]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy` ReadP String
space1

space1 :: ReadP [Char]
space1 :: ReadP String
space1 = ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 (Char -> ReadP Char
char Char
' ')

scriptword :: ReadP String
scriptword :: ReadP String
scriptword = ReadP String
quoted ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP String
value

-- | A balanced double-quoted string
quoted :: ReadP String
quoted :: ReadP String
quoted = do
    Char
_ <- Char -> ReadP Char
char Char
'"'
    ReadP Char -> ReadP Char -> ReadP String
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
manyTill (Char -> ReadP Char
escaped Char
'"' ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadP Char
anyToken) (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char Char
'"'

escaped :: Char -> ReadP Char
escaped :: Char -> ReadP Char
escaped Char
c = Char
c Char -> ReadP String -> ReadP Char
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string (String
"\\" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
c])

value :: ReadP String
value :: ReadP String
value = ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 ((Char -> Bool) -> ReadP Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))

anyToken :: ReadP Char
anyToken :: ReadP Char
anyToken = (Char -> Bool) -> ReadP Char
satisfy ((Char -> Bool) -> ReadP Char) -> (Char -> Bool) -> ReadP Char
forall a b. (a -> b) -> a -> b
$ Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True

-- Used for clipping the trailing newlines on GHC output
-- Also only take the last line of output
-- (Stack's ghc output has a lot of preceding noise from 7zip etc)
trim :: String -> String
trim :: String -> String
trim String
s = case String -> [String]
lines String
s of
  [] -> String
s
  [String]
ls -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
ls