packages feed

hie-bios 0.5.0 → 0.5.1

raw patch · 81 files changed

+1227/−1218 lines, 81 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ HIE.Bios.Cradle: getCradle :: (b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
+ HIE.Bios.Cradle: makeCradleResult :: (ExitCode, [String], FilePath, [String]) -> [FilePath] -> CradleLoadResult ComponentOptions
+ HIE.Bios.Cradle: readProcessWithOutputFile :: LoggingFunction -> FilePath -> FilePath -> [String] -> IO (ExitCode, [String], [String], [String])

Files

ChangeLog view
@@ -1,3 +1,8 @@+2020-06-26 - 0.5.1++	* Fix printing of current directory in wrapper script [#206](https://github.com/mpickering/hie-bios/pull/206)+	* Export Cradle utilizes [#189](https://github.com/mpickering/hie-bios/pull/189)+ 2020-05-08 - 0.5.0  	* Add cabal.project.local to cabal cradle dependencies [#184](https://github.com/mpickering/hie-bios/pull/184)
LICENSE view
@@ -1,29 +1,29 @@-Copyright (c) 2009, IIJ Innovation Institute Inc.
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-
-  * Redistributions of source code must retain the above copyright
-    notice, this list of conditions and the following disclaimer.
-  * Redistributions in binary form must reproduce the above copyright
-    notice, this list of conditions and the following disclaimer in
-    the documentation and/or other materials provided with the
-    distribution.
-  * Neither the name of the copyright holders nor the names of its
-    contributors may be used to endorse or promote products derived
-    from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
-BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.
+Copyright (c) 2009, IIJ Innovation Institute Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++  * Redistributions of source code must retain the above copyright+    notice, this list of conditions and the following disclaimer.+  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in+    the documentation and/or other materials provided with the+    distribution.+  * Neither the name of the copyright holders nor the names of its+    contributors may be used to endorse or promote products derived+    from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
hie-bios.cabal view
@@ -1,6 +1,6 @@ Cabal-Version:          2.2 Name:                   hie-bios-Version:                0.5.0+Version:                0.5.1 Author:                 Matthew Pickering <matthewtpickering@gmail.com> Maintainer:             Matthew Pickering <matthewtpickering@gmail.com> License:                BSD-3-Clause
src/HIE/Bios.hs view
@@ -1,33 +1,33 @@-{- | The HIE Bios
-
-Provides an abstraction over the GHC Api to initialise a GHC session and
-loading modules in a project.
-
-Defines the `hie.yaml` file specification. This is used to explicitly configure
-how a project should be built by GHC.
-
--}
-module HIE.Bios (
-  -- * Find and load a Cradle
-    Cradle(..)
-  , CradleLoadResult(..)
-  , CradleError(..)
-  , findCradle
-  , loadCradle
-  , loadImplicitCradle
-  , defaultCradle
-  -- * Compiler Options
-  , ComponentOptions(..)
-  , getCompilerOptions
-  -- * Initialising a GHC session from a Cradle
-  , initSession
-  -- * Loading targets into a GHC session
-  , loadFile
-
-  ) where
-
-import HIE.Bios.Cradle
-import HIE.Bios.Types
-import HIE.Bios.Flags
-import HIE.Bios.Environment
+{- | The HIE Bios++Provides an abstraction over the GHC Api to initialise a GHC session and+loading modules in a project.++Defines the `hie.yaml` file specification. This is used to explicitly configure+how a project should be built by GHC.++-}+module HIE.Bios (+  -- * Find and load a Cradle+    Cradle(..)+  , CradleLoadResult(..)+  , CradleError(..)+  , findCradle+  , loadCradle+  , loadImplicitCradle+  , defaultCradle+  -- * Compiler Options+  , ComponentOptions(..)+  , getCompilerOptions+  -- * Initialising a GHC session from a Cradle+  , initSession+  -- * Loading targets into a GHC session+  , loadFile++  ) where++import HIE.Bios.Cradle+import HIE.Bios.Types+import HIE.Bios.Flags+import HIE.Bios.Environment import HIE.Bios.Ghc.Load
src/HIE/Bios/Config.hs view
@@ -1,189 +1,189 @@-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE DeriveFunctor #-}
--- | Logic and datatypes for parsing @hie.yaml@ files.
-module HIE.Bios.Config(
-    readConfig,
-    Config(..),
-    CradleConfig(..),
-    CradleType(..)
-    ) where
-
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import qualified Data.HashMap.Strict as Map
-import           Data.Foldable (foldrM)
-import           Data.Yaml
-
--- | Configuration that can be used to load a 'Cradle'.
--- A configuration has roughly the following form:
---
--- @
--- cradle:
---   cabal:
---     component: "lib:hie-bios"
--- @
-newtype Config a = Config { cradle :: CradleConfig a }
-    deriving (Show, Eq, Functor)
-
-data CradleConfig a =
-    CradleConfig
-        { cradleDependencies :: [FilePath]
-        -- ^ Dependencies of a cradle.
-        -- Dependencies are expected to be relative to the root directory.
-        -- The given files are not required to exist.
-        , cradleType :: CradleType a
-        -- ^ Type of the cradle to use. Actions to obtain
-        -- compiler flags from are dependant on this field.
-        }
-        deriving (Show, Eq, Functor)
-
-data CradleType a
-    = Cabal { component :: Maybe String }
-    | CabalMulti [ (FilePath, String) ]
-    | Stack { component :: Maybe String }
-    | StackMulti [ (FilePath, String) ]
---  Bazel and Obelisk used to be supported but bit-rotted and no users have complained.
---  They can be added back if a user
---    | Bazel
---    | Obelisk
-    | Bios
-        { prog :: FilePath
-        -- ^ Path to program that retrieves options to compile a file
-        , depsProg :: Maybe FilePath
-        -- ^ Optional Path to program to obtain cradle dependencies.
-        -- Each cradle dependency is to be expected to be on a separate line
-        -- and relative to the root dir of the cradle, not relative
-        -- to the location of this program.
-        }
-    | Direct { arguments :: [String] }
-    | None
-    | Multi [ (FilePath, CradleConfig a) ]
-    | Other { otherConfig :: a, originalYamlValue :: Value }
-    deriving (Eq, Functor)
-
-instance FromJSON a => FromJSON (CradleType a) where
-    parseJSON (Object o) = parseCradleType o
-    parseJSON _ = fail "Not a known cradle type. Possible are: cabal, stack, bios, direct, default, none, multi"
-
-instance Show (CradleType a) where
-    show (Cabal comp) = "Cabal {component = " ++ show comp ++ "}"
-    show (CabalMulti a) = "CabalMulti " ++ show a
-    show (Stack comp) = "Stack {component = " ++ show comp ++ "}"
-    show (StackMulti a) = "StackMulti " ++ show a
-    show Bios { prog, depsProg } = "Bios {prog = " ++ show prog ++ ", depsProg = " ++ show depsProg ++ "}"
-    show (Direct args) = "Direct {arguments = " ++ show args ++ "}"
-    show None = "None"
-    show (Multi a) = "Multi " ++ show a
-    show (Other _ val) = "Other {originalYamlValue = " ++ show val ++ "}"
-
-parseCradleType :: FromJSON a => Object -> Parser (CradleType a)
-parseCradleType o
-    | Just val <- Map.lookup "cabal" o = parseCabal val
-    | Just val <- Map.lookup "stack" o = parseStack val
---    | Just _val <- Map.lookup "bazel" o = return Bazel
---    | Just _val <- Map.lookup "obelisk" o = return Obelisk
-    | Just val <- Map.lookup "bios" o = parseBios val
-    | Just val <- Map.lookup "direct" o = parseDirect val
-    | Just _val <- Map.lookup "none" o = return None
-    | Just val  <- Map.lookup "multi" o = parseMulti val
-    | Just val  <- Map.lookup "other" o = Other <$> parseJSON val <*> pure val
-parseCradleType o = fail $ "Unknown cradle type: " ++ show o
-
-parseStackOrCabal
-  :: (Maybe String -> CradleType a)
-  -> ([(FilePath, String)] -> CradleType a)
-  -> Value
-  -> Parser (CradleType a)
-parseStackOrCabal singleConstructor _ (Object x)
-  | Map.size x == 1, Just (String stackComponent) <- Map.lookup "component" x
-  = return $ singleConstructor $ Just $ T.unpack stackComponent
-  | Map.null x
-  = return $ singleConstructor Nothing
-  | otherwise
-  = fail "Not a valid Configuration type, following keys are allowed: component"
-parseStackOrCabal _ multiConstructor (Array x) = do
-  let parseOne e
-        | Object v <- e
-        , Just (String prefix) <- Map.lookup "path" v
-        , Just (String comp) <- Map.lookup "component" v
-        , Map.size v == 2
-        = return (T.unpack prefix, T.unpack comp)
-        | otherwise
-        = fail "Expected an object with path and component keys"
-
-  xs <- foldrM (\v cs -> (: cs) <$> parseOne v) [] x
-  return $ multiConstructor xs
-parseStackOrCabal singleConstructor _ Null = return $ singleConstructor Nothing
-parseStackOrCabal _ _ _ = fail "Configuration is expected to be an object."
-
-parseStack :: Value -> Parser (CradleType a)
-parseStack = parseStackOrCabal Stack StackMulti
-
-parseCabal :: Value -> Parser (CradleType a)
-parseCabal = parseStackOrCabal Cabal CabalMulti
-
-parseBios :: Value -> Parser (CradleType a)
-parseBios (Object x)
-    | 2 == Map.size x
-    , Just (String biosProgram) <- Map.lookup "program" x
-    , Just (String biosDepsProgram) <- Map.lookup "dependency-program" x
-    = return $ Bios (T.unpack biosProgram) (Just (T.unpack biosDepsProgram))
-
-    | 1 == Map.size x
-    , Just (String biosProgram) <- Map.lookup "program" x
-    = return $ Bios (T.unpack biosProgram) Nothing
-
-    | otherwise
-    = fail "Not a valid Bios Configuration type, following keys are allowed: program, dependency-program"
-parseBios _ = fail "Bios Configuration is expected to be an object."
-
-parseDirect :: Value -> Parser (CradleType a)
-parseDirect (Object x)
-    | Map.size x == 1
-    , Just (Array v) <- Map.lookup "arguments" x
-    = return $ Direct [T.unpack s | String s <- V.toList v]
-
-    | otherwise
-    = fail "Not a valid Direct Configuration type, following keys are allowed: arguments"
-parseDirect _ = fail "Direct Configuration is expected to be an object."
-
-parseMulti :: FromJSON a => Value -> Parser (CradleType a)
-parseMulti (Array x)
-    = Multi <$> mapM parsePath (V.toList x)
-parseMulti _ = fail "Multi Configuration is expected to be an array."
-
-parsePath :: FromJSON a => Value -> Parser (FilePath, CradleConfig a)
-parsePath (Object v)
-  | Just (String path) <- Map.lookup "path" v
-  , Just c <- Map.lookup "config" v
-  = (T.unpack path,) <$> parseJSON c
-parsePath o = fail ("Multi component is expected to be an object." ++ show o)
-
-instance FromJSON a => FromJSON (CradleConfig a) where
-    parseJSON (Object val) = do
-            crd     <- val .: "cradle"
-            crdDeps <- case Map.size val of
-                1 -> return []
-                2 -> val .: "dependencies"
-                _ -> fail "Unknown key, following keys are allowed: cradle, dependencies"
-
-            return $ CradleConfig { cradleType         = crd
-                                  , cradleDependencies = crdDeps
-                                  }
-
-    parseJSON _ = fail "Expected a cradle: key containing the preferences, possible values: cradle, dependencies"
-
-
-instance FromJSON a => FromJSON (Config a) where
-    parseJSON o = Config <$> parseJSON o
-
-
--- | Decode given file to a 'Config a' value.
--- Type variable 'a' can be used to extend the 'hie.yaml' file format
--- to extend configuration in the user-library.
--- If the contents of the file is not a valid 'Config a',
--- an 'Control.Exception.IOException' is thrown.
-readConfig :: FromJSON a => FilePath -> IO (Config a)
+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DeriveFunctor #-}+-- | Logic and datatypes for parsing @hie.yaml@ files.+module HIE.Bios.Config(+    readConfig,+    Config(..),+    CradleConfig(..),+    CradleType(..)+    ) where++import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Data.HashMap.Strict as Map+import           Data.Foldable (foldrM)+import           Data.Yaml++-- | Configuration that can be used to load a 'Cradle'.+-- A configuration has roughly the following form:+--+-- @+-- cradle:+--   cabal:+--     component: "lib:hie-bios"+-- @+newtype Config a = Config { cradle :: CradleConfig a }+    deriving (Show, Eq, Functor)++data CradleConfig a =+    CradleConfig+        { cradleDependencies :: [FilePath]+        -- ^ Dependencies of a cradle.+        -- Dependencies are expected to be relative to the root directory.+        -- The given files are not required to exist.+        , cradleType :: CradleType a+        -- ^ Type of the cradle to use. Actions to obtain+        -- compiler flags from are dependant on this field.+        }+        deriving (Show, Eq, Functor)++data CradleType a+    = Cabal { component :: Maybe String }+    | CabalMulti [ (FilePath, String) ]+    | Stack { component :: Maybe String }+    | StackMulti [ (FilePath, String) ]+--  Bazel and Obelisk used to be supported but bit-rotted and no users have complained.+--  They can be added back if a user+--    | Bazel+--    | Obelisk+    | Bios+        { prog :: FilePath+        -- ^ Path to program that retrieves options to compile a file+        , depsProg :: Maybe FilePath+        -- ^ Optional Path to program to obtain cradle dependencies.+        -- Each cradle dependency is to be expected to be on a separate line+        -- and relative to the root dir of the cradle, not relative+        -- to the location of this program.+        }+    | Direct { arguments :: [String] }+    | None+    | Multi [ (FilePath, CradleConfig a) ]+    | Other { otherConfig :: a, originalYamlValue :: Value }+    deriving (Eq, Functor)++instance FromJSON a => FromJSON (CradleType a) where+    parseJSON (Object o) = parseCradleType o+    parseJSON _ = fail "Not a known cradle type. Possible are: cabal, stack, bios, direct, default, none, multi"++instance Show (CradleType a) where+    show (Cabal comp) = "Cabal {component = " ++ show comp ++ "}"+    show (CabalMulti a) = "CabalMulti " ++ show a+    show (Stack comp) = "Stack {component = " ++ show comp ++ "}"+    show (StackMulti a) = "StackMulti " ++ show a+    show Bios { prog, depsProg } = "Bios {prog = " ++ show prog ++ ", depsProg = " ++ show depsProg ++ "}"+    show (Direct args) = "Direct {arguments = " ++ show args ++ "}"+    show None = "None"+    show (Multi a) = "Multi " ++ show a+    show (Other _ val) = "Other {originalYamlValue = " ++ show val ++ "}"++parseCradleType :: FromJSON a => Object -> Parser (CradleType a)+parseCradleType o+    | Just val <- Map.lookup "cabal" o = parseCabal val+    | Just val <- Map.lookup "stack" o = parseStack val+--    | Just _val <- Map.lookup "bazel" o = return Bazel+--    | Just _val <- Map.lookup "obelisk" o = return Obelisk+    | Just val <- Map.lookup "bios" o = parseBios val+    | Just val <- Map.lookup "direct" o = parseDirect val+    | Just _val <- Map.lookup "none" o = return None+    | Just val  <- Map.lookup "multi" o = parseMulti val+    | Just val  <- Map.lookup "other" o = Other <$> parseJSON val <*> pure val+parseCradleType o = fail $ "Unknown cradle type: " ++ show o++parseStackOrCabal+  :: (Maybe String -> CradleType a)+  -> ([(FilePath, String)] -> CradleType a)+  -> Value+  -> Parser (CradleType a)+parseStackOrCabal singleConstructor _ (Object x)+  | Map.size x == 1, Just (String stackComponent) <- Map.lookup "component" x+  = return $ singleConstructor $ Just $ T.unpack stackComponent+  | Map.null x+  = return $ singleConstructor Nothing+  | otherwise+  = fail "Not a valid Configuration type, following keys are allowed: component"+parseStackOrCabal _ multiConstructor (Array x) = do+  let parseOne e+        | Object v <- e+        , Just (String prefix) <- Map.lookup "path" v+        , Just (String comp) <- Map.lookup "component" v+        , Map.size v == 2+        = return (T.unpack prefix, T.unpack comp)+        | otherwise+        = fail "Expected an object with path and component keys"++  xs <- foldrM (\v cs -> (: cs) <$> parseOne v) [] x+  return $ multiConstructor xs+parseStackOrCabal singleConstructor _ Null = return $ singleConstructor Nothing+parseStackOrCabal _ _ _ = fail "Configuration is expected to be an object."++parseStack :: Value -> Parser (CradleType a)+parseStack = parseStackOrCabal Stack StackMulti++parseCabal :: Value -> Parser (CradleType a)+parseCabal = parseStackOrCabal Cabal CabalMulti++parseBios :: Value -> Parser (CradleType a)+parseBios (Object x)+    | 2 == Map.size x+    , Just (String biosProgram) <- Map.lookup "program" x+    , Just (String biosDepsProgram) <- Map.lookup "dependency-program" x+    = return $ Bios (T.unpack biosProgram) (Just (T.unpack biosDepsProgram))++    | 1 == Map.size x+    , Just (String biosProgram) <- Map.lookup "program" x+    = return $ Bios (T.unpack biosProgram) Nothing++    | otherwise+    = fail "Not a valid Bios Configuration type, following keys are allowed: program, dependency-program"+parseBios _ = fail "Bios Configuration is expected to be an object."++parseDirect :: Value -> Parser (CradleType a)+parseDirect (Object x)+    | Map.size x == 1+    , Just (Array v) <- Map.lookup "arguments" x+    = return $ Direct [T.unpack s | String s <- V.toList v]++    | otherwise+    = fail "Not a valid Direct Configuration type, following keys are allowed: arguments"+parseDirect _ = fail "Direct Configuration is expected to be an object."++parseMulti :: FromJSON a => Value -> Parser (CradleType a)+parseMulti (Array x)+    = Multi <$> mapM parsePath (V.toList x)+parseMulti _ = fail "Multi Configuration is expected to be an array."++parsePath :: FromJSON a => Value -> Parser (FilePath, CradleConfig a)+parsePath (Object v)+  | Just (String path) <- Map.lookup "path" v+  , Just c <- Map.lookup "config" v+  = (T.unpack path,) <$> parseJSON c+parsePath o = fail ("Multi component is expected to be an object." ++ show o)++instance FromJSON a => FromJSON (CradleConfig a) where+    parseJSON (Object val) = do+            crd     <- val .: "cradle"+            crdDeps <- case Map.size val of+                1 -> return []+                2 -> val .: "dependencies"+                _ -> fail "Unknown key, following keys are allowed: cradle, dependencies"++            return $ CradleConfig { cradleType         = crd+                                  , cradleDependencies = crdDeps+                                  }++    parseJSON _ = fail "Expected a cradle: key containing the preferences, possible values: cradle, dependencies"+++instance FromJSON a => FromJSON (Config a) where+    parseJSON o = Config <$> parseJSON o+++-- | Decode given file to a 'Config a' value.+-- Type variable 'a' can be used to extend the 'hie.yaml' file format+-- to extend configuration in the user-library.+-- If the contents of the file is not a valid 'Config a',+-- an 'Control.Exception.IOException' is thrown.+readConfig :: FromJSON a => FilePath -> IO (Config a) readConfig = decodeFileThrow
src/HIE/Bios/Cradle.hs view
@@ -15,6 +15,9 @@     , isMultiCradle     , isDefaultCradle     , isOtherCradle+    , getCradle+    , readProcessWithOutputFile+    , makeCradleResult   ) where  import Control.Exception (handleJust)
src/HIE/Bios/Flags.hs view
@@ -1,25 +1,25 @@-module HIE.Bios.Flags (getCompilerOptions, getCompilerOptionsWithLogger, LoggingFunction) where
-
-import HIE.Bios.Types
-import HIE.Bios.Internal.Log
-
-
--- | Initialize the 'DynFlags' relating to the compilation of a single
--- file or GHC session according to the provided 'Cradle'.
-getCompilerOptions ::
-    FilePath -- The file we are loading it because of
-    -> Cradle a
-    -> IO (CradleLoadResult ComponentOptions)
-getCompilerOptions =
-  getCompilerOptionsWithLogger logm
-
-getCompilerOptionsWithLogger ::
-  LoggingFunction
-  -> FilePath
-  -> Cradle a
-  -> IO (CradleLoadResult ComponentOptions)
-getCompilerOptionsWithLogger l fp cradle =
-  runCradle (cradleOptsProg cradle) l fp
-
-
-----------------------------------------------------------------
+module HIE.Bios.Flags (getCompilerOptions, getCompilerOptionsWithLogger, LoggingFunction) where++import HIE.Bios.Types+import HIE.Bios.Internal.Log+++-- | Initialize the 'DynFlags' relating to the compilation of a single+-- file or GHC session according to the provided 'Cradle'.+getCompilerOptions ::+    FilePath -- The file we are loading it because of+    -> Cradle a+    -> IO (CradleLoadResult ComponentOptions)+getCompilerOptions =+  getCompilerOptionsWithLogger logm++getCompilerOptionsWithLogger ::+  LoggingFunction+  -> FilePath+  -> Cradle a+  -> IO (CradleLoadResult ComponentOptions)+getCompilerOptionsWithLogger l fp cradle =+  runCradle (cradleOptsProg cradle) l fp+++----------------------------------------------------------------
src/HIE/Bios/Ghc/Api.hs view
@@ -1,108 +1,108 @@-{-# LANGUAGE ScopedTypeVariables, CPP #-}
--- | These functions are for conveniently implementing the simple CLI
-module HIE.Bios.Ghc.Api (
-    initializeFlagsWithCradle
-  , initializeFlagsWithCradleWithMessage
-  , G.SuccessFlag(..)
-  -- * Utility functions for running the GHC monad and implementing internal utilities
-  , withGHC
-  , withGHC'
-  , withGhcT
-  , getSystemLibDir
-  , withDynFlags
-  ) where
-
-import CoreMonad (liftIO)
-import Exception (ghandle, SomeException(..), ExceptionMonad(..))
-import GHC (Ghc, LoadHowMuch(..), GhcMonad, GhcT)
-import DynFlags
-
-import qualified GHC as G
-import qualified MonadUtils as G
-import qualified HscMain as G
-import qualified GhcMake as G
-
-import Control.Monad (void)
-import System.Exit (exitSuccess)
-import HIE.Bios.Types
-import qualified HIE.Bios.Internal.Log as Log
-import HIE.Bios.Environment
-import HIE.Bios.Flags
-
-----------------------------------------------------------------
-
--- | Converting the 'Ghc' monad to the 'IO' monad. All exceptions are ignored and logged.
-withGHC :: FilePath  -- ^ A target file displayed in an error message.
-        -> Ghc a -- ^ 'Ghc' actions created by the Ghc utilities.
-        -> IO a
-withGHC file body = ghandle ignore $ withGHC' body
-  where
-    ignore :: SomeException -> IO a
-    ignore e = do
-        Log.logm $ file ++ ":0:0:Error:"
-        Log.logm (show e)
-        exitSuccess
-
--- | Run a Ghc monad computation with an automatically discovered libdir.
--- It calculates the lib dir by calling ghc with the `--print-libdir` flag.
-withGHC' :: Ghc a -> IO a
-withGHC' body = do
-    -- TODO: Why is this not using ghc-paths?
-    mlibdir <- getSystemLibDir
-    G.runGhc mlibdir body
-
-withGhcT :: (Exception.ExceptionMonad m, G.MonadIO m, Monad m) => GhcT m a -> m a
-withGhcT body = do
-  mlibdir <- G.liftIO $ getSystemLibDir
-  G.runGhcT mlibdir body
-
-----------------------------------------------------------------
-
--- | Initialize a GHC session by loading a given file into a given cradle.
-initializeFlagsWithCradle ::
-    GhcMonad m
-    => FilePath -- ^ The file we are loading the 'Cradle' because of
-    -> Cradle a   -- ^ The cradle we want to load
-    -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions))
-initializeFlagsWithCradle = initializeFlagsWithCradleWithMessage (Just G.batchMsg)
-
--- | The same as 'initializeFlagsWithCradle' but with an additional argument to control
--- how the loading progress messages are displayed to the user. In @haskell-ide-engine@
--- the module loading progress is displayed in the UI by using a progress notification.
-initializeFlagsWithCradleWithMessage ::
-  GhcMonad m
-  => Maybe G.Messager
-  -> FilePath -- ^ The file we are loading the 'Cradle' because of
-  -> Cradle a  -- ^ The cradle we want to load
-  -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions)) -- ^ Whether we actually loaded the cradle or not.
-initializeFlagsWithCradleWithMessage msg fp cradle =
-    fmap (initSessionWithMessage msg) <$> liftIO (getCompilerOptions fp cradle)
-
--- | Actually perform the initialisation of the session. Initialising the session corresponds to
--- parsing the command line flags, setting the targets for the session and then attempting to load
--- all the targets.
-initSessionWithMessage :: (GhcMonad m)
-            => Maybe G.Messager
-            -> ComponentOptions
-            -> (m G.SuccessFlag, ComponentOptions)
-initSessionWithMessage msg compOpts = (do
-    targets <- initSession compOpts
-    G.setTargets targets
-    -- Get the module graph using the function `getModuleGraph`
-    mod_graph <- G.depanal [] True
-    G.load' LoadAllTargets msg mod_graph, compOpts)
-
-----------------------------------------------------------------
-
-withDynFlags ::
-  (GhcMonad m)
-  => (DynFlags -> DynFlags) -> m a -> m a
-withDynFlags setFlag body = G.gbracket setup teardown (\_ -> body)
-  where
-    setup = do
-        dflag <- G.getSessionDynFlags
-        void $ G.setSessionDynFlags (setFlag dflag)
-        return dflag
-    teardown = void . G.setSessionDynFlags
-
-----------------------------------------------------------------
+{-# LANGUAGE ScopedTypeVariables, CPP #-}+-- | These functions are for conveniently implementing the simple CLI+module HIE.Bios.Ghc.Api (+    initializeFlagsWithCradle+  , initializeFlagsWithCradleWithMessage+  , G.SuccessFlag(..)+  -- * Utility functions for running the GHC monad and implementing internal utilities+  , withGHC+  , withGHC'+  , withGhcT+  , getSystemLibDir+  , withDynFlags+  ) where++import CoreMonad (liftIO)+import Exception (ghandle, SomeException(..), ExceptionMonad(..))+import GHC (Ghc, LoadHowMuch(..), GhcMonad, GhcT)+import DynFlags++import qualified GHC as G+import qualified MonadUtils as G+import qualified HscMain as G+import qualified GhcMake as G++import Control.Monad (void)+import System.Exit (exitSuccess)+import HIE.Bios.Types+import qualified HIE.Bios.Internal.Log as Log+import HIE.Bios.Environment+import HIE.Bios.Flags++----------------------------------------------------------------++-- | Converting the 'Ghc' monad to the 'IO' monad. All exceptions are ignored and logged.+withGHC :: FilePath  -- ^ A target file displayed in an error message.+        -> Ghc a -- ^ 'Ghc' actions created by the Ghc utilities.+        -> IO a+withGHC file body = ghandle ignore $ withGHC' body+  where+    ignore :: SomeException -> IO a+    ignore e = do+        Log.logm $ file ++ ":0:0:Error:"+        Log.logm (show e)+        exitSuccess++-- | Run a Ghc monad computation with an automatically discovered libdir.+-- It calculates the lib dir by calling ghc with the `--print-libdir` flag.+withGHC' :: Ghc a -> IO a+withGHC' body = do+    -- TODO: Why is this not using ghc-paths?+    mlibdir <- getSystemLibDir+    G.runGhc mlibdir body++withGhcT :: (Exception.ExceptionMonad m, G.MonadIO m, Monad m) => GhcT m a -> m a+withGhcT body = do+  mlibdir <- G.liftIO $ getSystemLibDir+  G.runGhcT mlibdir body++----------------------------------------------------------------++-- | Initialize a GHC session by loading a given file into a given cradle.+initializeFlagsWithCradle ::+    GhcMonad m+    => FilePath -- ^ The file we are loading the 'Cradle' because of+    -> Cradle a   -- ^ The cradle we want to load+    -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions))+initializeFlagsWithCradle = initializeFlagsWithCradleWithMessage (Just G.batchMsg)++-- | The same as 'initializeFlagsWithCradle' but with an additional argument to control+-- how the loading progress messages are displayed to the user. In @haskell-ide-engine@+-- the module loading progress is displayed in the UI by using a progress notification.+initializeFlagsWithCradleWithMessage ::+  GhcMonad m+  => Maybe G.Messager+  -> FilePath -- ^ The file we are loading the 'Cradle' because of+  -> Cradle a  -- ^ The cradle we want to load+  -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions)) -- ^ Whether we actually loaded the cradle or not.+initializeFlagsWithCradleWithMessage msg fp cradle =+    fmap (initSessionWithMessage msg) <$> liftIO (getCompilerOptions fp cradle)++-- | Actually perform the initialisation of the session. Initialising the session corresponds to+-- parsing the command line flags, setting the targets for the session and then attempting to load+-- all the targets.+initSessionWithMessage :: (GhcMonad m)+            => Maybe G.Messager+            -> ComponentOptions+            -> (m G.SuccessFlag, ComponentOptions)+initSessionWithMessage msg compOpts = (do+    targets <- initSession compOpts+    G.setTargets targets+    -- Get the module graph using the function `getModuleGraph`+    mod_graph <- G.depanal [] True+    G.load' LoadAllTargets msg mod_graph, compOpts)++----------------------------------------------------------------++withDynFlags ::+  (GhcMonad m)+  => (DynFlags -> DynFlags) -> m a -> m a+withDynFlags setFlag body = G.gbracket setup teardown (\_ -> body)+  where+    setup = do+        dflag <- G.getSessionDynFlags+        void $ G.setSessionDynFlags (setFlag dflag)+        return dflag+    teardown = void . G.setSessionDynFlags++----------------------------------------------------------------
src/HIE/Bios/Ghc/Doc.hs view
@@ -1,25 +1,25 @@--- | Pretty printer utilities
-module HIE.Bios.Ghc.Doc where
-
-import GHC (DynFlags, getPrintUnqual, pprCols, GhcMonad)
-import Outputable (PprStyle, SDoc, withPprStyleDoc, neverQualify)
-import Pretty (Mode(..), Doc, Style(..), renderStyle, style)
-
-import HIE.Bios.Ghc.Gap (makeUserStyle)
-
-showPage :: DynFlags -> PprStyle -> SDoc -> String
-showPage dflag stl = showDocWith dflag PageMode . withPprStyleDoc dflag stl
-
-showOneLine :: DynFlags -> PprStyle -> SDoc -> String
-showOneLine dflag stl = showDocWith dflag OneLineMode . withPprStyleDoc dflag stl
-
-getStyle :: (GhcMonad m) => DynFlags -> m PprStyle
-getStyle dflags = makeUserStyle dflags <$> getPrintUnqual
-
-styleUnqualified :: DynFlags -> PprStyle
-styleUnqualified dflags = makeUserStyle dflags neverQualify
-
-showDocWith :: DynFlags -> Mode -> Doc -> String
-showDocWith dflags md = renderStyle mstyle
-  where
-    mstyle = style { mode = md, lineLength = pprCols dflags }
+-- | Pretty printer utilities+module HIE.Bios.Ghc.Doc where++import GHC (DynFlags, getPrintUnqual, pprCols, GhcMonad)+import Outputable (PprStyle, SDoc, withPprStyleDoc, neverQualify)+import Pretty (Mode(..), Doc, Style(..), renderStyle, style)++import HIE.Bios.Ghc.Gap (makeUserStyle)++showPage :: DynFlags -> PprStyle -> SDoc -> String+showPage dflag stl = showDocWith dflag PageMode . withPprStyleDoc dflag stl++showOneLine :: DynFlags -> PprStyle -> SDoc -> String+showOneLine dflag stl = showDocWith dflag OneLineMode . withPprStyleDoc dflag stl++getStyle :: (GhcMonad m) => DynFlags -> m PprStyle+getStyle dflags = makeUserStyle dflags <$> getPrintUnqual++styleUnqualified :: DynFlags -> PprStyle+styleUnqualified dflags = makeUserStyle dflags neverQualify++showDocWith :: DynFlags -> Mode -> Doc -> String+showDocWith dflags md = renderStyle mstyle+  where+    mstyle = style { mode = md, lineLength = pprCols dflags }
src/HIE/Bios/Ghc/Load.hs view
@@ -1,171 +1,171 @@-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE CPP #-}
--- | Convenience functions for loading a file into a GHC API session
-module HIE.Bios.Ghc.Load ( loadFileWithMessage, loadFile, setTargetFiles, setTargetFilesWithMessage) where
-
-import GHC
-import qualified GHC as G
-import qualified GhcMake as G
-import qualified HscMain as G
-import HscTypes
-import Control.Monad.IO.Class
-
-import Data.IORef
-
-import Hooks
-import TcRnTypes (FrontendResult(..))
-import Control.Monad (forM, void)
-import GhcMonad
-import HscMain
-import Data.List
-
-import Data.Time.Clock
-import qualified HIE.Bios.Ghc.Gap as Gap
-import qualified HIE.Bios.Internal.Log as Log
-
--- | Load a target into the GHC session.
---
--- The target is represented as a tuple. The tuple consists of the
--- original filename and another file that contains the actual
--- source code to compile.
---
--- The optional messager can be used to log diagnostics, warnings or errors
--- that occurred during loading the target.
---
--- If the loading succeeds, the typechecked module is returned
--- together with all the typechecked modules that had to be loaded
--- in order to typecheck the given target.
-loadFileWithMessage :: GhcMonad m
-         => Maybe G.Messager -- ^ Optional messager hook
-                             -- to log messages produced by GHC.
-         -> (FilePath, FilePath)  -- ^ Target file to load.
-         -> m (Maybe TypecheckedModule, [TypecheckedModule])
-         -- ^ Typechecked module and modules that had to
-         -- be loaded for the target.
-loadFileWithMessage msg file = do
-  -- STEP 1: Load the file into the session, using collectASTs to also retrieve
-  -- typechecked and parsed modules.
-  (_, tcs) <- collectASTs $ (setTargetFilesWithMessage msg [file])
-  Log.debugm $ "loaded " ++ fst file ++ " - " ++ snd file
-  let get_fp = ml_hs_file . ms_location . pm_mod_summary . tm_parsed_module
-  Log.debugm $ "Typechecked modules for: " ++ (unlines $ map (show . get_fp) tcs)
-  -- Find the specific module in the list of returned typechecked modules if it exists.
-  let findMod [] = Nothing
-      findMod (x:xs) = case get_fp x of
-                         Just fp -> if fp `isSuffixOf` (snd file) then Just x else findMod xs
-                         Nothing -> findMod xs
-  return (findMod tcs, tcs)
-
--- | Load a target into the GHC session with the default messager
---  which outputs updates in the same format as normal GHC.
---
--- The target is represented as a tuple. The tuple consists of the
--- original filename and another file that contains the actual
--- source code to compile.
---
--- If the message should configured, use 'loadFileWithMessage'.
---
--- If the loading succeeds, the typechecked module is returned
--- together with all the typechecked modules that had to be loaded
--- in order to typecheck the given target.
-loadFile :: (GhcMonad m)
-         => (FilePath, FilePath) -- ^ Target file to load.
-         -> m (Maybe TypecheckedModule, [TypecheckedModule])
-         -- ^ Typechecked module and modules that had to
-         -- be loaded for the target.
-loadFile = loadFileWithMessage (Just G.batchMsg)
-
-
--- | Set the files as targets and load them. This will reset GHC's targets so only the modules you
--- set as targets and its dependencies will be loaded or reloaded.
--- Produced diagnostics will be printed similar to the normal output of GHC.
--- To configure this, use 'setTargetFilesWithMessage'.
-setTargetFiles :: GhcMonad m => [(FilePath, FilePath)] -> m ()
-setTargetFiles = setTargetFilesWithMessage (Just G.batchMsg)
-
-msTargetIs :: ModSummary -> Target -> Bool
-msTargetIs ms t = case targetId t of
-  TargetModule m -> moduleName (ms_mod ms) == m
-  TargetFile f _ -> ml_hs_file (ms_location ms) == Just f
-
--- | We bump the times for any ModSummary's that are Targets, to
--- fool the recompilation checker so that we can get the typechecked modules
-updateTime :: MonadIO m => [Target] -> ModuleGraph -> m ModuleGraph
-updateTime ts graph = liftIO $ do
-  cur_time <- getCurrentTime
-  let go ms
-        | any (msTargetIs ms) ts = ms {ms_hs_date = cur_time}
-        | otherwise = ms
-  pure $ Gap.mapMG go graph
-
--- | Set the files as targets and load them. This will reset GHC's targets so only the modules you
--- set as targets and its dependencies will be loaded or reloaded.
-setTargetFilesWithMessage :: (GhcMonad m)  => Maybe G.Messager -> [(FilePath, FilePath)] -> m ()
-setTargetFilesWithMessage msg files = do
-    targets <- forM files guessTargetMapped
-    Log.debugm $ "setTargets: " ++ show files
-    G.setTargets targets
-    mod_graph <- updateTime targets =<< depanal [] False
-    Log.debugm $ "modGraph: " ++ show (map ms_location $ Gap.mgModSummaries mod_graph)
-    void $ G.load' LoadAllTargets msg mod_graph
-
--- | Add a hook to record the contents of any 'TypecheckedModule's which are produced
--- during compilation.
-collectASTs :: (GhcMonad m) => m a -> m (a, [TypecheckedModule])
-collectASTs action = do
-  dflags0 <- getSessionDynFlags
-  ref1 <- liftIO $ newIORef []
-  let dflags1 = dflags0 { hooks = (hooks dflags0)
-                          { hscFrontendHook = Just (astHook ref1) }
-                        }
-  -- Modify session is much faster than `setSessionDynFlags`.
-  modifySession $ \h -> h{ hsc_dflags = dflags1 }
-  res <- action
-  tcs <- liftIO $ readIORef ref1
-  -- Unset the hook so that we don't retain the reference ot the IORef so it can be gced.
-  -- This stops the typechecked modules being retained in some cases.
-  liftIO $ writeIORef ref1 []
-  dflags_old <- getSessionDynFlags
-  let dflags2 = dflags1 { hooks = (hooks dflags_old)
-                          { hscFrontendHook = Nothing }
-                        }
-  modifySession $ \h -> h{ hsc_dflags = dflags2 }
-
-  return (res, tcs)
-
--- | This hook overwrites the default frontend action of GHC.
-astHook :: IORef [TypecheckedModule] -> ModSummary -> Hsc FrontendResult
-astHook tc_ref ms = ghcInHsc $ do
-  p <- G.parseModule =<< initializePluginsGhc ms
-  tcm <- G.typecheckModule p
-  let tcg_env = fst (tm_internals_ tcm)
-  liftIO $ modifyIORef tc_ref (tcm :)
-  return $ FrontendTypecheck tcg_env
-
-initializePluginsGhc :: ModSummary -> Ghc ModSummary
-initializePluginsGhc ms = do
-  hsc_env <- getSession
-  df <- liftIO $ Gap.initializePlugins hsc_env (ms_hspp_opts  ms)
-  Log.debugm ("init-plugins(loaded):" ++ show (Gap.numLoadedPlugins df))
-  Log.debugm ("init-plugins(specified):" ++ show (length $ pluginModNames df))
-  return (ms { ms_hspp_opts = df })
-
-
-ghcInHsc :: Ghc a -> Hsc a
-ghcInHsc gm = do
-  hsc_session <- getHscEnv
-  session <- liftIO $ newIORef hsc_session
-  liftIO $ reflectGhc gm (Session session)
-
--- | A variant of 'guessTarget' which after guessing the target for a filepath, overwrites the
--- target file to be a temporary file.
-guessTargetMapped :: (GhcMonad m) => (FilePath, FilePath) -> m Target
-guessTargetMapped (orig_file_name, mapped_file_name) = do
-  t <- G.guessTarget orig_file_name Nothing
-  return (setTargetFilename mapped_file_name t)
-
-setTargetFilename :: FilePath -> Target -> Target
-setTargetFilename fn t =
-  t { targetId = case targetId t of
-                  TargetFile _ p -> TargetFile fn p
-                  tid -> tid }
+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+-- | Convenience functions for loading a file into a GHC API session+module HIE.Bios.Ghc.Load ( loadFileWithMessage, loadFile, setTargetFiles, setTargetFilesWithMessage) where++import GHC+import qualified GHC as G+import qualified GhcMake as G+import qualified HscMain as G+import HscTypes+import Control.Monad.IO.Class++import Data.IORef++import Hooks+import TcRnTypes (FrontendResult(..))+import Control.Monad (forM, void)+import GhcMonad+import HscMain+import Data.List++import Data.Time.Clock+import qualified HIE.Bios.Ghc.Gap as Gap+import qualified HIE.Bios.Internal.Log as Log++-- | Load a target into the GHC session.+--+-- The target is represented as a tuple. The tuple consists of the+-- original filename and another file that contains the actual+-- source code to compile.+--+-- The optional messager can be used to log diagnostics, warnings or errors+-- that occurred during loading the target.+--+-- If the loading succeeds, the typechecked module is returned+-- together with all the typechecked modules that had to be loaded+-- in order to typecheck the given target.+loadFileWithMessage :: GhcMonad m+         => Maybe G.Messager -- ^ Optional messager hook+                             -- to log messages produced by GHC.+         -> (FilePath, FilePath)  -- ^ Target file to load.+         -> m (Maybe TypecheckedModule, [TypecheckedModule])+         -- ^ Typechecked module and modules that had to+         -- be loaded for the target.+loadFileWithMessage msg file = do+  -- STEP 1: Load the file into the session, using collectASTs to also retrieve+  -- typechecked and parsed modules.+  (_, tcs) <- collectASTs $ (setTargetFilesWithMessage msg [file])+  Log.debugm $ "loaded " ++ fst file ++ " - " ++ snd file+  let get_fp = ml_hs_file . ms_location . pm_mod_summary . tm_parsed_module+  Log.debugm $ "Typechecked modules for: " ++ (unlines $ map (show . get_fp) tcs)+  -- Find the specific module in the list of returned typechecked modules if it exists.+  let findMod [] = Nothing+      findMod (x:xs) = case get_fp x of+                         Just fp -> if fp `isSuffixOf` (snd file) then Just x else findMod xs+                         Nothing -> findMod xs+  return (findMod tcs, tcs)++-- | Load a target into the GHC session with the default messager+--  which outputs updates in the same format as normal GHC.+--+-- The target is represented as a tuple. The tuple consists of the+-- original filename and another file that contains the actual+-- source code to compile.+--+-- If the message should configured, use 'loadFileWithMessage'.+--+-- If the loading succeeds, the typechecked module is returned+-- together with all the typechecked modules that had to be loaded+-- in order to typecheck the given target.+loadFile :: (GhcMonad m)+         => (FilePath, FilePath) -- ^ Target file to load.+         -> m (Maybe TypecheckedModule, [TypecheckedModule])+         -- ^ Typechecked module and modules that had to+         -- be loaded for the target.+loadFile = loadFileWithMessage (Just G.batchMsg)+++-- | Set the files as targets and load them. This will reset GHC's targets so only the modules you+-- set as targets and its dependencies will be loaded or reloaded.+-- Produced diagnostics will be printed similar to the normal output of GHC.+-- To configure this, use 'setTargetFilesWithMessage'.+setTargetFiles :: GhcMonad m => [(FilePath, FilePath)] -> m ()+setTargetFiles = setTargetFilesWithMessage (Just G.batchMsg)++msTargetIs :: ModSummary -> Target -> Bool+msTargetIs ms t = case targetId t of+  TargetModule m -> moduleName (ms_mod ms) == m+  TargetFile f _ -> ml_hs_file (ms_location ms) == Just f++-- | We bump the times for any ModSummary's that are Targets, to+-- fool the recompilation checker so that we can get the typechecked modules+updateTime :: MonadIO m => [Target] -> ModuleGraph -> m ModuleGraph+updateTime ts graph = liftIO $ do+  cur_time <- getCurrentTime+  let go ms+        | any (msTargetIs ms) ts = ms {ms_hs_date = cur_time}+        | otherwise = ms+  pure $ Gap.mapMG go graph++-- | Set the files as targets and load them. This will reset GHC's targets so only the modules you+-- set as targets and its dependencies will be loaded or reloaded.+setTargetFilesWithMessage :: (GhcMonad m)  => Maybe G.Messager -> [(FilePath, FilePath)] -> m ()+setTargetFilesWithMessage msg files = do+    targets <- forM files guessTargetMapped+    Log.debugm $ "setTargets: " ++ show files+    G.setTargets targets+    mod_graph <- updateTime targets =<< depanal [] False+    Log.debugm $ "modGraph: " ++ show (map ms_location $ Gap.mgModSummaries mod_graph)+    void $ G.load' LoadAllTargets msg mod_graph++-- | Add a hook to record the contents of any 'TypecheckedModule's which are produced+-- during compilation.+collectASTs :: (GhcMonad m) => m a -> m (a, [TypecheckedModule])+collectASTs action = do+  dflags0 <- getSessionDynFlags+  ref1 <- liftIO $ newIORef []+  let dflags1 = dflags0 { hooks = (hooks dflags0)+                          { hscFrontendHook = Just (astHook ref1) }+                        }+  -- Modify session is much faster than `setSessionDynFlags`.+  modifySession $ \h -> h{ hsc_dflags = dflags1 }+  res <- action+  tcs <- liftIO $ readIORef ref1+  -- Unset the hook so that we don't retain the reference ot the IORef so it can be gced.+  -- This stops the typechecked modules being retained in some cases.+  liftIO $ writeIORef ref1 []+  dflags_old <- getSessionDynFlags+  let dflags2 = dflags1 { hooks = (hooks dflags_old)+                          { hscFrontendHook = Nothing }+                        }+  modifySession $ \h -> h{ hsc_dflags = dflags2 }++  return (res, tcs)++-- | This hook overwrites the default frontend action of GHC.+astHook :: IORef [TypecheckedModule] -> ModSummary -> Hsc FrontendResult+astHook tc_ref ms = ghcInHsc $ do+  p <- G.parseModule =<< initializePluginsGhc ms+  tcm <- G.typecheckModule p+  let tcg_env = fst (tm_internals_ tcm)+  liftIO $ modifyIORef tc_ref (tcm :)+  return $ FrontendTypecheck tcg_env++initializePluginsGhc :: ModSummary -> Ghc ModSummary+initializePluginsGhc ms = do+  hsc_env <- getSession+  df <- liftIO $ Gap.initializePlugins hsc_env (ms_hspp_opts  ms)+  Log.debugm ("init-plugins(loaded):" ++ show (Gap.numLoadedPlugins df))+  Log.debugm ("init-plugins(specified):" ++ show (length $ pluginModNames df))+  return (ms { ms_hspp_opts = df })+++ghcInHsc :: Ghc a -> Hsc a+ghcInHsc gm = do+  hsc_session <- getHscEnv+  session <- liftIO $ newIORef hsc_session+  liftIO $ reflectGhc gm (Session session)++-- | A variant of 'guessTarget' which after guessing the target for a filepath, overwrites the+-- target file to be a temporary file.+guessTargetMapped :: (GhcMonad m) => (FilePath, FilePath) -> m Target+guessTargetMapped (orig_file_name, mapped_file_name) = do+  t <- G.guessTarget orig_file_name Nothing+  return (setTargetFilename mapped_file_name t)++setTargetFilename :: FilePath -> Target -> Target+setTargetFilename fn t =+  t { targetId = case targetId t of+                  TargetFile _ p -> TargetFile fn p+                  tid -> tid }
src/HIE/Bios/Ghc/Logger.hs view
@@ -1,118 +1,118 @@-{-# LANGUAGE BangPatterns #-}
-
-module HIE.Bios.Ghc.Logger (
-    withLogger
-  ) where
-
-import Bag (Bag, bagToList)
-import CoreMonad (liftIO)
-import DynFlags (LogAction, dopt, DumpFlag(Opt_D_dump_splices))
-import ErrUtils
-import Exception (ghandle)
-import FastString (unpackFS)
-import GHC (DynFlags(..), SrcSpan(..), Severity(SevError), GhcMonad)
-import qualified GHC as G
-import HscTypes (SourceError, srcErrorMessages)
-import Outputable (PprStyle, SDoc)
-
-import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
-import Data.Maybe (fromMaybe)
-import System.FilePath (normalise)
-
-import HIE.Bios.Ghc.Doc (showPage, getStyle)
-import HIE.Bios.Ghc.Api (withDynFlags)
-
-----------------------------------------------------------------
-
-type Builder = [String] -> [String]
-
-newtype LogRef = LogRef (IORef Builder)
-
-newLogRef :: IO LogRef
-newLogRef = LogRef <$> newIORef id
-
-readAndClearLogRef :: LogRef -> IO String
-readAndClearLogRef (LogRef ref) = do
-    b <- readIORef ref
-    writeIORef ref id
-    return $! unlines (b [])
-
-appendLogRef :: DynFlags -> LogRef -> LogAction
-appendLogRef df (LogRef ref) _ _ sev src style msg = do
-        let !l = ppMsg src sev df style msg
-        modifyIORef ref (\b -> b . (l:))
-
-----------------------------------------------------------------
-
--- | Set the session flag (e.g. "-Wall" or "-w:") then
---   executes a body. Log messages are returned as 'String'.
---   Right is success and Left is failure.
-withLogger ::
-  (GhcMonad m)
-  => (DynFlags -> DynFlags) -> m () -> m (Either String String)
-withLogger setDF body = ghandle sourceError $ do
-    logref <- liftIO newLogRef
-    withDynFlags (setLogger logref . setDF) $ do
-      body
-      liftIO $ Right <$> readAndClearLogRef logref
-  where
-    setLogger logref df = df { log_action =  appendLogRef df logref }
-
-----------------------------------------------------------------
-
--- | Converting 'SourceError' to 'String'.
-sourceError ::
-  (GhcMonad m)
-  => SourceError -> m (Either String String)
-sourceError err = do
-    dflag <- G.getSessionDynFlags
-    style <- getStyle dflag
-    let ret = unlines . errBagToStrList dflag style . srcErrorMessages $ err
-    return (Left ret)
-
-errBagToStrList :: DynFlags -> PprStyle -> Bag ErrMsg -> [String]
-errBagToStrList dflag style = map (ppErrMsg dflag style) . reverse . bagToList
-
-----------------------------------------------------------------
-
-ppErrMsg :: DynFlags -> PprStyle -> ErrMsg -> String
-ppErrMsg dflag style err = ppMsg spn SevError dflag style msg -- ++ ext
-   where
-     spn = errMsgSpan err
-     msg = pprLocErrMsg err
-     -- fixme
---     ext = showPage dflag style (pprLocErrMsg $ errMsgReason err)
-
-ppMsg :: SrcSpan -> Severity-> DynFlags -> PprStyle -> SDoc -> String
-ppMsg spn sev dflag style msg = prefix ++ cts
-  where
-    cts  = showPage dflag style msg
-    defaultPrefix
-      | isDumpSplices dflag = ""
-      | otherwise           = checkErrorPrefix
-    prefix = fromMaybe defaultPrefix $ do
-        (line,col,_,_) <- getSrcSpan spn
-        file <- normalise <$> getSrcFile spn
-        let severityCaption = showSeverityCaption sev
-        return $ file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ severityCaption
-
-checkErrorPrefix :: String
-checkErrorPrefix = "Dummy:0:0:Error:"
-
-showSeverityCaption :: Severity -> String
-showSeverityCaption SevWarning = "Warning: "
-showSeverityCaption _          = ""
-
-getSrcFile :: SrcSpan -> Maybe String
-getSrcFile (G.RealSrcSpan spn) = Just . unpackFS . G.srcSpanFile $ spn
-getSrcFile _                   = Nothing
-
-isDumpSplices :: DynFlags -> Bool
-isDumpSplices dflag = dopt Opt_D_dump_splices dflag
-
-getSrcSpan :: SrcSpan -> Maybe (Int,Int,Int,Int)
-getSrcSpan (RealSrcSpan spn) = Just ( G.srcSpanStartLine spn
-                                    , G.srcSpanStartCol spn
-                                    , G.srcSpanEndLine spn
-                                    , G.srcSpanEndCol spn)
-getSrcSpan _ = Nothing
+{-# LANGUAGE BangPatterns #-}++module HIE.Bios.Ghc.Logger (+    withLogger+  ) where++import Bag (Bag, bagToList)+import CoreMonad (liftIO)+import DynFlags (LogAction, dopt, DumpFlag(Opt_D_dump_splices))+import ErrUtils+import Exception (ghandle)+import FastString (unpackFS)+import GHC (DynFlags(..), SrcSpan(..), Severity(SevError), GhcMonad)+import qualified GHC as G+import HscTypes (SourceError, srcErrorMessages)+import Outputable (PprStyle, SDoc)++import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)+import Data.Maybe (fromMaybe)+import System.FilePath (normalise)++import HIE.Bios.Ghc.Doc (showPage, getStyle)+import HIE.Bios.Ghc.Api (withDynFlags)++----------------------------------------------------------------++type Builder = [String] -> [String]++newtype LogRef = LogRef (IORef Builder)++newLogRef :: IO LogRef+newLogRef = LogRef <$> newIORef id++readAndClearLogRef :: LogRef -> IO String+readAndClearLogRef (LogRef ref) = do+    b <- readIORef ref+    writeIORef ref id+    return $! unlines (b [])++appendLogRef :: DynFlags -> LogRef -> LogAction+appendLogRef df (LogRef ref) _ _ sev src style msg = do+        let !l = ppMsg src sev df style msg+        modifyIORef ref (\b -> b . (l:))++----------------------------------------------------------------++-- | Set the session flag (e.g. "-Wall" or "-w:") then+--   executes a body. Log messages are returned as 'String'.+--   Right is success and Left is failure.+withLogger ::+  (GhcMonad m)+  => (DynFlags -> DynFlags) -> m () -> m (Either String String)+withLogger setDF body = ghandle sourceError $ do+    logref <- liftIO newLogRef+    withDynFlags (setLogger logref . setDF) $ do+      body+      liftIO $ Right <$> readAndClearLogRef logref+  where+    setLogger logref df = df { log_action =  appendLogRef df logref }++----------------------------------------------------------------++-- | Converting 'SourceError' to 'String'.+sourceError ::+  (GhcMonad m)+  => SourceError -> m (Either String String)+sourceError err = do+    dflag <- G.getSessionDynFlags+    style <- getStyle dflag+    let ret = unlines . errBagToStrList dflag style . srcErrorMessages $ err+    return (Left ret)++errBagToStrList :: DynFlags -> PprStyle -> Bag ErrMsg -> [String]+errBagToStrList dflag style = map (ppErrMsg dflag style) . reverse . bagToList++----------------------------------------------------------------++ppErrMsg :: DynFlags -> PprStyle -> ErrMsg -> String+ppErrMsg dflag style err = ppMsg spn SevError dflag style msg -- ++ ext+   where+     spn = errMsgSpan err+     msg = pprLocErrMsg err+     -- fixme+--     ext = showPage dflag style (pprLocErrMsg $ errMsgReason err)++ppMsg :: SrcSpan -> Severity-> DynFlags -> PprStyle -> SDoc -> String+ppMsg spn sev dflag style msg = prefix ++ cts+  where+    cts  = showPage dflag style msg+    defaultPrefix+      | isDumpSplices dflag = ""+      | otherwise           = checkErrorPrefix+    prefix = fromMaybe defaultPrefix $ do+        (line,col,_,_) <- getSrcSpan spn+        file <- normalise <$> getSrcFile spn+        let severityCaption = showSeverityCaption sev+        return $ file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ severityCaption++checkErrorPrefix :: String+checkErrorPrefix = "Dummy:0:0:Error:"++showSeverityCaption :: Severity -> String+showSeverityCaption SevWarning = "Warning: "+showSeverityCaption _          = ""++getSrcFile :: SrcSpan -> Maybe String+getSrcFile (G.RealSrcSpan spn) = Just . unpackFS . G.srcSpanFile $ spn+getSrcFile _                   = Nothing++isDumpSplices :: DynFlags -> Bool+isDumpSplices dflag = dopt Opt_D_dump_splices dflag++getSrcSpan :: SrcSpan -> Maybe (Int,Int,Int,Int)+getSrcSpan (RealSrcSpan spn) = Just ( G.srcSpanStartLine spn+                                    , G.srcSpanStartCol spn+                                    , G.srcSpanEndLine spn+                                    , G.srcSpanEndCol spn)+getSrcSpan _ = Nothing
src/HIE/Bios/Internal/Log.hs view
@@ -1,16 +1,16 @@-module HIE.Bios.Internal.Log where
-
-import Control.Monad.IO.Class
-import System.Log.Logger
-
-logm :: MonadIO m => String -> m ()
-logm s = liftIO $ infoM "hie-bios" s
-
-debugm :: MonadIO m => String -> m ()
-debugm s = liftIO $ debugM "hie-bios" s
-
-warningm :: MonadIO m => String -> m ()
-warningm s = liftIO $ warningM "hie-bios" s
-
-errorm :: MonadIO m => String -> m ()
-errorm s = liftIO $ errorM "hie-bios" s
+module HIE.Bios.Internal.Log where++import Control.Monad.IO.Class+import System.Log.Logger++logm :: MonadIO m => String -> m ()+logm s = liftIO $ infoM "hie-bios" s++debugm :: MonadIO m => String -> m ()+debugm s = liftIO $ debugM "hie-bios" s++warningm :: MonadIO m => String -> m ()+warningm s = liftIO $ warningM "hie-bios" s++errorm :: MonadIO m => String -> m ()+errorm s = liftIO $ errorM "hie-bios" s
src/HIE/Bios/Wrappers.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-module HIE.Bios.Wrappers (cabalWrapper, cabalWrapperHs) where
-
-import Data.FileEmbed
-
-cabalWrapper :: String
-cabalWrapper = $(embedStringFile "wrappers/cabal")
-
-cabalWrapperHs :: String
-cabalWrapperHs = $(embedStringFile "wrappers/cabal.hs")
-
+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+module HIE.Bios.Wrappers (cabalWrapper, cabalWrapperHs) where++import Data.FileEmbed++cabalWrapper :: String+cabalWrapper = $(embedStringFile "wrappers/cabal")++cabalWrapperHs :: String+cabalWrapperHs = $(embedStringFile "wrappers/cabal.hs")+
tests/ParserTests.hs view
@@ -1,105 +1,105 @@-{-# LANGUAGE OverloadedStrings #-}
-module Main where
-
-import Test.Tasty
-import Test.Tasty.HUnit
-import HIE.Bios.Config
-import qualified Data.HashMap.Strict as Map
-import Data.Void
-import Data.Yaml
-import qualified Data.Text as T
-import System.FilePath
-import Control.Applicative ( (<|>) )
-
-configDir :: FilePath
-configDir = "tests/configs"
-
-main :: IO ()
-main = defaultMain $
-  testCase "Parser Tests" $ do
-    assertParser "cabal-1.yaml" (noDeps (Cabal (Just "lib:hie-bios")))
-    assertParser "stack-config.yaml" (noDeps (Stack Nothing))
-    --assertParser "bazel.yaml" (noDeps Bazel)
-    assertParser "bios-1.yaml" (noDeps (Bios "program" Nothing))
-    assertParser "bios-2.yaml" (noDeps (Bios "program" (Just "dep-program")))
-    assertParser "dependencies.yaml" (Config (CradleConfig ["depFile"] (Cabal (Just "lib:hie-bios"))))
-    assertParser "direct.yaml" (noDeps (Direct ["list", "of", "arguments"]))
-    assertParser "none.yaml" (noDeps None)
-    --assertParser "obelisk.yaml" (noDeps Obelisk)
-    assertParser "multi.yaml" (noDeps (Multi [("./src", CradleConfig [] (Cabal (Just "lib:hie-bios")))
-                                             , ("./test", CradleConfig [] (Cabal (Just "test")) ) ]))
-
-    assertParser "cabal-multi.yaml" (noDeps (CabalMulti [("./src", "lib:hie-bios")
-                                                    ,("./", "lib:hie-bios")]))
-
-    assertParser "stack-multi.yaml" (noDeps (StackMulti [("./src", "lib:hie-bios")
-                                                    ,("./", "lib:hie-bios")]))
-
-    assertParser "nested-cabal-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None)
-                                                          ,("./", CradleConfig [] (
-                                                                    CabalMulti [("./src", "lib:hie-bios")
-                                                                               ,("./tests", "parser-tests")]))]))
-
-    assertParser "nested-stack-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None)
-                                                          ,("./", CradleConfig [] (
-                                                                    StackMulti [("./src", "lib:hie-bios")
-                                                                              ,("./tests", "parser-tests")]))]))
-
-    assertCustomParser "ch-cabal.yaml"
-      (noDeps (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal"))
-    assertCustomParser "ch-stack.yaml"
-      (noDeps (Other CabalHelperStack $ simpleCabalHelperYaml "stack"))
-    assertCustomParser "multi-ch.yaml"
-      (noDeps (Multi
-        [ ("./src", CradleConfig [] (Other CabalHelperStack $ simpleCabalHelperYaml "stack"))
-        , ("./input", CradleConfig [] (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal"))
-        , ("./test", CradleConfig [] (Cabal (Just "test")))
-        , (".", CradleConfig [] None)
-        ]))
-
-assertParser :: FilePath -> Config Void -> Assertion
-assertParser fp cc = do
-  conf <- readConfig (configDir </> fp)
-  (conf == cc) @? (unlines [("Parser Failed: " ++ fp)
-                           , "Expected: " ++ show cc
-                           , "Actual: " ++ show conf ])
-
-assertCustomParser :: FilePath -> Config CabalHelper -> Assertion
-assertCustomParser fp cc = do
-  conf <- readConfig (configDir </> fp)
-  (conf == cc) @? (unlines [("Parser Failed: " ++ fp)
-                          , "Expected: " ++ show cc
-                          , "Actual: " ++ show conf ])
-
-noDeps :: CradleType a -> Config a
-noDeps c = Config (CradleConfig [] c)
-
--- ------------------------------------------------------------------
-
-data CabalHelper
-  = CabalHelperCabal
-  | CabalHelperStack
-  deriving (Show, Eq)
-
-instance FromJSON CabalHelper where
-  parseJSON (Object o)
-    | Just obj <- Map.lookup "cabal-helper" o = chCabal obj <|> chStack obj
-    where
-      chCabal (Object val)
-        | Just _val <- Map.lookup "cabal" val = return CabalHelperCabal
-      chCabal _ = fail "CH: not a cabal cradle."
-
-      chStack (Object val)
-        | Just _val <- Map.lookup "stack" val = return CabalHelperStack
-      chStack _ = fail "CH: not a stack cradle."
-
-  parseJSON _ = fail "Not a valid cabal-helper specification"
-
-simpleCabalHelperYaml :: T.Text -> Value
-simpleCabalHelperYaml tool =
-  object
-    [ ( "cabal-helper", object
-        [ (tool, Null)
-        ]
-      )
-    ]
+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Test.Tasty+import Test.Tasty.HUnit+import HIE.Bios.Config+import qualified Data.HashMap.Strict as Map+import Data.Void+import Data.Yaml+import qualified Data.Text as T+import System.FilePath+import Control.Applicative ( (<|>) )++configDir :: FilePath+configDir = "tests/configs"++main :: IO ()+main = defaultMain $+  testCase "Parser Tests" $ do+    assertParser "cabal-1.yaml" (noDeps (Cabal (Just "lib:hie-bios")))+    assertParser "stack-config.yaml" (noDeps (Stack Nothing))+    --assertParser "bazel.yaml" (noDeps Bazel)+    assertParser "bios-1.yaml" (noDeps (Bios "program" Nothing))+    assertParser "bios-2.yaml" (noDeps (Bios "program" (Just "dep-program")))+    assertParser "dependencies.yaml" (Config (CradleConfig ["depFile"] (Cabal (Just "lib:hie-bios"))))+    assertParser "direct.yaml" (noDeps (Direct ["list", "of", "arguments"]))+    assertParser "none.yaml" (noDeps None)+    --assertParser "obelisk.yaml" (noDeps Obelisk)+    assertParser "multi.yaml" (noDeps (Multi [("./src", CradleConfig [] (Cabal (Just "lib:hie-bios")))+                                             , ("./test", CradleConfig [] (Cabal (Just "test")) ) ]))++    assertParser "cabal-multi.yaml" (noDeps (CabalMulti [("./src", "lib:hie-bios")+                                                    ,("./", "lib:hie-bios")]))++    assertParser "stack-multi.yaml" (noDeps (StackMulti [("./src", "lib:hie-bios")+                                                    ,("./", "lib:hie-bios")]))++    assertParser "nested-cabal-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None)+                                                          ,("./", CradleConfig [] (+                                                                    CabalMulti [("./src", "lib:hie-bios")+                                                                               ,("./tests", "parser-tests")]))]))++    assertParser "nested-stack-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None)+                                                          ,("./", CradleConfig [] (+                                                                    StackMulti [("./src", "lib:hie-bios")+                                                                              ,("./tests", "parser-tests")]))]))++    assertCustomParser "ch-cabal.yaml"+      (noDeps (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal"))+    assertCustomParser "ch-stack.yaml"+      (noDeps (Other CabalHelperStack $ simpleCabalHelperYaml "stack"))+    assertCustomParser "multi-ch.yaml"+      (noDeps (Multi+        [ ("./src", CradleConfig [] (Other CabalHelperStack $ simpleCabalHelperYaml "stack"))+        , ("./input", CradleConfig [] (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal"))+        , ("./test", CradleConfig [] (Cabal (Just "test")))+        , (".", CradleConfig [] None)+        ]))++assertParser :: FilePath -> Config Void -> Assertion+assertParser fp cc = do+  conf <- readConfig (configDir </> fp)+  (conf == cc) @? (unlines [("Parser Failed: " ++ fp)+                           , "Expected: " ++ show cc+                           , "Actual: " ++ show conf ])++assertCustomParser :: FilePath -> Config CabalHelper -> Assertion+assertCustomParser fp cc = do+  conf <- readConfig (configDir </> fp)+  (conf == cc) @? (unlines [("Parser Failed: " ++ fp)+                          , "Expected: " ++ show cc+                          , "Actual: " ++ show conf ])++noDeps :: CradleType a -> Config a+noDeps c = Config (CradleConfig [] c)++-- ------------------------------------------------------------------++data CabalHelper+  = CabalHelperCabal+  | CabalHelperStack+  deriving (Show, Eq)++instance FromJSON CabalHelper where+  parseJSON (Object o)+    | Just obj <- Map.lookup "cabal-helper" o = chCabal obj <|> chStack obj+    where+      chCabal (Object val)+        | Just _val <- Map.lookup "cabal" val = return CabalHelperCabal+      chCabal _ = fail "CH: not a cabal cradle."++      chStack (Object val)+        | Just _val <- Map.lookup "stack" val = return CabalHelperStack+      chStack _ = fail "CH: not a stack cradle."++  parseJSON _ = fail "Not a valid cabal-helper specification"++simpleCabalHelperYaml :: T.Text -> Value+simpleCabalHelperYaml tool =+  object+    [ ( "cabal-helper", object+        [ (tool, Null)+        ]+      )+    ]
tests/configs/bazel.yaml view
@@ -1,2 +1,2 @@-cradle:
-  { bazel: }
+cradle:+  { bazel: }
tests/configs/bios-1.yaml view
@@ -1,3 +1,3 @@-cradle:
-  bios:
-    program: "program"
+cradle:+  bios:+    program: "program"
tests/configs/bios-2.yaml view
@@ -1,4 +1,4 @@-cradle:
-  bios:
-    program: "program"
-    dependency-program: "dep-program"
+cradle:+  bios:+    program: "program"+    dependency-program: "dep-program"
tests/configs/cabal-1.yaml view
@@ -1,2 +1,2 @@-cradle:
-  { cabal: {component: "lib:hie-bios"} }
+cradle:+  { cabal: {component: "lib:hie-bios"} }
tests/configs/cabal-multi.yaml view
@@ -1,6 +1,6 @@-cradle:
-  cabal:
-    - path: "./src"
-      component: "lib:hie-bios"
-    - path: "./"
-      component: "lib:hie-bios"
+cradle:+  cabal:+    - path: "./src"+      component: "lib:hie-bios"+    - path: "./"+      component: "lib:hie-bios"
tests/configs/ch-cabal.yaml view
@@ -1,4 +1,4 @@-cradle:
-  other:
-    cabal-helper:
+cradle:+  other:+    cabal-helper:       cabal:
tests/configs/ch-stack.yaml view
@@ -1,4 +1,4 @@-cradle:
-  other:
-    cabal-helper:
+cradle:+  other:+    cabal-helper:       stack:
tests/configs/default.yaml view
@@ -1,2 +1,2 @@-cradle:
-  default:
+cradle:+  default:
tests/configs/dependencies.yaml view
@@ -1,5 +1,5 @@-cradle:
-  { cabal: {component: "lib:hie-bios"} }
-
-dependencies:
-  - "depFile"
+cradle:+  { cabal: {component: "lib:hie-bios"} }++dependencies:+  - "depFile"
tests/configs/direct.yaml view
@@ -1,3 +1,3 @@-cradle:
-  direct:
-    arguments: ["list", "of", "arguments"]
+cradle:+  direct:+    arguments: ["list", "of", "arguments"]
tests/configs/multi-ch.yaml view
@@ -1,10 +1,10 @@-cradle:
-  multi:
-    - path: "./src"
-      config: { cradle: {other: {cabal-helper: {stack: } } } }
-    - path: "./input"
-      config: { cradle: {other: {cabal-helper: {cabal: } } } }
-    - path: "./test"
-      config: { cradle: {cabal: {component: "test"}} }
-    - path: "."
-      config: { cradle: { none: } }
+cradle:+  multi:+    - path: "./src"+      config: { cradle: {other: {cabal-helper: {stack: } } } }+    - path: "./input"+      config: { cradle: {other: {cabal-helper: {cabal: } } } }+    - path: "./test"+      config: { cradle: {cabal: {component: "test"}} }+    - path: "."+      config: { cradle: { none: } }
tests/configs/multi.yaml view
@@ -1,6 +1,6 @@-cradle:
-  multi:
-    - path: "./src"
-      config: { cradle: {cabal: {component: "lib:hie-bios"}} }
-    - path: "./test"
-      config: { cradle: {cabal: {component: "test"}} }
+cradle:+  multi:+    - path: "./src"+      config: { cradle: {cabal: {component: "lib:hie-bios"}} }+    - path: "./test"+      config: { cradle: {cabal: {component: "test"}} }
tests/configs/nested-cabal-multi.yaml view
@@ -1,8 +1,8 @@-cradle:
-  multi:
-    - path: "./test/testdata"
-      config: { cradle: { none:  } }
-    - path: "./"
-      config: { cradle: { cabal:
-                            [ { path: "./src", component: "lib:hie-bios" }
-                            , { path: "./tests", component: "parser-tests" } ] } }
+cradle:+  multi:+    - path: "./test/testdata"+      config: { cradle: { none:  } }+    - path: "./"+      config: { cradle: { cabal:+                            [ { path: "./src", component: "lib:hie-bios" }+                            , { path: "./tests", component: "parser-tests" } ] } }
tests/configs/nested-stack-multi.yaml view
@@ -1,8 +1,8 @@-cradle:
-  multi:
-    - path: "./test/testdata"
-      config: { cradle: { none:  } }
-    - path: "./"
-      config: { cradle: { stack:
-                            [ { path: "./src", component: "lib:hie-bios" }
-                            , { path: "./tests", component: "parser-tests" } ] } }
+cradle:+  multi:+    - path: "./test/testdata"+      config: { cradle: { none:  } }+    - path: "./"+      config: { cradle: { stack:+                            [ { path: "./src", component: "lib:hie-bios" }+                            , { path: "./tests", component: "parser-tests" } ] } }
tests/configs/none.yaml view
@@ -1,2 +1,2 @@-cradle:
-  none:
+cradle:+  none:
tests/configs/obelisk.yaml view
@@ -1,2 +1,2 @@-cradle:
-  { obelisk: }
+cradle:+  { obelisk: }
tests/configs/stack-config.yaml view
@@ -1,2 +1,2 @@-cradle:
-  { stack: {}}
+cradle:+  { stack: {}}
tests/configs/stack-multi.yaml view
@@ -1,6 +1,6 @@-cradle:
-  stack:
-    - path: "./src"
-      component: "lib:hie-bios"
-    - path: "./"
-      component: "lib:hie-bios"
+cradle:+  stack:+    - path: "./src"+      component: "lib:hie-bios"+    - path: "./"+      component: "lib:hie-bios"
tests/projects/implicit-cabal/Main.hs view
@@ -1,4 +1,4 @@-module Main where
-
-main :: IO ()
-main = putStrLn "Hello, Haskell!"
+module Main where++main :: IO ()+main = putStrLn "Hello, Haskell!"
tests/projects/implicit-cabal/Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
tests/projects/implicit-cabal/cabal.project view
@@ -1,1 +1,1 @@-packages: .
+packages: .
tests/projects/implicit-cabal/implicit-cabal.cabal view
@@ -1,25 +1,25 @@-cabal-version:       >=1.10
--- Initial package description 'implicit-cabal.cabal' generated by 'cabal
--- init'.  For further documentation, see
--- http://haskell.org/cabal/users-guide/
-
-name:                implicit-cabal
-version:             0.1.0.0
--- synopsis:
--- description:
--- bug-reports:
--- license:
-license-file:        LICENSE
-author:              Luke Lau
-maintainer:          luke_lau@icloud.com
--- copyright:
--- category:
-build-type:          Simple
-
-executable implicit-cabal
-  main-is:             Main.hs
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base == 4.*
-  -- hs-source-dirs:
-  default-language:    Haskell2010
+cabal-version:       >=1.10+-- Initial package description 'implicit-cabal.cabal' generated by 'cabal+-- init'.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                implicit-cabal+version:             0.1.0.0+-- synopsis:+-- description:+-- bug-reports:+-- license:+license-file:        LICENSE+author:              Luke Lau+maintainer:          luke_lau@icloud.com+-- copyright:+-- category:+build-type:          Simple++executable implicit-cabal+  main-is:             Main.hs+  -- other-modules:+  -- other-extensions:+  build-depends:       base == 4.*+  -- hs-source-dirs:+  default-language:    Haskell2010
tests/projects/implicit-stack-multi/Main.hs view
@@ -1,4 +1,4 @@-module Main where
-
-main :: IO ()
-main = putStrLn "Hello, Haskell!"
+module Main where++main :: IO ()+main = putStrLn "Hello, Haskell!"
tests/projects/implicit-stack-multi/Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
tests/projects/implicit-stack-multi/implicit-stack-multi.cabal view
@@ -1,25 +1,25 @@-cabal-version:       >=1.10
--- Initial package description 'implicit-stack-multi.cabal' generated by
--- 'cabal init'.  For further documentation, see
--- http://haskell.org/cabal/users-guide/
-
-name:                implicit-stack-multi
-version:             0.1.0.0
--- synopsis:
--- description:
--- bug-reports:
--- license:
-license-file:        LICENSE
-author:              Luke Lau
-maintainer:          luke_lau@icloud.com
--- copyright:
--- category:
-build-type:          Simple
-
-executable implicit-stack-multi
-  main-is:             Main.hs
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base == 4.*
-  -- hs-source-dirs:
-  default-language:    Haskell2010
+cabal-version:       >=1.10+-- Initial package description 'implicit-stack-multi.cabal' generated by+-- 'cabal init'.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                implicit-stack-multi+version:             0.1.0.0+-- synopsis:+-- description:+-- bug-reports:+-- license:+license-file:        LICENSE+author:              Luke Lau+maintainer:          luke_lau@icloud.com+-- copyright:+-- category:+build-type:          Simple++executable implicit-stack-multi+  main-is:             Main.hs+  -- other-modules:+  -- other-extensions:+  build-depends:       base == 4.*+  -- hs-source-dirs:+  default-language:    Haskell2010
tests/projects/implicit-stack-multi/other-package/Main.hs view
@@ -1,4 +1,4 @@-module Main where
-
-main :: IO ()
-main = putStrLn "Hello, Haskell!"
+module Main where++main :: IO ()+main = putStrLn "Hello, Haskell!"
tests/projects/implicit-stack-multi/other-package/Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
tests/projects/implicit-stack-multi/other-package/other-package.cabal view
@@ -1,26 +1,26 @@-cabal-version:       >=1.10
--- Initial package description 'other-package.cabal' generated by 'cabal
--- init'.  For further documentation, see
--- http://haskell.org/cabal/users-guide/
-
-name:                other-package
-version:             0.1.0.0
--- synopsis:
--- description:
--- bug-reports:
--- license:
-license-file:        LICENSE
-author:              Luke Lau
-maintainer:          luke_lau@icloud.com
--- copyright:
--- category:
-build-type:          Simple
-extra-source-files:  CHANGELOG.md
-
-executable other-package
-  main-is:             Main.hs
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base == 4.*
-  -- hs-source-dirs:
-  default-language:    Haskell2010
+cabal-version:       >=1.10+-- Initial package description 'other-package.cabal' generated by 'cabal+-- init'.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                other-package+version:             0.1.0.0+-- synopsis:+-- description:+-- bug-reports:+-- license:+license-file:        LICENSE+author:              Luke Lau+maintainer:          luke_lau@icloud.com+-- copyright:+-- category:+build-type:          Simple+extra-source-files:  CHANGELOG.md++executable other-package+  main-is:             Main.hs+  -- other-modules:+  -- other-extensions:+  build-depends:       base == 4.*+  -- hs-source-dirs:+  default-language:    Haskell2010
tests/projects/implicit-stack/Main.hs view
@@ -1,4 +1,4 @@-module Main where
-
-main :: IO ()
-main = putStrLn "Hello, Haskell!"
+module Main where++main :: IO ()+main = putStrLn "Hello, Haskell!"
tests/projects/implicit-stack/Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
tests/projects/implicit-stack/implicit-stack.cabal view
@@ -1,25 +1,25 @@-cabal-version:       >=1.10
--- Initial package description 'implicit-stack.cabal' generated by 'cabal
--- init'.  For further documentation, see
--- http://haskell.org/cabal/users-guide/
-
-name:                implicit-stack
-version:             0.1.0.0
--- synopsis:
--- description:
--- bug-reports:
--- license:
-license-file:        LICENSE
-author:              Luke Lau
-maintainer:          luke_lau@icloud.com
--- copyright:
--- category:
-build-type:          Simple
-
-executable implicit-stack
-  main-is:             Main.hs
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base == 4.*
-  -- hs-source-dirs:
-  default-language:    Haskell2010
+cabal-version:       >=1.10+-- Initial package description 'implicit-stack.cabal' generated by 'cabal+-- init'.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                implicit-stack+version:             0.1.0.0+-- synopsis:+-- description:+-- bug-reports:+-- license:+license-file:        LICENSE+author:              Luke Lau+maintainer:          luke_lau@icloud.com+-- copyright:+-- category:+build-type:          Simple++executable implicit-stack+  main-is:             Main.hs+  -- other-modules:+  -- other-extensions:+  build-depends:       base == 4.*+  -- hs-source-dirs:+  default-language:    Haskell2010
tests/projects/multi-cabal/Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
tests/projects/multi-cabal/app/Main.hs view
@@ -1,4 +1,4 @@-
-import System.Directory (getCurrentDirectory)
-
++import System.Directory (getCurrentDirectory)+ main = return ()
tests/projects/multi-cabal/cabal.project view
@@ -1,1 +1,1 @@-packages: ./
+packages: ./
tests/projects/multi-cabal/hie.yaml view
@@ -1,7 +1,7 @@-cradle:
-  cabal:
-      - path: ./src
-        component: "lib:multi-cabal"
-
-      - path: ./app
+cradle:+  cabal:+      - path: ./src+        component: "lib:multi-cabal"++      - path: ./app         component: "exe:multi-cabal"
tests/projects/multi-cabal/multi-cabal.cabal view
@@ -1,23 +1,23 @@-cabal-version:       >=2.0
-name:                multi-cabal
-version:             0.1.0.0
-build-type:          Simple
-
-library
-  exposed-modules: Lib
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base >=4.10 && < 5, filepath
-  hs-source-dirs:      src
-  default-language:    Haskell2010
-  ghc-options:         +RTS -A1m -N -RTS -Wall
-
-
-
-executable multi-cabal
-  main-is:              app/Main.hs
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base >=4.10 && < 5, directory
-  -- hs-source-dirs:
-  default-language:    Haskell2010
+cabal-version:       >=2.0+name:                multi-cabal+version:             0.1.0.0+build-type:          Simple++library+  exposed-modules: Lib+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.10 && < 5, filepath+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         +RTS -A1m -N -RTS -Wall++++executable multi-cabal+  main-is:              app/Main.hs+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.10 && < 5, directory+  -- hs-source-dirs:+  default-language:    Haskell2010
tests/projects/multi-cabal/src/Lib.hs view
@@ -1,5 +1,5 @@-module Lib where
-
-import System.FilePath ((</>))
-
+module Lib where++import System.FilePath ((</>))+ foo = "test" </> "me"
tests/projects/multi-direct/B.hs view
@@ -1,3 +1,3 @@-module B where
-
-import A
+module B where++import A
tests/projects/multi-direct/hie.yaml view
@@ -1,12 +1,12 @@-cradle:
-  multi:
-    - path: "A.hs"
-      config:
-        cradle:
-          direct:
-            arguments: ["-Walaaal", "A", "B"]
-    - path: "B.hs"
-      config:
-        cradle:
-          direct:
-            arguments: ["-Walaaal", "A", "B"]
+cradle:+  multi:+    - path: "A.hs"+      config:+        cradle:+          direct:+            arguments: ["-Walaaal", "A", "B"]+    - path: "B.hs"+      config:+        cradle:+          direct:+            arguments: ["-Walaaal", "A", "B"]
tests/projects/multi-stack/Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
tests/projects/multi-stack/app/Main.hs view
@@ -1,4 +1,4 @@-
-import System.Directory (getCurrentDirectory)
-
++import System.Directory (getCurrentDirectory)+ main = return ()
tests/projects/multi-stack/cabal.project view
@@ -1,1 +1,1 @@-packages: ./
+packages: ./
tests/projects/multi-stack/hie.yaml view
@@ -1,7 +1,7 @@-cradle:
-  stack:
-      - path: ./src
-        component: "multi-stack:lib"
-
-      - path: ./app
+cradle:+  stack:+      - path: ./src+        component: "multi-stack:lib"++      - path: ./app         component: "multi-stack:exe:multi-stack"
tests/projects/multi-stack/multi-stack.cabal view
@@ -1,23 +1,23 @@-cabal-version:       >=2.0
-name:                multi-stack
-version:             0.1.0.0
-build-type:          Simple
-
-library
-  exposed-modules: Lib
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base >=4.10 && < 5, filepath
-  hs-source-dirs:      src
-  default-language:    Haskell2010
-
-
-
-executable multi-stack
-  main-is:              app/Main.hs
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base >=4.10 && < 5, directory
-  -- hs-source-dirs:
-  default-language:    Haskell2010
+cabal-version:       >=2.0+name:                multi-stack+version:             0.1.0.0+build-type:          Simple++library+  exposed-modules: Lib+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.10 && < 5, filepath+  hs-source-dirs:      src+  default-language:    Haskell2010++++executable multi-stack+  main-is:              app/Main.hs+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.10 && < 5, directory+  -- hs-source-dirs:+  default-language:    Haskell2010   ghc-options:         +RTS -A1m -N -RTS -Wall
tests/projects/multi-stack/src/Lib.hs view
@@ -1,5 +1,5 @@-module Lib where
-
-import System.FilePath ((</>))
-
+module Lib where++import System.FilePath ((</>))+ foo = "test" </> "me"
tests/projects/simple-bios/B.hs view
@@ -1,3 +1,3 @@-module B where
-
-import A
+module B where++import A
tests/projects/simple-bios/hie-bios.sh view
@@ -1,3 +1,3 @@-echo "-Wall" >> $HIE_BIOS_OUTPUT
-echo "A" >> $HIE_BIOS_OUTPUT
-echo "B" >> $HIE_BIOS_OUTPUT
+echo "-Wall" >> $HIE_BIOS_OUTPUT+echo "A" >> $HIE_BIOS_OUTPUT+echo "B" >> $HIE_BIOS_OUTPUT
tests/projects/simple-bios/hie.yaml view
@@ -1,2 +1,2 @@-cradle:
-  bios: {program: ./hie-bios.sh }
+cradle:+  bios: {program: ./hie-bios.sh }
tests/projects/simple-cabal/A.hs view
@@ -1,1 +1,1 @@-module A where
+module A where
tests/projects/simple-cabal/B.hs view
@@ -1,3 +1,3 @@-module B where
-
-import A
+module B where++import A
tests/projects/simple-cabal/CHANGELOG.md view
@@ -1,5 +1,5 @@-# Revision history for simple-cabal
-
-## 0.1.0.0 -- YYYY-mm-dd
-
-* First version. Released on an unsuspecting world.
+# Revision history for simple-cabal++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
tests/projects/simple-cabal/Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
tests/projects/simple-cabal/cabal.project view
@@ -1,1 +1,1 @@-packages: .
+packages: .
tests/projects/simple-cabal/hie.yaml view
@@ -1,2 +1,2 @@-cradle:
-  cabal: {component: "lib:simple-cabal"}
+cradle:+  cabal: {component: "lib:simple-cabal"}
tests/projects/simple-cabal/simple-cabal.cabal view
@@ -1,23 +1,23 @@-cabal-version:       >=2.0
-name:                simple-cabal
-version:             0.1.0.0
--- synopsis:
--- description:
--- bug-reports:
--- license:
-license-file:        LICENSE
-author:              Matthew Pickering
-maintainer:          matthewtpickering@gmail.com
--- copyright:
--- category:
-build-type:          Simple
-extra-source-files:  CHANGELOG.md
-
-library
-  exposed-modules: A B
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base >=4.10 && < 5
-  ghc-options:         +RTS -A1m -N -RTS -Wall
-  -- hs-source-dirs:
-  default-language:    Haskell2010
+cabal-version:       >=2.0+name:                simple-cabal+version:             0.1.0.0+-- synopsis:+-- description:+-- bug-reports:+-- license:+license-file:        LICENSE+author:              Matthew Pickering+maintainer:          matthewtpickering@gmail.com+-- copyright:+-- category:+build-type:          Simple+extra-source-files:  CHANGELOG.md++library+  exposed-modules: A B+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.10 && < 5+  ghc-options:         +RTS -A1m -N -RTS -Wall+  -- hs-source-dirs:+  default-language:    Haskell2010
tests/projects/simple-direct/B.hs view
@@ -1,3 +1,3 @@-module B where
-
-import A
+module B where++import A
tests/projects/simple-direct/hie.yaml view
@@ -1,2 +1,2 @@-cradle:
-  direct: {arguments: ["-Walaaal", "A", "B"] }
+cradle:+  direct: {arguments: ["-Walaaal", "A", "B"] }
tests/projects/simple-stack/A.hs view
@@ -1,1 +1,1 @@-module A where
+module A where
tests/projects/simple-stack/B.hs view
@@ -1,3 +1,3 @@-module B where
-
-import A
+module B where++import A
tests/projects/simple-stack/CHANGELOG.md view
@@ -1,5 +1,5 @@-# Revision history for simple-cabal
-
-## 0.1.0.0 -- YYYY-mm-dd
-
-* First version. Released on an unsuspecting world.
+# Revision history for simple-cabal++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
tests/projects/simple-stack/Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
tests/projects/simple-stack/cabal.project view
@@ -1,1 +1,1 @@-packages: .
+packages: .
tests/projects/simple-stack/hie.yaml view
@@ -1,3 +1,3 @@-cradle:
-  stack:
-    component: "simple-stack:lib"
+cradle:+  stack:+    component: "simple-stack:lib"
tests/projects/simple-stack/simple-stack.cabal view
@@ -1,23 +1,23 @@-cabal-version:       >=2.0
-name:                simple-stack
-version:             0.1.0.0
--- synopsis:
--- description:
--- bug-reports:
--- license:
-license-file:        LICENSE
-author:              Matthew Pickering
-maintainer:          matthewtpickering@gmail.com
--- copyright:
--- category:
-build-type:          Simple
-extra-source-files:  CHANGELOG.md
-
-library
-  exposed-modules: A B
-  -- other-modules:
-  -- other-extensions:
-  build-depends:       base >=4.10 && < 5
-  ghc-options:         -Wall +RTS -A1m -N -RTS
-  -- hs-source-dirs:
-  default-language:    Haskell2010
+cabal-version:       >=2.0+name:                simple-stack+version:             0.1.0.0+-- synopsis:+-- description:+-- bug-reports:+-- license:+license-file:        LICENSE+author:              Matthew Pickering+maintainer:          matthewtpickering@gmail.com+-- copyright:+-- category:+build-type:          Simple+extra-source-files:  CHANGELOG.md++library+  exposed-modules: A B+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.10 && < 5+  ghc-options:         -Wall +RTS -A1m -N -RTS+  -- hs-source-dirs:+  default-language:    Haskell2010
wrappers/cabal view
@@ -1,11 +1,11 @@ #!/usr/bin/env bash  function out(){-  echo "$1" >> $HIE_BIOS_OUTPUT+  echo "$1" >> "$HIE_BIOS_OUTPUT" }  if [ "$1" == "--interactive" ]; then-  out $(pwd)+  out "$(pwd)"   for arg in "$@"; do     out "$arg"   done
wrappers/cabal.hs view
@@ -1,11 +1,12 @@ module Main (main) where  import System.Directory (getCurrentDirectory)-import System.Environment (getArgs, getEnv, lookupEnv)+import System.Environment (getArgs, getEnv) import System.Exit (exitWith) import System.Process (spawnProcess, waitForProcess) import System.IO (openFile, hClose, hPutStrLn, IOMode(..)) +main :: IO () main = do   args <- getArgs   output_file <- getEnv "HIE_BIOS_OUTPUT"