diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2020-06-26 - 0.5.1 + + * Fix printing of current directory in wrapper script [#206](https://github.com/mpickering/hie-bios/pull/206) + * Export Cradle utilizes [#189](https://github.com/mpickering/hie-bios/pull/189) + 2020-05-08 - 0.5.0 * Add cabal.project.local to cabal cradle dependencies [#184](https://github.com/mpickering/hie-bios/pull/184) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/hie-bios.cabal b/hie-bios.cabal --- a/hie-bios.cabal +++ b/hie-bios.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: hie-bios -Version: 0.5.0 +Version: 0.5.1 Author: Matthew Pickering Maintainer: Matthew Pickering License: BSD-3-Clause diff --git a/src/HIE/Bios.hs b/src/HIE/Bios.hs --- a/src/HIE/Bios.hs +++ b/src/HIE/Bios.hs @@ -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 diff --git a/src/HIE/Bios/Config.hs b/src/HIE/Bios/Config.hs --- a/src/HIE/Bios/Config.hs +++ b/src/HIE/Bios/Config.hs @@ -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 diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -15,6 +15,9 @@ , isMultiCradle , isDefaultCradle , isOtherCradle + , getCradle + , readProcessWithOutputFile + , makeCradleResult ) where import Control.Exception (handleJust) diff --git a/src/HIE/Bios/Flags.hs b/src/HIE/Bios/Flags.hs --- a/src/HIE/Bios/Flags.hs +++ b/src/HIE/Bios/Flags.hs @@ -1,25 +1,25 @@ -module HIE.Bios.Flags (getCompilerOptions, getCompilerOptionsWithLogger, LoggingFunction) where - -import HIE.Bios.Types -import HIE.Bios.Internal.Log - - --- | Initialize the 'DynFlags' relating to the compilation of a single --- file or GHC session according to the provided 'Cradle'. -getCompilerOptions :: - FilePath -- The file we are loading it because of - -> Cradle a - -> IO (CradleLoadResult ComponentOptions) -getCompilerOptions = - getCompilerOptionsWithLogger logm - -getCompilerOptionsWithLogger :: - LoggingFunction - -> FilePath - -> Cradle a - -> IO (CradleLoadResult ComponentOptions) -getCompilerOptionsWithLogger l fp cradle = - runCradle (cradleOptsProg cradle) l fp - - ----------------------------------------------------------------- +module HIE.Bios.Flags (getCompilerOptions, getCompilerOptionsWithLogger, LoggingFunction) where + +import HIE.Bios.Types +import HIE.Bios.Internal.Log + + +-- | Initialize the 'DynFlags' relating to the compilation of a single +-- file or GHC session according to the provided 'Cradle'. +getCompilerOptions :: + FilePath -- The file we are loading it because of + -> Cradle a + -> IO (CradleLoadResult ComponentOptions) +getCompilerOptions = + getCompilerOptionsWithLogger logm + +getCompilerOptionsWithLogger :: + LoggingFunction + -> FilePath + -> Cradle a + -> IO (CradleLoadResult ComponentOptions) +getCompilerOptionsWithLogger l fp cradle = + runCradle (cradleOptsProg cradle) l fp + + +---------------------------------------------------------------- diff --git a/src/HIE/Bios/Ghc/Api.hs b/src/HIE/Bios/Ghc/Api.hs --- a/src/HIE/Bios/Ghc/Api.hs +++ b/src/HIE/Bios/Ghc/Api.hs @@ -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 + +---------------------------------------------------------------- diff --git a/src/HIE/Bios/Ghc/Doc.hs b/src/HIE/Bios/Ghc/Doc.hs --- a/src/HIE/Bios/Ghc/Doc.hs +++ b/src/HIE/Bios/Ghc/Doc.hs @@ -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 } diff --git a/src/HIE/Bios/Ghc/Load.hs b/src/HIE/Bios/Ghc/Load.hs --- a/src/HIE/Bios/Ghc/Load.hs +++ b/src/HIE/Bios/Ghc/Load.hs @@ -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 } diff --git a/src/HIE/Bios/Ghc/Logger.hs b/src/HIE/Bios/Ghc/Logger.hs --- a/src/HIE/Bios/Ghc/Logger.hs +++ b/src/HIE/Bios/Ghc/Logger.hs @@ -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 diff --git a/src/HIE/Bios/Internal/Log.hs b/src/HIE/Bios/Internal/Log.hs --- a/src/HIE/Bios/Internal/Log.hs +++ b/src/HIE/Bios/Internal/Log.hs @@ -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 diff --git a/src/HIE/Bios/Wrappers.hs b/src/HIE/Bios/Wrappers.hs --- a/src/HIE/Bios/Wrappers.hs +++ b/src/HIE/Bios/Wrappers.hs @@ -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") + diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs --- a/tests/ParserTests.hs +++ b/tests/ParserTests.hs @@ -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) + ] + ) + ] diff --git a/tests/configs/bazel.yaml b/tests/configs/bazel.yaml --- a/tests/configs/bazel.yaml +++ b/tests/configs/bazel.yaml @@ -1,2 +1,2 @@ -cradle: - { bazel: } +cradle: + { bazel: } diff --git a/tests/configs/bios-1.yaml b/tests/configs/bios-1.yaml --- a/tests/configs/bios-1.yaml +++ b/tests/configs/bios-1.yaml @@ -1,3 +1,3 @@ -cradle: - bios: - program: "program" +cradle: + bios: + program: "program" diff --git a/tests/configs/bios-2.yaml b/tests/configs/bios-2.yaml --- a/tests/configs/bios-2.yaml +++ b/tests/configs/bios-2.yaml @@ -1,4 +1,4 @@ -cradle: - bios: - program: "program" - dependency-program: "dep-program" +cradle: + bios: + program: "program" + dependency-program: "dep-program" diff --git a/tests/configs/cabal-1.yaml b/tests/configs/cabal-1.yaml --- a/tests/configs/cabal-1.yaml +++ b/tests/configs/cabal-1.yaml @@ -1,2 +1,2 @@ -cradle: - { cabal: {component: "lib:hie-bios"} } +cradle: + { cabal: {component: "lib:hie-bios"} } diff --git a/tests/configs/cabal-multi.yaml b/tests/configs/cabal-multi.yaml --- a/tests/configs/cabal-multi.yaml +++ b/tests/configs/cabal-multi.yaml @@ -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" diff --git a/tests/configs/ch-cabal.yaml b/tests/configs/ch-cabal.yaml --- a/tests/configs/ch-cabal.yaml +++ b/tests/configs/ch-cabal.yaml @@ -1,4 +1,4 @@ -cradle: - other: - cabal-helper: +cradle: + other: + cabal-helper: cabal: diff --git a/tests/configs/ch-stack.yaml b/tests/configs/ch-stack.yaml --- a/tests/configs/ch-stack.yaml +++ b/tests/configs/ch-stack.yaml @@ -1,4 +1,4 @@ -cradle: - other: - cabal-helper: +cradle: + other: + cabal-helper: stack: diff --git a/tests/configs/default.yaml b/tests/configs/default.yaml --- a/tests/configs/default.yaml +++ b/tests/configs/default.yaml @@ -1,2 +1,2 @@ -cradle: - default: +cradle: + default: diff --git a/tests/configs/dependencies.yaml b/tests/configs/dependencies.yaml --- a/tests/configs/dependencies.yaml +++ b/tests/configs/dependencies.yaml @@ -1,5 +1,5 @@ -cradle: - { cabal: {component: "lib:hie-bios"} } - -dependencies: - - "depFile" +cradle: + { cabal: {component: "lib:hie-bios"} } + +dependencies: + - "depFile" diff --git a/tests/configs/direct.yaml b/tests/configs/direct.yaml --- a/tests/configs/direct.yaml +++ b/tests/configs/direct.yaml @@ -1,3 +1,3 @@ -cradle: - direct: - arguments: ["list", "of", "arguments"] +cradle: + direct: + arguments: ["list", "of", "arguments"] diff --git a/tests/configs/multi-ch.yaml b/tests/configs/multi-ch.yaml --- a/tests/configs/multi-ch.yaml +++ b/tests/configs/multi-ch.yaml @@ -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: } } diff --git a/tests/configs/multi.yaml b/tests/configs/multi.yaml --- a/tests/configs/multi.yaml +++ b/tests/configs/multi.yaml @@ -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"}} } diff --git a/tests/configs/nested-cabal-multi.yaml b/tests/configs/nested-cabal-multi.yaml --- a/tests/configs/nested-cabal-multi.yaml +++ b/tests/configs/nested-cabal-multi.yaml @@ -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" } ] } } diff --git a/tests/configs/nested-stack-multi.yaml b/tests/configs/nested-stack-multi.yaml --- a/tests/configs/nested-stack-multi.yaml +++ b/tests/configs/nested-stack-multi.yaml @@ -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" } ] } } diff --git a/tests/configs/none.yaml b/tests/configs/none.yaml --- a/tests/configs/none.yaml +++ b/tests/configs/none.yaml @@ -1,2 +1,2 @@ -cradle: - none: +cradle: + none: diff --git a/tests/configs/obelisk.yaml b/tests/configs/obelisk.yaml --- a/tests/configs/obelisk.yaml +++ b/tests/configs/obelisk.yaml @@ -1,2 +1,2 @@ -cradle: - { obelisk: } +cradle: + { obelisk: } diff --git a/tests/configs/stack-config.yaml b/tests/configs/stack-config.yaml --- a/tests/configs/stack-config.yaml +++ b/tests/configs/stack-config.yaml @@ -1,2 +1,2 @@ -cradle: - { stack: {}} +cradle: + { stack: {}} diff --git a/tests/configs/stack-multi.yaml b/tests/configs/stack-multi.yaml --- a/tests/configs/stack-multi.yaml +++ b/tests/configs/stack-multi.yaml @@ -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" diff --git a/tests/projects/implicit-cabal/Main.hs b/tests/projects/implicit-cabal/Main.hs --- a/tests/projects/implicit-cabal/Main.hs +++ b/tests/projects/implicit-cabal/Main.hs @@ -1,4 +1,4 @@ -module Main where - -main :: IO () -main = putStrLn "Hello, Haskell!" +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/tests/projects/implicit-cabal/Setup.hs b/tests/projects/implicit-cabal/Setup.hs --- a/tests/projects/implicit-cabal/Setup.hs +++ b/tests/projects/implicit-cabal/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/implicit-cabal/cabal.project b/tests/projects/implicit-cabal/cabal.project --- a/tests/projects/implicit-cabal/cabal.project +++ b/tests/projects/implicit-cabal/cabal.project @@ -1,1 +1,1 @@ -packages: . +packages: . diff --git a/tests/projects/implicit-cabal/implicit-cabal.cabal b/tests/projects/implicit-cabal/implicit-cabal.cabal --- a/tests/projects/implicit-cabal/implicit-cabal.cabal +++ b/tests/projects/implicit-cabal/implicit-cabal.cabal @@ -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 diff --git a/tests/projects/implicit-stack-multi/Main.hs b/tests/projects/implicit-stack-multi/Main.hs --- a/tests/projects/implicit-stack-multi/Main.hs +++ b/tests/projects/implicit-stack-multi/Main.hs @@ -1,4 +1,4 @@ -module Main where - -main :: IO () -main = putStrLn "Hello, Haskell!" +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/tests/projects/implicit-stack-multi/Setup.hs b/tests/projects/implicit-stack-multi/Setup.hs --- a/tests/projects/implicit-stack-multi/Setup.hs +++ b/tests/projects/implicit-stack-multi/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/implicit-stack-multi/implicit-stack-multi.cabal b/tests/projects/implicit-stack-multi/implicit-stack-multi.cabal --- a/tests/projects/implicit-stack-multi/implicit-stack-multi.cabal +++ b/tests/projects/implicit-stack-multi/implicit-stack-multi.cabal @@ -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 diff --git a/tests/projects/implicit-stack-multi/other-package/Main.hs b/tests/projects/implicit-stack-multi/other-package/Main.hs --- a/tests/projects/implicit-stack-multi/other-package/Main.hs +++ b/tests/projects/implicit-stack-multi/other-package/Main.hs @@ -1,4 +1,4 @@ -module Main where - -main :: IO () -main = putStrLn "Hello, Haskell!" +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/tests/projects/implicit-stack-multi/other-package/Setup.hs b/tests/projects/implicit-stack-multi/other-package/Setup.hs --- a/tests/projects/implicit-stack-multi/other-package/Setup.hs +++ b/tests/projects/implicit-stack-multi/other-package/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/implicit-stack-multi/other-package/other-package.cabal b/tests/projects/implicit-stack-multi/other-package/other-package.cabal --- a/tests/projects/implicit-stack-multi/other-package/other-package.cabal +++ b/tests/projects/implicit-stack-multi/other-package/other-package.cabal @@ -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 diff --git a/tests/projects/implicit-stack/Main.hs b/tests/projects/implicit-stack/Main.hs --- a/tests/projects/implicit-stack/Main.hs +++ b/tests/projects/implicit-stack/Main.hs @@ -1,4 +1,4 @@ -module Main where - -main :: IO () -main = putStrLn "Hello, Haskell!" +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/tests/projects/implicit-stack/Setup.hs b/tests/projects/implicit-stack/Setup.hs --- a/tests/projects/implicit-stack/Setup.hs +++ b/tests/projects/implicit-stack/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/implicit-stack/implicit-stack.cabal b/tests/projects/implicit-stack/implicit-stack.cabal --- a/tests/projects/implicit-stack/implicit-stack.cabal +++ b/tests/projects/implicit-stack/implicit-stack.cabal @@ -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 diff --git a/tests/projects/multi-cabal/Setup.hs b/tests/projects/multi-cabal/Setup.hs --- a/tests/projects/multi-cabal/Setup.hs +++ b/tests/projects/multi-cabal/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/multi-cabal/app/Main.hs b/tests/projects/multi-cabal/app/Main.hs --- a/tests/projects/multi-cabal/app/Main.hs +++ b/tests/projects/multi-cabal/app/Main.hs @@ -1,4 +1,4 @@ - -import System.Directory (getCurrentDirectory) - + +import System.Directory (getCurrentDirectory) + main = return () diff --git a/tests/projects/multi-cabal/cabal.project b/tests/projects/multi-cabal/cabal.project --- a/tests/projects/multi-cabal/cabal.project +++ b/tests/projects/multi-cabal/cabal.project @@ -1,1 +1,1 @@ -packages: ./ +packages: ./ diff --git a/tests/projects/multi-cabal/hie.yaml b/tests/projects/multi-cabal/hie.yaml --- a/tests/projects/multi-cabal/hie.yaml +++ b/tests/projects/multi-cabal/hie.yaml @@ -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" diff --git a/tests/projects/multi-cabal/multi-cabal.cabal b/tests/projects/multi-cabal/multi-cabal.cabal --- a/tests/projects/multi-cabal/multi-cabal.cabal +++ b/tests/projects/multi-cabal/multi-cabal.cabal @@ -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 diff --git a/tests/projects/multi-cabal/src/Lib.hs b/tests/projects/multi-cabal/src/Lib.hs --- a/tests/projects/multi-cabal/src/Lib.hs +++ b/tests/projects/multi-cabal/src/Lib.hs @@ -1,5 +1,5 @@ -module Lib where - -import System.FilePath (()) - +module Lib where + +import System.FilePath (()) + foo = "test" "me" diff --git a/tests/projects/multi-direct/B.hs b/tests/projects/multi-direct/B.hs --- a/tests/projects/multi-direct/B.hs +++ b/tests/projects/multi-direct/B.hs @@ -1,3 +1,3 @@ -module B where - -import A +module B where + +import A diff --git a/tests/projects/multi-direct/hie.yaml b/tests/projects/multi-direct/hie.yaml --- a/tests/projects/multi-direct/hie.yaml +++ b/tests/projects/multi-direct/hie.yaml @@ -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"] diff --git a/tests/projects/multi-stack/Setup.hs b/tests/projects/multi-stack/Setup.hs --- a/tests/projects/multi-stack/Setup.hs +++ b/tests/projects/multi-stack/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/multi-stack/app/Main.hs b/tests/projects/multi-stack/app/Main.hs --- a/tests/projects/multi-stack/app/Main.hs +++ b/tests/projects/multi-stack/app/Main.hs @@ -1,4 +1,4 @@ - -import System.Directory (getCurrentDirectory) - + +import System.Directory (getCurrentDirectory) + main = return () diff --git a/tests/projects/multi-stack/cabal.project b/tests/projects/multi-stack/cabal.project --- a/tests/projects/multi-stack/cabal.project +++ b/tests/projects/multi-stack/cabal.project @@ -1,1 +1,1 @@ -packages: ./ +packages: ./ diff --git a/tests/projects/multi-stack/hie.yaml b/tests/projects/multi-stack/hie.yaml --- a/tests/projects/multi-stack/hie.yaml +++ b/tests/projects/multi-stack/hie.yaml @@ -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" diff --git a/tests/projects/multi-stack/multi-stack.cabal b/tests/projects/multi-stack/multi-stack.cabal --- a/tests/projects/multi-stack/multi-stack.cabal +++ b/tests/projects/multi-stack/multi-stack.cabal @@ -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 diff --git a/tests/projects/multi-stack/src/Lib.hs b/tests/projects/multi-stack/src/Lib.hs --- a/tests/projects/multi-stack/src/Lib.hs +++ b/tests/projects/multi-stack/src/Lib.hs @@ -1,5 +1,5 @@ -module Lib where - -import System.FilePath (()) - +module Lib where + +import System.FilePath (()) + foo = "test" "me" diff --git a/tests/projects/simple-bios/B.hs b/tests/projects/simple-bios/B.hs --- a/tests/projects/simple-bios/B.hs +++ b/tests/projects/simple-bios/B.hs @@ -1,3 +1,3 @@ -module B where - -import A +module B where + +import A diff --git a/tests/projects/simple-bios/hie-bios.sh b/tests/projects/simple-bios/hie-bios.sh --- a/tests/projects/simple-bios/hie-bios.sh +++ b/tests/projects/simple-bios/hie-bios.sh @@ -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 diff --git a/tests/projects/simple-bios/hie.yaml b/tests/projects/simple-bios/hie.yaml --- a/tests/projects/simple-bios/hie.yaml +++ b/tests/projects/simple-bios/hie.yaml @@ -1,2 +1,2 @@ -cradle: - bios: {program: ./hie-bios.sh } +cradle: + bios: {program: ./hie-bios.sh } diff --git a/tests/projects/simple-cabal/A.hs b/tests/projects/simple-cabal/A.hs --- a/tests/projects/simple-cabal/A.hs +++ b/tests/projects/simple-cabal/A.hs @@ -1,1 +1,1 @@ -module A where +module A where diff --git a/tests/projects/simple-cabal/B.hs b/tests/projects/simple-cabal/B.hs --- a/tests/projects/simple-cabal/B.hs +++ b/tests/projects/simple-cabal/B.hs @@ -1,3 +1,3 @@ -module B where - -import A +module B where + +import A diff --git a/tests/projects/simple-cabal/CHANGELOG.md b/tests/projects/simple-cabal/CHANGELOG.md --- a/tests/projects/simple-cabal/CHANGELOG.md +++ b/tests/projects/simple-cabal/CHANGELOG.md @@ -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. diff --git a/tests/projects/simple-cabal/Setup.hs b/tests/projects/simple-cabal/Setup.hs --- a/tests/projects/simple-cabal/Setup.hs +++ b/tests/projects/simple-cabal/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/simple-cabal/cabal.project b/tests/projects/simple-cabal/cabal.project --- a/tests/projects/simple-cabal/cabal.project +++ b/tests/projects/simple-cabal/cabal.project @@ -1,1 +1,1 @@ -packages: . +packages: . diff --git a/tests/projects/simple-cabal/hie.yaml b/tests/projects/simple-cabal/hie.yaml --- a/tests/projects/simple-cabal/hie.yaml +++ b/tests/projects/simple-cabal/hie.yaml @@ -1,2 +1,2 @@ -cradle: - cabal: {component: "lib:simple-cabal"} +cradle: + cabal: {component: "lib:simple-cabal"} diff --git a/tests/projects/simple-cabal/simple-cabal.cabal b/tests/projects/simple-cabal/simple-cabal.cabal --- a/tests/projects/simple-cabal/simple-cabal.cabal +++ b/tests/projects/simple-cabal/simple-cabal.cabal @@ -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 diff --git a/tests/projects/simple-direct/B.hs b/tests/projects/simple-direct/B.hs --- a/tests/projects/simple-direct/B.hs +++ b/tests/projects/simple-direct/B.hs @@ -1,3 +1,3 @@ -module B where - -import A +module B where + +import A diff --git a/tests/projects/simple-direct/hie.yaml b/tests/projects/simple-direct/hie.yaml --- a/tests/projects/simple-direct/hie.yaml +++ b/tests/projects/simple-direct/hie.yaml @@ -1,2 +1,2 @@ -cradle: - direct: {arguments: ["-Walaaal", "A", "B"] } +cradle: + direct: {arguments: ["-Walaaal", "A", "B"] } diff --git a/tests/projects/simple-stack/A.hs b/tests/projects/simple-stack/A.hs --- a/tests/projects/simple-stack/A.hs +++ b/tests/projects/simple-stack/A.hs @@ -1,1 +1,1 @@ -module A where +module A where diff --git a/tests/projects/simple-stack/B.hs b/tests/projects/simple-stack/B.hs --- a/tests/projects/simple-stack/B.hs +++ b/tests/projects/simple-stack/B.hs @@ -1,3 +1,3 @@ -module B where - -import A +module B where + +import A diff --git a/tests/projects/simple-stack/CHANGELOG.md b/tests/projects/simple-stack/CHANGELOG.md --- a/tests/projects/simple-stack/CHANGELOG.md +++ b/tests/projects/simple-stack/CHANGELOG.md @@ -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. diff --git a/tests/projects/simple-stack/Setup.hs b/tests/projects/simple-stack/Setup.hs --- a/tests/projects/simple-stack/Setup.hs +++ b/tests/projects/simple-stack/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/tests/projects/simple-stack/cabal.project b/tests/projects/simple-stack/cabal.project --- a/tests/projects/simple-stack/cabal.project +++ b/tests/projects/simple-stack/cabal.project @@ -1,1 +1,1 @@ -packages: . +packages: . diff --git a/tests/projects/simple-stack/hie.yaml b/tests/projects/simple-stack/hie.yaml --- a/tests/projects/simple-stack/hie.yaml +++ b/tests/projects/simple-stack/hie.yaml @@ -1,3 +1,3 @@ -cradle: - stack: - component: "simple-stack:lib" +cradle: + stack: + component: "simple-stack:lib" diff --git a/tests/projects/simple-stack/simple-stack.cabal b/tests/projects/simple-stack/simple-stack.cabal --- a/tests/projects/simple-stack/simple-stack.cabal +++ b/tests/projects/simple-stack/simple-stack.cabal @@ -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 diff --git a/wrappers/cabal b/wrappers/cabal --- a/wrappers/cabal +++ b/wrappers/cabal @@ -1,11 +1,11 @@ #!/usr/bin/env bash function out(){ - echo "$1" >> $HIE_BIOS_OUTPUT + echo "$1" >> "$HIE_BIOS_OUTPUT" } if [ "$1" == "--interactive" ]; then - out $(pwd) + out "$(pwd)" for arg in "$@"; do out "$arg" done diff --git a/wrappers/cabal.hs b/wrappers/cabal.hs --- a/wrappers/cabal.hs +++ b/wrappers/cabal.hs @@ -1,11 +1,12 @@ module Main (main) where import System.Directory (getCurrentDirectory) -import System.Environment (getArgs, getEnv, lookupEnv) +import System.Environment (getArgs, getEnv) import System.Exit (exitWith) import System.Process (spawnProcess, waitForProcess) import System.IO (openFile, hClose, hPutStrLn, IOMode(..)) +main :: IO () main = do args <- getArgs output_file <- getEnv "HIE_BIOS_OUTPUT"