Move split source into src/ and lib/

1 files changed, 0 insertions, 527 deletions

diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs
deleted file mode 100644
index 73ad668..0000000
--- a/Distribution/Helper.hs
+++ /dev/null
@@ -1,527 +0,0 @@
--- ghc-mod: Making Haskell development *more* fun
--- Copyright (C) 2015,2017  Daniel Gröber <dxld ÄT darkboxed DOT org>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of the GNU Affero General Public License as published by
--- the Free Software Foundation, either version 3 of the License, or
--- (at your option) any later version.
---
--- This program is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of
--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--- GNU Affero General Public License for more details.
---
--- You should have received a copy of the GNU Affero General Public License
--- along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-{-# LANGUAGE CPP, RecordWildCards, FlexibleContexts, ConstraintKinds,
-  GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric, DeriveFunctor
- #-}
-
-{-|
-Module      : Distribution.Helper
-License     : AGPL-3
-Maintainer  : dxld@darkboxed.org
-Portability : POSIX
--}
-
-module Distribution.Helper (
-  -- * Running Queries
-    Query
-  , runQuery
-
-  -- * Queries against Cabal\'s on disk state
-
-  -- ** Package queries
-  , packageId
-  , packageDbStack
-  , packageFlags
-  , packageLicenses
-  , compilerVersion
-
-  , ghcMergedPkgOptions
-
-  -- ** cabal-install queries
-  , configFlags
-  , nonDefaultConfigFlags
-
-
-  -- ** Component queries
-  , ComponentQuery
-  , components
-
-  , ghcSrcOptions
-  , ghcPkgOptions
-  , ghcLangOptions
-  , ghcOptions
-  , sourceDirs
-  , entrypoints
-
-  -- * Query environment
-  , QueryEnv
-  , mkQueryEnv
-  , qeReadProcess
-  , qePrograms
-  , qeProjectDir
-  , qeDistDir
-  , qeCabalPkgDb
-  , qeCabalVer
-
-  , Programs(..)
-  , defaultPrograms
-
-
-  -- * Result types
-  , ChModuleName(..)
-  , ChComponentName(..)
-  , ChPkgDb(..)
-  , ChEntrypoint(..)
-
-  -- * General information
-  , buildPlatform
-
-  -- * Stuff that cabal-install really should export
-  , Distribution.Helper.getSandboxPkgDb
-
-  -- * Managing @dist/@
-  , prepare
-  , reconfigure
-  , writeAutogenFiles
-
-  -- * $libexec related error handling
-  , LibexecNotFoundError(..)
-  , libexecNotFoundError
-
-  -- * Reexports
-  , module Data.Functor.Apply
-  ) where
-
-import Control.Applicative
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.State.Strict
-import Control.Monad.Reader
-import Control.Exception as E
-import Data.Char
-import Data.List
-import Data.Maybe
-import Data.Version
-import Data.Typeable
-import Data.Functor.Apply
-import Distribution.Simple.BuildPaths (exeExtension)
-import System.Environment
-import System.FilePath hiding ((<.>))
-import qualified System.FilePath as FP
-import System.Directory
-import System.Process
-import System.IO.Unsafe
-import Text.Printf
-import GHC.Generics
-import Prelude
-
-import Paths_cabal_helper (getLibexecDir)
-import CabalHelper.Shared.InterfaceTypes
-import CabalHelper.Shared.Sandbox
-
--- | Paths or names of various programs we need.
-data Programs = Programs {
-      -- | The path to the @cabal@ program.
-      cabalProgram  :: FilePath,
-
-      -- | The path to the @ghc@ program.
-      ghcProgram    :: FilePath,
-
-      -- | The path to the @ghc-pkg@ program. If
-      -- not changed it will be derived from the path to 'ghcProgram'.
-      ghcPkgProgram :: FilePath
-    } deriving (Eq, Ord, Show, Read, Generic, Typeable)
-
--- | Default all programs to their unqualified names, i.e. they will be searched
--- for on @PATH@.
-defaultPrograms :: Programs
-defaultPrograms = Programs "cabal" "ghc" "ghc-pkg"
-
--- | Environment for running a 'Query'. The real constructor is not exposed,
--- the field accessors are however. See below. Use the 'mkQueryEnv' smart
--- constructor to construct one.
-data QueryEnv = QueryEnv {
-      -- | Field accessor for 'QueryEnv'. Defines how to start the cabal-helper
-      --  process. Useful if you need to capture stderr output from the helper.
-      qeReadProcess :: FilePath -> [String] -> String -> IO String,
-
-      -- | Field accessor for 'QueryEnv'.
-      qePrograms    :: Programs,
-
-      -- | Field accessor for 'QueryEnv'. Defines path to the project directory,
-      -- i.e. a directory containing a @project.cabal@ file
-      qeProjectDir  :: FilePath,
-
-
-      -- | Field accessor for 'QueryEnv'. Defines path to the @dist/@ directory,
-      -- /builddir/ in Cabal terminology.
-      qeDistDir     :: FilePath,
-
-      -- | Field accessor for 'QueryEnv'. Defines where to look for the Cabal
-      -- library when linking the helper.
-      qeCabalPkgDb  :: Maybe FilePath,
-
-      -- | Field accessor for 'QueryEnv'. If @dist/setup-config@ wasn\'t written
-      -- by this version of Cabal an error is thrown when running the query.
-      qeCabalVer    :: Maybe Version
-    }
-
--- | @mkQueryEnv projdir distdir@. Smart constructor for 'QueryEnv'.
--- Sets fields 'qeProjectDir' and 'qeDistDir' to @projdir@ and @distdir@
--- respectively and provides sensible defaults for the other fields.
-mkQueryEnv :: FilePath
-           -- ^ Path to the project directory, i.e. the directory containing a
-           -- @project.cabal@ file
-           -> FilePath
-           -- ^ Path to the @dist/@ directory, called /builddir/ in Cabal
-           -- terminology.
-           -> QueryEnv
-mkQueryEnv projdir distdir = QueryEnv {
-    qeReadProcess = readProcess
-  , qePrograms    = defaultPrograms
-  , qeProjectDir  = projdir
-  , qeDistDir     = distdir
-  , qeCabalPkgDb  = Nothing
-  , qeCabalVer    = Nothing
-  }
-
-data SomeLocalBuildInfo = SomeLocalBuildInfo {
-      slbiPackageDbStack      :: [ChPkgDb],
-      slbiPackageFlags        :: [(String, Bool)],
-      slbiPkgLicenses         :: [(String, [(String, Version)])],
-      slbiCompilerVersion     :: (String, Version),
-
-      slbiGhcMergedPkgOptions :: [String],
-
-      slbiConfigFlags         :: [(String, Bool)],
-      slbiNonDefaultConfigFlags :: [(String, Bool)],
-
-      slbiGhcSrcOptions       :: [(ChComponentName, [String])],
-      slbiGhcPkgOptions       :: [(ChComponentName, [String])],
-      slbiGhcLangOptions      :: [(ChComponentName, [String])],
-      slbiGhcOptions          :: [(ChComponentName, [String])],
-
-      slbiSourceDirs          :: [(ChComponentName, [String])],
-      slbiEntrypoints         :: [(ChComponentName, ChEntrypoint)]
-    } deriving (Eq, Ord, Read, Show)
-
--- | A lazy, cached, query against a package's Cabal configuration. Use
--- 'runQuery' to execute it.
-newtype Query m a = Query { unQuery :: StateT (Maybe SomeLocalBuildInfo)
-                                         (ReaderT QueryEnv m) a }
-    deriving (Functor, Applicative, Monad, MonadIO)
-
-instance MonadTrans Query where
-    lift = Query . lift . lift
-
-type MonadQuery m = ( MonadIO m
-                    , MonadState (Maybe SomeLocalBuildInfo) m
-                    , MonadReader QueryEnv m)
-
--- | A 'Query' to run on all components of a package. Use 'components' to get a
--- regular 'Query'.
-newtype ComponentQuery m a = ComponentQuery (Query m [(ChComponentName, a)])
-    deriving (Functor)
-
-instance Monad m => Apply (ComponentQuery m) where
-    ComponentQuery flab <.> ComponentQuery fla =
-        ComponentQuery $ liftM2 go flab fla
-      where
-        go :: [(ChComponentName, a -> b)]
-           -> [(ChComponentName, a)]
-           -> [(ChComponentName, b)]
-        go lab la =
-            [ (cn, ab a)
-            | (cn,  ab) <- lab
-            , (cn', a)  <- la
-            , cn == cn'
-            ]
-
-run :: Monad m => QueryEnv -> Maybe SomeLocalBuildInfo -> Query m a -> m a
-run e s action = flip runReaderT e (flip evalStateT s (unQuery action))
-
--- | @runQuery env query@. Run a 'Query' under a given 'QueryEnv'.
-runQuery :: Monad m
-         => QueryEnv
-         -> Query m a
-         -> m a
-runQuery qe action = run qe Nothing action
-
-getSlbi :: MonadQuery m => m SomeLocalBuildInfo
-getSlbi = do
-  s <- get
-  case s of
-    Nothing -> do
-            slbi <- getSomeConfigState
-            put (Just slbi)
-            return slbi
-    Just slbi -> return slbi
-
--- | List of package databases to use.
-packageDbStack :: MonadIO m => Query m [ChPkgDb]
-
--- | Like @ghcPkgOptions@ but for the whole package not just one component
-ghcMergedPkgOptions :: MonadIO m => Query m [String]
-
--- | Get the licenses of the packages the current project is linking against.
-packageLicenses :: MonadIO m => Query m [(String, [(String, Version)])]
-
--- | Flag definitions from cabal file
-packageFlags :: MonadIO m => Query m [(String, Bool)]
-
--- | Flag assignments from setup-config
-configFlags :: MonadIO m => Query m [(String, Bool)]
-
--- | Flag assignments from setup-config which differ from the default
--- setting. This can also include flags which cabal decided to modify,
--- i.e. don't rely on these being the flags set by the user directly.
-nonDefaultConfigFlags :: MonadIO m => Query m [(String, Bool)]
-
--- | The version of GHC the project is configured to use
-compilerVersion :: MonadIO m => Query m (String, Version)
-
--- | Package identifier, i.e. package name and version
-packageId :: MonadIO m => Query m (String, Version)
-
--- | Run a ComponentQuery on all components of the package.
-components :: Monad m => ComponentQuery m (ChComponentName -> b) -> Query m [b]
-components (ComponentQuery sc) = map (\(cn, f) -> f cn) <$> sc
-
--- | Modules or files Cabal would have the compiler build directly. Can be used
--- to compute the home module closure for a component.
-entrypoints   :: MonadIO m => ComponentQuery m ChEntrypoint
-
--- | A component's @source-dirs@ field, beware since if this is empty implicit
--- behaviour in GHC kicks in.
-sourceDirs    :: MonadIO m => ComponentQuery m [FilePath]
-
--- | All options Cabal would pass to GHC.
-ghcOptions    :: MonadIO m => ComponentQuery m [String]
-
--- | Only search path related GHC options.
-ghcSrcOptions :: MonadIO m => ComponentQuery m [String]
-
--- | Only package related GHC options, sufficient for things don't need to
--- access any home modules.
-ghcPkgOptions :: MonadIO m => ComponentQuery m [String]
-
--- | Only language related options, i.e. @-XSomeExtension@
-ghcLangOptions :: MonadIO m => ComponentQuery m [String]
-
-packageId             = Query $ getPackageId
-packageDbStack        = Query $ slbiPackageDbStack        `liftM` getSlbi
-packageFlags          = Query $ slbiPackageFlags          `liftM` getSlbi
-packageLicenses       = Query $ slbiPkgLicenses           `liftM` getSlbi
-compilerVersion       = Query $ slbiCompilerVersion       `liftM` getSlbi
-ghcMergedPkgOptions   = Query $ slbiGhcMergedPkgOptions   `liftM` getSlbi
-configFlags           = Query $ slbiConfigFlags           `liftM` getSlbi
-nonDefaultConfigFlags = Query $ slbiNonDefaultConfigFlags `liftM` getSlbi
-
-ghcSrcOptions  = ComponentQuery $ Query $ slbiGhcSrcOptions  `liftM` getSlbi
-ghcPkgOptions  = ComponentQuery $ Query $ slbiGhcPkgOptions  `liftM` getSlbi
-ghcOptions     = ComponentQuery $ Query $ slbiGhcOptions     `liftM` getSlbi
-ghcLangOptions = ComponentQuery $ Query $ slbiGhcLangOptions `liftM` getSlbi
-sourceDirs     = ComponentQuery $ Query $ slbiSourceDirs     `liftM` getSlbi
-entrypoints    = ComponentQuery $ Query $ slbiEntrypoints    `liftM` getSlbi
-
--- | Run @cabal configure@
-reconfigure :: MonadIO m
-            => (FilePath -> [String] -> String -> IO String)
-            -> Programs -- ^ Program paths
-            -> [String] -- ^ Command line arguments to be passed to @cabal@
-            -> m ()
-reconfigure readProc progs cabalOpts = do
-    let progOpts =
-            [ "--with-ghc=" ++ ghcProgram progs ]
-            -- Only pass ghc-pkg if it was actually set otherwise we
-            -- might break cabal's guessing logic
-            ++ if ghcPkgProgram progs /= "ghc-pkg"
-                 then [ "--with-ghc-pkg=" ++ ghcPkgProgram progs ]
-                 else []
-            ++ cabalOpts
-    _ <- liftIO $ readProc (cabalProgram progs) ("configure":progOpts) ""
-    return ()
-
-readHelper :: (MonadIO m, MonadQuery m) => [String] -> m [Maybe ChResponse]
-readHelper args = ask >>= \qe -> liftIO $ do
-  out <- either error id <$> invokeHelper qe args
-  let res = read out
-  liftIO $ evaluate res `E.catch` \se@(SomeException _) -> do
-      md <- lookupEnv' "CABAL_HELPER_DEBUG"
-      let msg = "readHelper: exception: '" ++ show se ++ "'"
-      error $ msg ++ case md of
-        Nothing -> ", for more information set the environment variable CABAL_HELPER_DEBUG"
-        Just _ -> ", output: '"++ out ++"'"
-
-invokeHelper :: QueryEnv -> [String] -> IO (Either String String)
-invokeHelper QueryEnv {..} args = do
-  let progArgs = [ "--with-ghc="     ++ ghcProgram qePrograms
-                 , "--with-ghc-pkg=" ++ ghcPkgProgram qePrograms
-                 , "--with-cabal="   ++ cabalProgram qePrograms
-                 ]
-  exe  <- findLibexecExe
-  let args' = progArgs ++ qeProjectDir:qeDistDir:args
-  out <- qeReadProcess exe args' ""
-  (Right <$> evaluate out) `E.catch` \(SomeException _) ->
-      return $ Left $ concat
-                 ["invokeHelper", ": ", exe, " "
-                 , intercalate " " (map show args')
-                 , " failed"
-                 ]
-
-getPackageId :: MonadQuery m => m (String, Version)
-getPackageId = ask >>= \QueryEnv {..} -> do
-  [ Just (ChResponseVersion pkgName pkgVer) ] <- readHelper [ "package-id" ]
-  return (pkgName, pkgVer)
-
-getSomeConfigState :: MonadQuery m => m SomeLocalBuildInfo
-getSomeConfigState = ask >>= \QueryEnv {..} -> do
-  res <- readHelper
-         [ "package-db-stack"
-         , "flags"
-         , "licenses"
-         , "compiler-version"
-
-         , "ghc-merged-pkg-options"
-
-         , "config-flags"
-         , "non-default-config-flags"
-
-         , "ghc-src-options"
-         , "ghc-pkg-options"
-         , "ghc-lang-options"
-         , "ghc-options"
-
-         , "source-dirs"
-         , "entrypoints"
-         ]
-  let [ Just (ChResponsePkgDbs      slbiPackageDbStack),
-        Just (ChResponseFlags       slbiPackageFlags),
-        Just (ChResponseLicenses    slbiPkgLicenses),
-        Just (ChResponseVersion     comp compVer),
-
-        Just (ChResponseList        slbiGhcMergedPkgOptions),
-
-        Just (ChResponseFlags       slbiConfigFlags),
-        Just (ChResponseFlags       slbiNonDefaultConfigFlags),
-
-        Just (ChResponseCompList    slbiGhcSrcOptions),
-        Just (ChResponseCompList    slbiGhcPkgOptions),
-        Just (ChResponseCompList    slbiGhcLangOptions),
-        Just (ChResponseCompList    slbiGhcOptions),
-
-        Just (ChResponseCompList    slbiSourceDirs),
-        Just (ChResponseEntrypoints slbiEntrypoints)
-        ] = res
-      slbiCompilerVersion = (comp, compVer)
-  return $ SomeLocalBuildInfo {..}
-
-
--- | Make sure the appropriate helper executable for the given project is
--- installed and ready to run queries.
-prepare :: MonadIO m => QueryEnv -> m ()
-prepare qe =
-  liftIO $ void $ invokeHelper qe []
-
--- | Create @cabal_macros.h@ and @Paths_\<pkg\>@ possibly other generated files
--- in the usual place.
-writeAutogenFiles :: MonadIO m => QueryEnv -> m ()
-writeAutogenFiles qe  =
-  liftIO $ void $ invokeHelper qe ["write-autogen-files"]
-
--- | Get the path to the sandbox package-db in a project
-getSandboxPkgDb :: (FilePath -> [String] -> String -> IO String)
-             -> FilePath
-             -- ^ Cabal build platform, i.e. @buildPlatform@
-             -> Version
-             -- ^ GHC version (@cProjectVersion@ is your friend)
-             -> IO (Maybe FilePath)
-getSandboxPkgDb readProc =
-    CabalHelper.Shared.Sandbox.getSandboxPkgDb $ unsafePerformIO $ buildPlatform readProc
-
-buildPlatform :: (FilePath -> [String] -> String -> IO String) -> IO String
-buildPlatform readProc = do
-  exe  <- findLibexecExe
-  CabalHelper.Shared.Sandbox.dropWhileEnd isSpace <$> readProc exe ["print-build-platform"] ""
-
--- | This exception is thrown by all 'runQuery' functions if the internal
--- wrapper executable cannot be found. You may catch this and present the user
--- an appropriate error message however the default is to print
--- 'libexecNotFoundError'.
-data LibexecNotFoundError = LibexecNotFoundError String FilePath
-                          deriving (Typeable)
-instance Exception LibexecNotFoundError
-instance Show LibexecNotFoundError where
-  show (LibexecNotFoundError exe dir) =
-    libexecNotFoundError exe dir "https://github.com/DanielG/cabal-helper/issues"
-
-findLibexecExe :: IO FilePath
-findLibexecExe = do
-    libexecdir <- getLibexecDir
-    let exeName = "cabal-helper-wrapper"
-        exe = libexecdir </> exeName FP.<.> exeExtension'
-
-    exists <- doesFileExist exe
-
-    if exists
-       then return exe
-       else do
-         mdir <- tryFindCabalHelperTreeLibexecDir
-         case mdir of
-           Nothing ->
-               error $ throw $ LibexecNotFoundError exeName libexecdir
-           Just dir ->
-               return $ dir </> "dist" </> "build" </> exeName </> exeName
-
-tryFindCabalHelperTreeLibexecDir :: IO (Maybe FilePath)
-tryFindCabalHelperTreeLibexecDir = do
-  exe <- getExecutablePath'
-  dir <- case takeFileName exe of
-    "ghc" -> do -- we're probably in ghci; try CWD
-        getCurrentDirectory
-    _ ->
-        return $ (!!4) $ iterate takeDirectory exe
-  exists <- doesFileExist $ dir </> "cabal-helper.cabal"
-  return $ if exists
-             then Just dir
-             else Nothing
-
-libexecNotFoundError :: String   -- ^ Name of the executable we were trying to
-                                 -- find
-                     -> FilePath -- ^ Path to @$libexecdir@
-                     -> String   -- ^ URL the user will be directed towards to
-                                 -- report a bug.
-                     -> String
-libexecNotFoundError exe dir reportBug = printf
- ( "Could not find $libexecdir/%s\n"
- ++"\n"
- ++"If you are a cabal-helper developer you can set the environment variable\n"
- ++"`cabal_helper_libexecdir' to override $libexecdir[1]. The following will\n"
- ++"work in the cabal-helper source tree:\n"
- ++"\n"
- ++"    $ export cabal_helper_libexecdir=$PWD/dist/build/%s\n"
- ++"\n"
- ++"[1]: %s\n"
- ++"\n"
- ++"If you don't know what I'm talking about something went wrong with your\n"
- ++"installation. Please report this problem here:\n"
- ++"\n"
- ++"    %s") exe exe dir reportBug
-
-getExecutablePath' :: IO FilePath
-getExecutablePath' =
-#if MIN_VERSION_base(4,6,0)
-    getExecutablePath
-#else
-    getProgName
-#endif
-
-lookupEnv' :: String -> IO (Maybe String)
-lookupEnv' k = lookup k <$> getEnvironment
-
-exeExtension' :: FilePath
-exeExtension' = Distribution.Simple.BuildPaths.exeExtension