packages feed

hie-bios 0.4.0 → 0.5.0

raw patch · 93 files changed

+1469/−1327 lines, 93 filesdep ~ghcsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc

API changes (from Hackage documentation)

+ HIE.Bios: [componentRoot] :: ComponentOptions -> FilePath
+ HIE.Bios.Environment: makeDynFlagsAbsolute :: FilePath -> DynFlags -> DynFlags
+ HIE.Bios.Flags: getCompilerOptionsWithLogger :: LoggingFunction -> FilePath -> Cradle a -> IO (CradleLoadResult ComponentOptions)
+ HIE.Bios.Flags: type LoggingFunction = String -> IO ()
+ HIE.Bios.Ghc.Gap: mapOverIncludePaths :: (FilePath -> FilePath) -> DynFlags -> DynFlags
+ HIE.Bios.Types: [componentRoot] :: ComponentOptions -> FilePath
- HIE.Bios: ComponentOptions :: [String] -> [FilePath] -> ComponentOptions
+ HIE.Bios: ComponentOptions :: [String] -> FilePath -> [FilePath] -> ComponentOptions
- HIE.Bios.Types: ComponentOptions :: [String] -> [FilePath] -> ComponentOptions
+ HIE.Bios.Types: ComponentOptions :: [String] -> FilePath -> [FilePath] -> ComponentOptions

Files

ChangeLog view
@@ -1,3 +1,21 @@+2020-05-08 - 0.5.0++	* Add cabal.project.local to cabal cradle dependencies [#184](https://github.com/mpickering/hie-bios/pull/184)+	* Remove unused environment variables to simplify code. [#182](https://github.com/mpickering/hie-bios/pull/182)+	* Clean up hie-bios wrapper scripts after they are used. [#179](https://github.com/mpickering/hie-bios/pull/179)+	* Avoid error in windows due to temp file being locked. [#175](https://github.com/mpickering/hie-bios/pull/175)+	* Get building with ghc-8.10. [#173](https://github.com/mpickering/hie-bios/pull/173)+	* Add getCompilerOptionsWithLogger convenience function.+	* Add componentRoot to ComponentOptions. [#166](https://github.com/mpickering/hie-bios/pull/166)+		Options may be relative to the componentRoot.+	* Add makeDynFlagsAbsolute to fix mangling of ghc options starting with "-i". [#166](https://github.com/mpickering/hie-bios/pull/166)+		Breaks backwards-compatibility, because ComponentOptions now may contain+		filepaths relative to the component root directory.+		This function needs to be invoked on the parsed 'DynFlags' to normalise the filepaths.+	* Fix Ghci Script parses space in Filepath as Module (#162)+	* Correct path to .hie-bios example in readme (#159)+	* Relax upper bound for 'extra' (#161)+ 2020-01-29 - 0.4.0  	* Return CompilerOptions in initialization (#130)
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.
README.md view
@@ -285,7 +285,7 @@ should work for any file in your project.  ```-ghci $(./hie-bios /path/to/foo.hs | tr '\n' ' ') /path/to/foo.hs+ghci $(./.hie-bios /path/to/foo.hs | tr '\n' ' ') /path/to/foo.hs ```  This is useful if you are designing a new build system or the other modes
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple
+main = defaultMain
exe/Main.hs view
@@ -86,6 +86,7 @@                                                 ++ "\": " ++ show err                     CradleSuccess opts ->                       return $ unlines ["Options: " ++ show (componentOptions opts)+                                       ,"ComponentDir: " ++ (componentRoot opts)                                        ,"Dependencies: " ++ show (componentDependencies opts) ]                     CradleNone -> return "No flags: this component should not be loaded"         return (unlines res)
hie-bios.cabal view
@@ -1,6 +1,6 @@ Cabal-Version:          2.2 Name:                   hie-bios-Version:                0.4.0+Version:                0.5.0 Author:                 Matthew Pickering <matthewtpickering@gmail.com> Maintainer:             Matthew Pickering <matthewtpickering@gmail.com> License:                BSD-3-Clause@@ -70,6 +70,11 @@                         tests/projects/simple-stack/cabal.project                         tests/projects/simple-stack/hie.yaml                         tests/projects/simple-stack/simple-stack.cabal+                        "tests/projects/space stack/A.hs"+                        "tests/projects/space stack/B.hs"+                        "tests/projects/space stack/Setup.hs"+                        "tests/projects/space stack/hie.yaml"+                        "tests/projects/space stack/stackproj.cabal"                         tests/projects/implicit-cabal/Setup.hs                         tests/projects/implicit-cabal/cabal.project                         tests/projects/implicit-cabal/implicit-cabal.cabal@@ -85,7 +90,7 @@                         tests/projects/implicit-stack-multi/other-package/Main.hs  -tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.4+tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4  Library   Default-Language:     Haskell2010@@ -119,9 +124,9 @@                         directory            >= 1.3.0 && < 1.4,                         filepath             >= 1.4.1 && < 1.5,                         time                 >= 1.8.0 && < 1.10,-                        extra                >= 1.6.14 && < 1.7,+                        extra                >= 1.6.14 && < 1.8,                         process              >= 1.6.1 && < 1.7,-                        ghc                  >= 8.4.1 && < 8.9,+                        ghc                  >= 8.4.1 && < 8.11,                         transformers         >= 0.5.2 && < 0.6,                         temporary            >= 1.2 && < 1.4,                         text                 >= 1.2.3 && < 1.3,
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
@@ -115,7 +115,7 @@     addActionDeps :: CradleAction a -> CradleAction a     addActionDeps ca =       ca { runCradle = \l fp ->-            (fmap (\(ComponentOptions os' ds) -> ComponentOptions os' (ds `union` deps)))+            (fmap (\(ComponentOptions os' dir ds) -> ComponentOptions os' dir (ds `union` deps)))               <$> runCradle ca l fp }  implicitConfig :: FilePath -> MaybeT IO (CradleConfig a, FilePath)@@ -200,7 +200,7 @@     { cradleRootDir = cur_dir     , cradleOptsProg = CradleAction         { actionName = Types.Default-        , runCradle = \_ _ -> return (CradleSuccess (ComponentOptions [] []))+        , runCradle = \_ _ -> return (CradleSuccess (ComponentOptions [] cur_dir []))         }     } @@ -298,7 +298,7 @@     { cradleRootDir = wdir     , cradleOptsProg = CradleAction         { actionName = Types.Direct-        , runCradle = \_ _ -> return (CradleSuccess (ComponentOptions args []))+        , runCradle = \_ _ -> return (CradleSuccess (ComponentOptions args wdir []))         }     } @@ -323,7 +323,7 @@ biosDepsAction :: LoggingFunction -> FilePath -> Maybe FilePath -> IO [FilePath] biosDepsAction l wdir (Just biosDepsProg) = do   biosDeps' <- canonicalizePath biosDepsProg-  (ex, sout, serr, args) <- readProcessWithOutputFile l Nothing wdir biosDeps' []+  (ex, sout, serr, args) <- readProcessWithOutputFile l wdir biosDeps' []   case ex of     ExitFailure _ ->  error $ show (ex, sout, serr)     ExitSuccess -> return args@@ -337,13 +337,13 @@            -> IO (CradleLoadResult ComponentOptions) biosAction wdir bios bios_deps l fp = do   bios' <- canonicalizePath bios-  (ex, _stdo, std, res) <- readProcessWithOutputFile l Nothing wdir bios' [fp]+  (ex, _stdo, std, res) <- readProcessWithOutputFile l wdir bios' [fp]   deps <- biosDepsAction l wdir bios_deps         -- Output from the program should be written to the output file and         -- delimited by newlines.         -- Execute the bios action and add dependencies of the cradle.         -- Removes all duplicates.-  return $ makeCradleResult (ex, std, res) deps+  return $ makeCradleResult (ex, std, wdir, res) deps  ------------------------------------------------------------------------ -- Cabal Cradle@@ -362,7 +362,7 @@ cabalCradleDependencies :: FilePath -> IO [FilePath] cabalCradleDependencies rootDir = do     cabalFiles <- findCabalFiles rootDir-    return $ cabalFiles ++ ["cabal.project"]+    return $ cabalFiles ++ ["cabal.project", "cabal.project.local"]  findCabalFiles :: FilePath -> IO [FilePath] findCabalFiles wdir = do@@ -370,7 +370,7 @@   return $ filter ((== ".cabal") . takeExtension) dirContent  -processCabalWrapperArgs :: [String] -> Maybe [String]+processCabalWrapperArgs :: [String] -> Maybe (FilePath, [String]) processCabalWrapperArgs args =     case args of         (dir: ghc_args) ->@@ -378,9 +378,8 @@                     removeVerbosityOpts                     $ removeRTS                     $ removeInteractive-                    $ map (fixImportDirs dir)                     $ ghc_args-            in Just final_args+            in Just (dir, final_args)         _ -> Nothing  -- | GHC process information.@@ -391,45 +390,50 @@ -- generate a fake GHC that can be passed to cabal -- when run with --interactive, it will print out its -- command-line arguments and exit-getCabalWrapperTool :: GhcProc -> FilePath -> IO FilePath-getCabalWrapperTool (ghcPath, ghcArgs) wdir = do-  wrapper_fp <--    if isWindows-      then do-        cacheDir <- getCacheDir ""-        let srcHash = show (fingerprintString cabalWrapperHs)-        let wrapper_name = "wrapper-" ++ srcHash-        let wrapper_fp = cacheDir </> wrapper_name <.> "exe"-        exists <- doesFileExist wrapper_fp-        unless exists $ withSystemTempDirectory "hie-bios" $ \ tmpDir -> do-            createDirectoryIfMissing True cacheDir-            let wrapper_hs = cacheDir </> wrapper_name <.> "hs"-            writeFile wrapper_hs cabalWrapperHs-            let ghc = (proc ghcPath $-                        ghcArgs ++ ["-rtsopts=ignore", "-outputdir", tmpDir, "-o", wrapper_fp, wrapper_hs])-                        { cwd = Just wdir }-            readCreateProcess ghc "" >>= putStr-        return wrapper_fp-      else writeSystemTempFile "bios-wrapper" cabalWrapper+withCabalWrapperTool :: GhcProc -> FilePath -> (FilePath -> IO a) -> IO a+withCabalWrapperTool (ghcPath, ghcArgs) wdir k = do+  if isWindows+    then do+      cacheDir <- getCacheDir ""+      let srcHash = show (fingerprintString cabalWrapperHs)+      let wrapper_name = "wrapper-" ++ srcHash+      let wrapper_fp = cacheDir </> wrapper_name <.> "exe"+      exists <- doesFileExist wrapper_fp+      unless exists $ withSystemTempDirectory "hie-bios" $ \ tmpDir -> do+          createDirectoryIfMissing True cacheDir+          let wrapper_hs = cacheDir </> wrapper_name <.> "hs"+          writeFile wrapper_hs cabalWrapperHs+          let ghc = (proc ghcPath $+                      ghcArgs ++ ["-rtsopts=ignore", "-outputdir", tmpDir, "-o", wrapper_fp, wrapper_hs])+                      { cwd = Just wdir }+          readCreateProcess ghc "" >>= putStr+      setMode wrapper_fp+      k wrapper_fp+    else withSystemTempFile "bios-wrapper"+            (\loc h -> do+                        hPutStr h cabalWrapper+                        hClose h+                        setMode loc+                        k loc) -  setFileMode wrapper_fp accessModes-  _check <- readFile wrapper_fp-  return wrapper_fp+  where+    setMode wrapper_fp = setFileMode wrapper_fp accessModes + cabalAction :: FilePath -> Maybe String -> LoggingFunction -> FilePath -> IO (CradleLoadResult ComponentOptions) cabalAction work_dir mc l fp = do-  wrapper_fp <- getCabalWrapperTool ("ghc", []) work_dir-  let cab_args = ["v2-repl", "--with-compiler", wrapper_fp, fromMaybe (fixTargetPath fp) mc]-  (ex, output, stde, args) <--    readProcessWithOutputFile l Nothing work_dir "cabal" cab_args-  deps <- cabalCradleDependencies work_dir-  case processCabalWrapperArgs args of-      Nothing -> pure $ CradleFail (CradleError ex-                  ["Failed to parse result of calling cabal"-                   , unlines output-                   , unlines stde-                   , unlines args])-      Just final_args -> pure $ makeCradleResult (ex, stde, final_args) deps+  withCabalWrapperTool ("ghc", []) work_dir $ \wrapper_fp -> do+    let cab_args = ["v2-repl", "--with-compiler", wrapper_fp, fromMaybe (fixTargetPath fp) mc]+    (ex, output, stde, args) <-+      readProcessWithOutputFile l work_dir "cabal" cab_args+    deps <- cabalCradleDependencies work_dir+    case processCabalWrapperArgs args of+        Nothing -> pure $ CradleFail (CradleError ex+                    ["Failed to parse result of calling cabal"+                     , unlines output+                     , unlines stde+                     , unlines args])+        Just (componentDir, final_args) -> pure $ makeCradleResult (ex, stde, componentDir, final_args) deps   where     -- Need to make relative on Windows, due to a Cabal bug with how it     -- parses file targets with a C: drive in it@@ -452,15 +456,7 @@ removeVerbosityOpts :: [String] -> [String] removeVerbosityOpts = filter ((&&) <$> (/= "-v0") <*> (/= "-w")) -fixImportDirs :: FilePath -> String -> String-fixImportDirs base_dir arg =-  if "-i" `isPrefixOf` arg-    then let dir = drop 2 arg-         in if not (null dir) && isRelative dir then "-i" ++ base_dir </> dir-                              else arg-    else arg - cabalWorkDir :: FilePath -> MaybeT IO FilePath cabalWorkDir = findFileUpwards isCabal   where@@ -489,25 +485,24 @@ stackAction work_dir mc l _fp = do   let ghcProcArgs = ("stack", ["exec", "ghc", "--"])   -- Same wrapper works as with cabal-  wrapper_fp <- getCabalWrapperTool ghcProcArgs work_dir--  (ex1, _stdo, stde, args) <--    readProcessWithOutputFile l Nothing work_dir-            "stack" $ ["repl", "--no-nix-pure", "--with-ghc", wrapper_fp]-                      ++ [ comp | Just comp <- [mc] ]-  (ex2, pkg_args, stdr, _) <--    readProcessWithOutputFile l Nothing work_dir "stack" ["path", "--ghc-package-path"]-  let split_pkgs = concatMap splitSearchPath pkg_args-      pkg_ghc_args = concatMap (\p -> ["-package-db", p] ) split_pkgs-  deps <- stackCradleDependencies work_dir-  return $ case processCabalWrapperArgs args of-      Nothing -> CradleFail (CradleError ex1 $-                  ("Failed to parse result of calling stack":-                    stde)-                   ++ args)+  withCabalWrapperTool ghcProcArgs work_dir $ \wrapper_fp -> do+    (ex1, _stdo, stde, args) <-+      readProcessWithOutputFile l work_dir+              "stack" $ ["repl", "--no-nix-pure", "--with-ghc", wrapper_fp]+                        ++ [ comp | Just comp <- [mc] ]+    (ex2, pkg_args, stdr, _) <-+      readProcessWithOutputFile l work_dir "stack" ["path", "--ghc-package-path"]+    let split_pkgs = concatMap splitSearchPath pkg_args+        pkg_ghc_args = concatMap (\p -> ["-package-db", p] ) split_pkgs+    deps <- stackCradleDependencies work_dir+    return $ case processCabalWrapperArgs args of+        Nothing -> CradleFail (CradleError ex1 $+                    ("Failed to parse result of calling stack":+                      stde)+                     ++ args) -      Just ghc_args ->-        makeCradleResult (combineExitCodes [ex1, ex2], stde ++ stdr, ghc_args ++ pkg_ghc_args) deps+        Just (componentDir, ghc_args) ->+          makeCradleResult (combineExitCodes [ex1, ex2], stde ++ stdr, componentDir, ghc_args ++ pkg_ghc_args) deps  combineExitCodes :: [ExitCode] -> ExitCode combineExitCodes = foldr go ExitSuccess@@ -639,48 +634,49 @@ --   Additionally, arguments to ghc are supplied via @HIE_BIOS_GHC_ARGS@ readProcessWithOutputFile   :: LoggingFunction -- ^ Output of the process is streamed into this function.-  -> Maybe GhcProc -- ^ Optional FilePath to GHC and arguments that should-                   -- be passed to ghc.-                   -- In the process to call, filepath and arguments   -> FilePath -- ^ Working directory. Process is executed in this directory.   -> FilePath -- ^ Process to call.   -> [String] -- ^ Arguments to the process.   -> IO (ExitCode, [String], [String], [String])-readProcessWithOutputFile l ghcProc work_dir fp args =-  withSystemTempFile "bios-output" $ \output_file h -> do-    hSetBuffering h LineBuffering-    old_env <- getEnvironment-    let (ghcPath, ghcArgs) = case ghcProc of-            Just (p, a) -> (p, unwords a)-            Nothing ->-              ( fromMaybe "ghc" (lookup hieBiosGhc old_env)-              , fromMaybe "" (lookup hieBiosGhcArgs old_env)-              )+readProcessWithOutputFile l work_dir fp args = do+  old_env <- getEnvironment++  withHieBiosOutput old_env $ \output_file -> do     -- Pipe stdout directly into the logger     let process = (readProcessInDirectory work_dir fp args)                       { env = Just-                              $ (hieBiosGhc, ghcPath)-                              : (hieBiosGhcArgs, ghcArgs)-                              : ("HIE_BIOS_OUTPUT", output_file)+                              $ (hieBiosOutput, output_file)                               : old_env                       }-        -- Windows line endings are not converted so you have to filter out `'r` characters-        loggingConduit = (C.decodeUtf8  C..| C.lines C..| C.filterE (/= '\r')  C..| C.map T.unpack C..| C.iterM l C..| C.sinkList)++    -- Windows line endings are not converted so you have to filter out `'r` characters+    let  loggingConduit = (C.decodeUtf8  C..| C.lines C..| C.filterE (/= '\r')  C..| C.map T.unpack C..| C.iterM l C..| C.sinkList)     (ex, stdo, stde) <- sourceProcessWithStreams process mempty loggingConduit loggingConduit-    !res <- force <$> hGetContents h+    res <- withFile output_file ReadMode $ \handle -> do+             hSetBuffering handle LineBuffering+             !res <- force <$> hGetContents handle+             return res+     return (ex, stdo, stde, lines (filter (/= '\r') res))      where-      hieBiosGhc = "HIE_BIOS_GHC"-      hieBiosGhcArgs = "HIE_BIOS_GHC_ARGS"+      withHieBiosOutput :: [(String,String)] -> (FilePath -> IO a) -> IO a+      withHieBiosOutput env action = do+        let mbHieBiosOut = lookup hieBiosOutput env+        case mbHieBiosOut of+          Just file@(_:_) -> action file+          _ -> withSystemTempFile "hie-bios" $+                 \ file h -> hClose h >> action file +      hieBiosOutput = "HIE_BIOS_OUTPUT"+ readProcessInDirectory :: FilePath -> FilePath -> [String] -> CreateProcess readProcessInDirectory wdir p args = (proc p args) { cwd = Just wdir } -makeCradleResult :: (ExitCode, [String], [String]) -> [FilePath] -> CradleLoadResult ComponentOptions-makeCradleResult (ex, err, gopts) deps =+makeCradleResult :: (ExitCode, [String], FilePath, [String]) -> [FilePath] -> CradleLoadResult ComponentOptions+makeCradleResult (ex, err, componentDir, gopts) deps =   case ex of     ExitFailure _ -> CradleFail (CradleError ex err)     _ ->-        let compOpts = ComponentOptions gopts deps+        let compOpts = ComponentOptions gopts componentDir deps         in CradleSuccess compOpts
src/HIE/Bios/Environment.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE RecordWildCards, CPP #-}-module HIE.Bios.Environment (initSession, getSystemLibDir, getCacheDir, addCmdOpts) where+module HIE.Bios.Environment (initSession, getSystemLibDir, makeDynFlagsAbsolute, getCacheDir, addCmdOpts) where  import CoreMonad (liftIO) import GHC (DynFlags(..), GhcLink(..), HscTarget(..), GhcMonad)@@ -19,7 +19,9 @@ import qualified Data.ByteString.Char8 as B import Data.ByteString.Base16 import Data.List-+import Data.Char (isSpace)+import Control.Applicative ((<|>))+import Text.ParserCombinators.ReadP import HIE.Bios.Types import HIE.Bios.Ghc.Gap @@ -37,12 +39,13 @@     cache_dir <- liftIO $ getCacheDir opts_hash     -- Add the user specified options to a fresh GHC session.     (df', targets) <- addCmdOpts componentOptions df+    let df'' = makeDynFlagsAbsolute componentRoot df'     void $ G.setSessionDynFlags         (disableOptimisation -- Compile with -O0 as we are not going to produce object files.         $ setIgnoreInterfacePragmas            -- Ignore any non-essential information in interface files such as unfoldings changing.         $ writeInterfaceFiles (Just cache_dir) -- Write interface files to the cache         $ setVerbosity 0                       -- Set verbosity to zero just in case the user specified `-vx` in the options.-        $ setLinkerOptions df'                 -- Set `-fno-code` to avoid generating object files, unless we have to.+        $ setLinkerOptions df''                 -- Set `-fno-code` to avoid generating object files, unless we have to.         )     -- Unset the default log action to avoid output going to stdout.     unsetLogAction@@ -78,7 +81,7 @@ -}  -- | 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` +-- 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 fp = do@@ -121,7 +124,6 @@            => [String] -> DynFlags -> m (DynFlags, [G.Target]) addCmdOpts cmdOpts df1 = do   (df2, leftovers', _warns) <- G.parseDynamicFlags df1 (map G.noLoc cmdOpts)-   -- parse targets from ghci-scripts. Only extract targets that have been ":add"'ed.   additionalTargets <- concat <$> mapM (liftIO . getTargetsFromGhciScript) (ghciScripts df2) @@ -165,6 +167,19 @@        liftIO $ hPutStrLn stderr "cannot set package flags with :seti; use :set"     -} +-- | Make filepaths in the given 'DynFlags' absolute.+-- This makes the 'DynFlags' independent of the current working directory.+makeDynFlagsAbsolute :: FilePath -> DynFlags -> DynFlags+makeDynFlagsAbsolute work_dir df =+  mapOverIncludePaths (prependIfNotAbsolute work_dir)+  $ df+    { importPaths = map (prependIfNotAbsolute work_dir) (importPaths df)+    }+  where+    prependIfNotAbsolute wdir f+      | isAbsolute f = f+      | otherwise = wdir </> f+ -- partition_args, along with some of the other code in this file, -- was copied from ghc/Main.hs -- -----------------------------------------------------------------------------@@ -223,7 +238,42 @@ getTargetsFromGhciScript :: FilePath -> IO [String] getTargetsFromGhciScript script = do   contents <- lines <$> readFile script-  return-    $ concatMap (tail {- first element is ":add" which we want to remove -}-                      . words)-    $ filter (":add" `isPrefixOf`) contents+  let parseGhciLine = concatMap fst . filter (null . snd) . readP_to_S parser+  return $ concatMap parseGhciLine 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 = do+  _ <- string ":add" <* space1+  scriptword `sepBy` space1++space1 :: ReadP [Char]+space1 = many1 (char ' ')++scriptword :: ReadP String+scriptword = quoted <++ value++-- | A balanced double-quoted string+quoted :: ReadP String+quoted = do+    _ <- char '"'+    manyTill (escaped '"' <|> anyToken) $ char '"'++escaped :: Char -> ReadP Char+escaped c = c <$ string ("\\" <> [c])++value :: ReadP String+value = many1 (satisfy (not . isSpace))++anyToken :: ReadP Char+anyToken = satisfy $ const True
src/HIE/Bios/Flags.hs view
@@ -1,17 +1,25 @@-module HIE.Bios.Flags (getCompilerOptions) 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 fp cradle =-  runCradle (cradleOptsProg cradle) logm 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/Gap.hs view
@@ -8,6 +8,7 @@   , getTyThing   , fixInfo   , getModSummaries+  , mapOverIncludePaths   , LExpression   , LBinding   , LPattern@@ -20,7 +21,7 @@   , unsetLogAction   ) where -import DynFlags (DynFlags)+import DynFlags (DynFlags, includePaths) import GHC(LHsBind, LHsExpr, LPat, Type, ModSummary, ModuleGraph, HscEnv, setLogAction, GhcMonad) import Outputable (PrintUnqualified, PprStyle, Depth(AllTheWay), mkUserStyle) @@ -42,6 +43,10 @@ import GHC (mgModSummaries, mapMG) #endif +#if __GLASGOW_HASKELL__ >= 806+import DynFlags (IncludeSpecs(..))+#endif+ #if __GLASGOW_HASKELL__ >= 810 import GHC.Hs.Extension (GhcTc) import GHC.Hs.Expr (MatchGroup, MatchGroupTc(..), mg_ext)@@ -89,6 +94,20 @@ fixInfo :: (a, b, c, d, e) -> (a, b, c, d) fixInfo (t,f,cs,fs,_) = (t,f,cs,fs) #endif++----------------------------------------------------------------++mapOverIncludePaths :: (FilePath -> FilePath) -> DynFlags -> DynFlags+mapOverIncludePaths f df = df+  { includePaths = +#if __GLASGOW_HASKELL__ > 804+      IncludeSpecs+          (map f $ includePathsQuote  (includePaths df))+          (map f $ includePathsGlobal (includePaths df))+#else+      map f (includePaths df)+#endif+  }  ----------------------------------------------------------------
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/Debug.hs view
@@ -35,10 +35,11 @@     conf <- findConfig canonFp     crdl <- findCradle' canonFp     case res of-      CradleSuccess (ComponentOptions gopts deps) -> do+      CradleSuccess (ComponentOptions gopts croot deps) -> do         mglibdir <- liftIO getSystemLibDir         return [             "Root directory:      " ++ rootDir+          , "Component directory: " ++ croot           , "GHC options:         " ++ unwords (map quoteIfNeeded gopts)           , "System libraries:    " ++ fromMaybe "" mglibdir           , "Config Location:     " ++ conf
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/Types.hs view
@@ -81,6 +81,9 @@ -- | Option information for GHC data ComponentOptions = ComponentOptions {     componentOptions  :: [String]  -- ^ Command line options.+  , componentRoot :: FilePath +  -- ^ Root directory of the component. All 'componentOptions' are either +  -- absolute, or relative to this directory.   , componentDependencies :: [FilePath]   -- ^ Dependencies of a cradle that might change the cradle.   -- Contains both files specified in hie.yaml as well as
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/BiosTests.hs view
@@ -40,7 +40,6 @@         $ linuxExlusiveTestCases         ++            [ testCaseSteps "simple-cabal" $ testDirectory isCabalCradle "./tests/projects/simple-cabal/B.hs"-           , testCaseSteps "simple-stack" $ testDirectory isStackCradle "./tests/projects/simple-stack/B.hs"            , testCaseSteps "simple-direct" $ testDirectory isDirectCradle "./tests/projects/simple-direct/B.hs"            , testCaseSteps "multi-direct" {- tests if both components can be loaded -}                          $  testDirectory isMultiCradle "./tests/projects/multi-direct/A.hs"@@ -48,16 +47,30 @@            , testCaseSteps "multi-cabal" {- tests if both components can be loaded -}                          $  testDirectory isCabalCradle "./tests/projects/multi-cabal/app/Main.hs"                          >> testDirectory isCabalCradle "./tests/projects/multi-cabal/src/Lib.hs"-           , testCaseSteps "multi-stack" {- tests if both components can be loaded -}-                         $  testDirectory isStackCradle "./tests/projects/multi-stack/app/Main.hs"-                         >> testDirectory isStackCradle "./tests/projects/multi-stack/src/Lib.hs"            ]+-- TODO: Remove once there's a stackage snapshot for ghc 8.10+#if __GLASGOW_HASKELL__ < 810+       ++ [ testCaseSteps "simple-stack" $ testDirectory isStackCradle "./tests/projects/simple-stack/B.hs"+          , testCaseSteps "multi-stack" {- tests if both components can be loaded -}+                        $  testDirectory isStackCradle "./tests/projects/multi-stack/app/Main.hs"+                        >> testDirectory isStackCradle "./tests/projects/multi-stack/src/Lib.hs"+          ,+          -- Test for special characters in the path for parsing of the ghci-scripts.+          -- Issue https://github.com/mpickering/hie-bios/issues/162+          testCaseSteps "space stack"+                        $  testDirectory isStackCradle "./tests/projects/space stack/A.hs"+                        >> testDirectory isStackCradle "./tests/projects/space stack/B.hs"+          ]+#endif       , testGroup "Implicit cradle tests" $         [ testCaseSteps "implicit-cabal" $ testImplicitCradle "./tests/projects/implicit-cabal/Main.hs" Cabal+-- TODO: Remove once there's a stackage snapshot for ghc 8.10+#if __GLASGOW_HASKELL__ < 810         , testCaseSteps "implicit-stack" $ testImplicitCradle "./tests/projects/implicit-stack/Main.hs" Stack         , testCaseSteps "implicit-stack-multi"             $ testImplicitCradle "./tests/projects/implicit-stack-multi/Main.hs" Stack             >> testImplicitCradle "./tests/projects/implicit-stack-multi/other-package/Main.hs" Stack+#endif         ]       ] @@ -129,6 +142,7 @@ stackProjects =   [ "tests" </> "projects" </> "multi-stack"   , "tests" </> "projects" </> "simple-stack"+  , "tests" </> "projects" </> "space stack"   , "tests" </> "projects" </> "implicit-stack"   , "tests" </> "projects" </> "implicit-stack-multi"   ]@@ -138,8 +152,10 @@  stackYamlResolver :: String stackYamlResolver =-#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)))-  "nightly-2019-12-13"+#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,10,1,0)))+  "TODO"+#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)))+  "lts-15.10" #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,5,0)))   "lts-14.17" #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,4,0)))
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
+ tests/projects/space stack/A.hs view
@@ -0,0 +1,4 @@+module A where++main :: IO ()+main = return ()
+ tests/projects/space stack/B.hs view
@@ -0,0 +1,3 @@+module B where++import A
+ tests/projects/space stack/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ tests/projects/space stack/hie.yaml view
@@ -0,0 +1,3 @@+cradle:+  stack:+    component: "stackproj:exe:exe"
+ tests/projects/space stack/stackproj.cabal view
@@ -0,0 +1,15 @@+cabal-version:       >=2.0+name:                stackproj+version:             0.1.0.0+author:              Matthew Pickering+maintainer:          matthewtpickering@gmail.com+build-type:          Simple++executable exe+  other-modules: B+  main-is: A.hs+  -- other-extensions:+  build-depends:       base >=4.10 && < 5+  ghc-options:         -Wall +RTS -A1m -N -RTS+  -- hs-source-dirs:+  default-language:    Haskell2010
wrappers/cabal view
@@ -10,5 +10,5 @@     out "$arg"   done else-  "${HIE_BIOS_GHC}" ${HIE_BIOS_GHC_ARGS} "$@"+  "ghc" "$@" fi
wrappers/cabal.hs view
@@ -9,8 +9,6 @@ main = do   args <- getArgs   output_file <- getEnv "HIE_BIOS_OUTPUT"-  ghcPath <- getEnv "HIE_BIOS_GHC"-  ghcPathArgs <- fmap (maybe [] words) (lookupEnv "HIE_BIOS_GHC_ARGS")   case args of     "--interactive":_ -> do       h <- openFile output_file AppendMode@@ -18,6 +16,6 @@       mapM_ (hPutStrLn h) args       hClose h     _ -> do-      ph <- spawnProcess ghcPath (ghcPathArgs ++ args)+      ph <- spawnProcess "ghc" (args)       code <- waitForProcess ph       exitWith code