packages feed

haskell-packages (empty) → 0.1

raw patch · 11 files changed

+1119/−0 lines, 11 filesdep +Cabaldep +EitherTdep +aesonsetup-changed

Dependencies added: Cabal, EitherT, aeson, base, bytestring, containers, deepseq, directory, filepath, haskell-src-exts, hse-cpp, mtl, optparse-applicative, tagged

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2012 Roman Cheplyaka++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ README.md view
@@ -0,0 +1,72 @@+There are two cases when you may need haskell-packages: if you are writing a+Haskell compiler (or any tool that processes Haskell source code, such as a+static analyzer), or if you want to integrate with an existing Haskell compiler+that uses haskell-packages.++## Writing a compiler++If you are writing a compiler, you typically want to integrate it with Cabal, to+be able to build ordinary Haskell packages.++If you go the hard way, this involves:++1. **Parsing command line parameters**. Sounds easy — just take a list of files to+    compile. In reality you also need to handle package ids and package dbs, CPP+    options (`-DFOO=1`), language extension flags (`-XRankNTypes`) etc.++    To integrate with Cabal, you also need to tell it the list of installed+    packages, supported languages and extensions etc.++2. Actual **integration with Cabal** means understanding how Cabal works and+    hard-coding support for your compiler. And then getting it accepted and+    waiting for the next Cabal release.++    You may pretend that you are GHC or other compiler that is already supported+    by Cabal. It might work, but often it won't, for various reasons. Also,+    GHC's command line protocol is quite complex.++3. **Package management**. You need to implement a package db mechanism, which would+    let you to keep track of installed packages. Then you'd have to implement a+    `ghc-pkg`-like tool to manage those databases, for both Cabal and your users.++**Or**, you can simply use this library!++It already has command line options parsing, Cabal support, and package+management. All you need to do is to provide the function to do actual+compilation and tell a couple of other things about your compiler. See+the `Distribution.HaskellSuite.Compiler` module for details.++## Using other compilers++Some compilers produce artifacts that you may want to use. A good example is the+`gen-iface` compiler from haskell-names which generates an *interface* for each+module — the set of all named entities (functions, types, classes) that are+exported by that module. This information can be then used either by other+compilers, or by tools like IDEs.++Assuming the compiler uses haskell-packages and exports its database type, it's+very easy to use its artifacts. See `Distribution.HaskellSuite.Packages` for+package resolution and `Distribution.HaskellSuite.Modules` for module+resolution.++## Installation++Note that haskell-packages uses (yet unreleased) haskell-src-exts 1.14. Get it+[here][hse].++It doesn't matter what Cabal version you use together with haskell-packages, but+if you want to invoke a haskell-packages compiler from Cabal (see+[Usage](#usage)), you need to build our [fork of Cabal][Cabal]. Eventually it+will be merged into Cabal.++[hse]: https://github.com/haskell-suite/haskell-src-exts+[Cabal]: https://github.com/feuerbach/Cabal++## Usage++To compile a Haskell package using a haskell-packages tool:++    cabal install --haskell-suite -w $TOOL++where `$TOOL` may be either a full path to the compiler, or just an executable+name if it's in `$PATH`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ haskell-packages.cabal view
@@ -0,0 +1,56 @@+-- Initial haskell-packages.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                haskell-packages+version:             0.1+synopsis:            Haskell suite library for package management and integration with Cabal+description:         See <http://haskell-suite.github.io/haskell-packages/>+license:             MIT+license-file:        LICENSE+author:              Roman Cheplyaka+maintainer:          Roman Cheplyaka <roma@ro-che.info>+copyright:           (c) Roman Cheplyaka 2012+category:            Distribution+homepage:            http://haskell-suite.github.io/haskell-packages/+bug-reports:         https://github.com/haskell-suite/haskell-packages/issues+build-type:          Simple+cabal-version:       >=1.10+extra-source-files:+  README.md++source-repository head+  type:     git+  location: git://github.com/haskell-suite/haskell-packages.git++source-repository this+  type:     git+  location: git://github.com/haskell-suite/haskell-packages.git+  tag:      v0.1++library+  default-language:    Haskell2010+  Hs-source-dirs:+    src+  exposed-modules:+    Distribution.HaskellSuite+    Distribution.HaskellSuite.Compiler+    Distribution.HaskellSuite.Packages+    Distribution.HaskellSuite.Modules+  other-modules:+    Distribution.HaskellSuite.Cabal+    Paths_haskell_packages+  build-depends:+      base >=4.5 && < 5+    , optparse-applicative >= 0.5.1+    , aeson == 0.6.*+    , bytestring >=0.9+    , Cabal >= 1.16+    , deepseq+    , directory+    , filepath+    , containers+    , mtl+    , hse-cpp+    , EitherT+    , haskell-src-exts >= 1.14+    , tagged
+ src/Distribution/HaskellSuite.hs view
@@ -0,0 +1,16 @@+-- | This module re-exports all you need in order to /read/ package+-- databases and module info files created by compilers that use+-- haskell-packages.+--+-- If you are writing a compiler, i.e. a program that creates or writes+-- package databases or module info files — then take a look at+-- "Distribution.HaskellSuite.Compiler". It provides command-line+-- options handling and Cabal integration.+module Distribution.HaskellSuite+  ( module Distribution.HaskellSuite.Packages+  , module Distribution.HaskellSuite.Modules+  )+  where++import Distribution.HaskellSuite.Packages+import Distribution.HaskellSuite.Modules
+ src/Distribution/HaskellSuite/Cabal.hs view
@@ -0,0 +1,213 @@+-- | This module provides Cabal integration.+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}++module Distribution.HaskellSuite.Cabal+  ( main )+  where++import Data.Typeable+import Data.Version+import Data.List+import Data.Monoid+import Data.Proxy+import Distribution.Simple.Compiler+import Distribution.InstalledPackageInfo+  ( showInstalledPackageInfo+  , parseInstalledPackageInfo )+import Distribution.ParseUtils+import Distribution.Package+import Distribution.Text+import Distribution.ModuleName hiding (main)+import Options.Applicative+import Control.Monad+import Control.Monad.Trans.Either+import Control.Exception+import Text.Printf+import qualified Distribution.HaskellSuite.Compiler as Compiler+import Distribution.HaskellSuite.Packages+import Language.Haskell.Exts.Extension+import Paths_haskell_packages as Our (version)+import System.FilePath+import System.Directory++-- It is actually important that we import 'defaultCpphsOptions' from+-- hse-cpp and not from cpphs, because they are different. hse-cpp version+-- provides the defaults more compatible with haskell-src-exts.+import Language.Haskell.Exts.Annotated.CPP++main+  :: forall c . Compiler.Is c+  => c -> IO ()+main t =+  join $ customExecParser (prefs noBacktrack) $ info (helper <*> optParser) idm+  where++  optParser =+    foldr (<|>) empty+      [ version+      , compilerVersion+      , hspkgVersion+      , supportedLanguages+      , supportedExtensions+      , subparser $ pkgCommand <> compilerCommand+      ]++  versionStr = showVersion $ Compiler.version t+  ourVersionStr = showVersion Our.version++  compilerVersion =+    flag'+      (printf "%s %s\n" (Compiler.name t) versionStr)+      (long "compiler-version")++  hspkgVersion =+    flag'+      (putStrLn ourVersionStr)+      (long "hspkg-version")++  supportedLanguages =+    flag'+      (mapM_ (putStrLn . prettyLanguage) $ Compiler.languages t)+      (long "supported-languages")++  supportedExtensions =+    flag'+      (mapM_ (putStrLn . prettyExtension) $ Compiler.languageExtensions t)+      (long "supported-extensions")++  version =+    flag'+      (printf "%s %s\nBased on haskell-packages version %s\n" (Compiler.name t) versionStr ourVersionStr)+      (long "version")++  pkgCommand =+    command "pkg" (info (subparser pkgSubcommands) idm)+  pkgSubcommands =+    mconcat+      [ pkgDump+      , pkgInstallLib+      , pkgUpdate+      , pkgUnregister+      , pkgList+      , pkgInit+      ]++  pkgDump = command "dump" $ info (doDump <$> pkgDbStackParser) idm+    where+      doDump dbs = do+        pkgs <-+          fmap concat $+          forM dbs $ \db ->+            getInstalledPackages+              (Proxy :: Proxy (Compiler.DB c))+              db+        putStr $ intercalate "---\n" $ map showInstalledPackageInfo pkgs++  pkgInstallLib = command "install-library" $ flip info idm $+    Compiler.installLib t <$>+      (strOption (long "build-dir" <> metavar "PATH")) <*>+      (strOption (long "target-dir" <> metavar "PATH")) <*>+      (optional $ strOption (long "dynlib-target-dir" <> metavar "PATH")) <*>+      (nullOption (long "package-id" <> metavar "ID" <> reader parsePackageId)) <*>+      (arguments simpleParse (metavar "MODULE"))+    where+      parsePackageId str =+        maybe+          (Left . ErrorMsg $ "could not parse package-id: " ++ str)+          Right+          (simpleParse str)++  pkgUpdate =+    command "update" $ flip info idm $+      doRegister <$> pkgDbParser++  doRegister d = do+    pi <- parseInstalledPackageInfo <$> getContents+    case pi of+      ParseOk _ a -> Compiler.register t d a+      ParseFailed e -> putStrLn $ snd $ locatedErrorMsg e++  pkgUnregister =+    command "unregister" $ flip info idm $+      Compiler.unregister t <$> pkgDbParser <*> pkgIdParser++  pkgInit =+    command "init" $ flip info idm $+      initDB <$> argument str (metavar "PATH")++  pkgList =+    command "list" $ flip info idm $+      Compiler.list t <$> pkgDbParser++  compilerCommand =+    command "compile" (info compiler idm)+  compiler =+    (\srcDirs buildDir lang exts cppOpts dbStack pkgids mods ->+        Compiler.compile t buildDir lang exts cppOpts dbStack pkgids =<< findModules srcDirs mods) <$>+      (many $ strOption (short 'i' <> metavar "PATH")) <*>+      (strOption (long "build-dir" <> metavar "PATH") <|> pure ".") <*>+      (optional $ classifyLanguage <$> strOption (short 'G' <> metavar "language")) <*>+      (many $ parseExtension <$> strOption (short 'X' <> metavar "extension")) <*>+      cppOptsParser <*>+      pkgDbStackParser <*>+      (many $ InstalledPackageId <$> strOption (long "package-id")) <*>+      arguments str (metavar "MODULE")++data ModuleNotFound = ModuleNotFound String+  deriving Typeable++instance Show ModuleNotFound where+  show (ModuleNotFound mod) = printf "Module %s not found" mod+instance Exception ModuleNotFound++findModules srcDirs = mapM (findModule srcDirs)+findModule srcDirs mod = do+  r <- runEitherT $ sequence_ (checkInDir <$> srcDirs <*> exts)+  case r of+    Left found -> return found+    Right {} -> throwIO $ ModuleNotFound mod++  where+    exts = ["hs", "lhs"]++    checkInDir dir ext = EitherT $ do+      let file = dir </> toFilePath (fromString mod) <.> ext+      found <- doesFileExist file+      return $ if found+        then Left file+        else Right ()++pkgDbParser :: Parser PackageDB+pkgDbParser =+  flag' GlobalPackageDB (long "global") <|>+  flag' UserPackageDB   (long "user")   <|>+  (SpecificPackageDB <$> strOption (long "package-db" <> metavar "PATH"))++pkgIdParser :: Parser PackageId+pkgIdParser =+  argument simpleParse (metavar "PACKAGE")++pkgDbStackParser :: Parser PackageDBStack+pkgDbStackParser =+  (\fs -> if null fs then [GlobalPackageDB] else fs) <$>+    many pkgDbParser++cppOptsParser :: Parser CpphsOptions+cppOptsParser = appEndo <$> allMod <*> pure defaultCpphsOptions+  where+    allMod = fmap mconcat $ many $ define <|> includeDir++    define =+      flip fmap (strOption (short 'D' <> metavar "sym[=var]")) $+      \str ->+        let+          def :: (String, String)+          def =+            case span (/= '=') str of+              (_, []) -> (str, "")+              (sym, _:var) -> (sym, var)+          in Endo $ \opts -> opts { defines = def : defines opts }++    includeDir =+      flip fmap (strOption (short 'I' <> metavar "PATH")) $+      \str -> Endo $ \opts -> opts { includes = str : includes opts }
+ src/Distribution/HaskellSuite/Cabal.hs-boot view
@@ -0,0 +1,7 @@+module Distribution.HaskellSuite.Cabal where++import {-# SOURCE #-} qualified Distribution.HaskellSuite.Compiler as Compiler++main+  :: Compiler.Is c+  => c -> IO ()
+ src/Distribution/HaskellSuite/Compiler.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts, ScopedTypeVariables #-}+-- | This module is designed to be imported qualified:+--+-- >import qualified Distribution.HaskellSuite.Compiler as Compiler+module Distribution.HaskellSuite.Compiler+  (+  -- * Compiler description+    Is(..)+  , CompileFn++  -- * Simple compiler+  , Simple+  , simple++  -- * Command line+  -- | Compiler's entry point.+  --+  -- It parses command line options (that are typically passed by Cabal) and+  -- invokes the appropriate compiler's methods.+  , main+  )+  where++import Data.Version+import Distribution.HaskellSuite.Packages+import {-# SOURCE #-} Distribution.HaskellSuite.Cabal+import Distribution.Simple.Compiler+import Distribution.Simple.Utils+import Distribution.Verbosity+import Distribution.InstalledPackageInfo+import Distribution.Package+import Distribution.Text+import Distribution.ModuleName (ModuleName)+import Control.Monad+import Control.Exception+import Data.Maybe+import Data.List+import Data.Function+import Language.Haskell.Exts.Annotated.CPP+import Language.Haskell.Exts.Extension++-- | Compilation function+type CompileFn+  =  FilePath+  -> Maybe Language+  -> [Extension]+  -> CpphsOptions+  -> PackageDBStack+  -> [InstalledPackageId]+  -> [FilePath]+  -> IO ()++-- | An abstraction over a Haskell compiler.+--+-- Once you've written a @Compiler.@'Is' instance, you get Cabal+-- integration for free (via @Compiler@.'main').+--+-- Consider whether @Compiler.@'Simple' suits your needs — then you need to+-- write even less code.+--+-- Minimal definition: 'DB', 'name', 'version', 'fileExtensions',+-- 'compile', 'languages', 'languageExtensions'.+--+-- 'fileExtensions' are only used for 'installLib', so if you define+-- a custom 'installLib', 'fileExtensions' won't be used (but you'll still+-- get a compiler warning if you do not define it).+class IsPackageDB (DB compiler) => Is compiler where++  -- | The database type used by the compiler+  type DB compiler++  -- | Compiler's name. Should not contain spaces.+  name :: compiler -> String+  -- | Compiler's version+  version :: compiler -> Version+  -- | File extensions of the files generated by the compiler. Those files+  -- will be copied during the install phase.+  fileExtensions :: compiler -> [String]+  -- | How to compile a set of modules+  compile :: compiler -> CompileFn+  -- | Languages supported by this compiler (such as @Haskell98@,+  -- @Haskell2010@ etc.)+  languages :: compiler -> [Language]+  -- | Extensions supported by this compiler+  languageExtensions :: compiler -> [Extension]++  installLib+      :: compiler+      -> FilePath -- ^ build dir+      -> FilePath -- ^ target dir+      -> Maybe FilePath -- ^ target dir for dynamic libraries+      -> PackageIdentifier+      -> [ModuleName]+      -> IO ()+  installLib t buildDir targetDir _dynlibTargetDir _pkg mods =+    findModuleFiles [buildDir] (fileExtensions t) mods+      >>= installOrdinaryFiles normal targetDir++  -- | Register the package in the database. If a package with the same id+  -- is already installed, it should be replaced by the new one.+  register+    :: compiler+    -> PackageDB+    -> InstalledPackageInfo+    -> IO ()+  register t dbspec pkg = do+    mbDb <- locateDB dbspec++    case mbDb :: Maybe (DB compiler) of+      Nothing -> throwIO RegisterNullDB+      Just db -> do+        pkgs <- readPackageDB (maybeInitDB dbspec) db+        let pkgid = installedPackageId pkg+        writePackageDB db $ pkg : removePackage pkgid pkgs++  -- | Unregister the package+  unregister+    :: compiler+    -> PackageDB+    -> PackageId+    -> IO ()+  unregister t dbspec pkg = do+    let+      pkgCriterion =+        -- if the version is not specified, treat it as a wildcard+        (case pkgVersion $ packageId pkg of+          Version [] _ ->+            ((==) `on` pkgName) pkg+          _ ->+            (==) pkg)+        . sourcePackageId++    mbDb <- locateDB dbspec++    case mbDb :: Maybe (DB compiler) of+      Nothing -> throwIO RegisterNullDB+      Just db -> do+        pkgs <- readPackageDB (maybeInitDB dbspec) db++        let+          (packagesRemoved, packagesLeft) = partition pkgCriterion pkgs++        if null packagesRemoved+          then+            putStrLn $ "No packages removed"+          else do+            putStrLn "Packages removed:"+            forM_ packagesRemoved $ \p ->+              putStrLn $ "  " ++ display (installedPackageId p)++        writePackageDB db packagesLeft++  list+    :: compiler+    -> PackageDB+    -> IO ()+  list t dbspec = do+    mbDb <- locateDB dbspec++    case mbDb :: Maybe (DB compiler) of+      Nothing -> return ()+      Just db -> do+        pkgs <- readPackageDB (maybeInitDB dbspec) db++        forM_ pkgs $ putStrLn . display . installedPackageId++removePackage :: InstalledPackageId -> Packages -> Packages+removePackage pkgid = filter ((pkgid /=) . installedPackageId)++data Simple db = Simple+  { stName :: String+  , stVer :: Version+  , stLangs :: [Language]+  , stLangExts :: [Extension]+  , stCompile :: CompileFn+  , stExts :: [String]+  }++simple+  :: String -- ^ compiler name+  -> Version -- ^ compiler version+  -> [Language]+  -> [Extension]+  -> CompileFn+  -> [String] -- ^ extensions that generated file have+  -> Simple db+simple = Simple++instance IsPackageDB db => Is (Simple db) where+  type DB (Simple db) = db++  name = stName+  version = stVer+  fileExtensions = stExts+  compile = stCompile+  languages = stLangs+  languageExtensions = stLangExts
+ src/Distribution/HaskellSuite/Compiler.hs-boot view
@@ -0,0 +1,3 @@+module Distribution.HaskellSuite.Compiler where++class Is compiler
+ src/Distribution/HaskellSuite/Modules.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies,+             FlexibleInstances, TypeSynonymInstances,+             DeriveDataTypeable #-}+module Distribution.HaskellSuite.Modules+  (+  -- * Module monad+  -- | When you need to resolve modules, you work in a 'ModuleT' monad (or+  -- another monad that is an instance of 'MonadModule') and use the+  -- 'getModuleInfo' function.+  --+  -- It finds an installed module by its name and reads (and caches) its+  -- info from the info file. Then you run a 'ModuleT' monadic action+  -- using 'evalModuleT' or 'runModuleT'.+  --+  -- To run a 'ModuleT' action you'll also need to provide the set of+  -- packages (represented by their 'InstalledPackageInfo') in which to+  -- search for modules. You can get such a set from either+  -- 'getInstalledPackages' or 'readPackagesInfo', depending on your use+  -- case.+    ModuleT+  , getModuleInfo+  , evalModuleT+  , runModuleT+  , MonadModule(..)+  -- * Module names+  , ModName(..)+  , convertModuleName+  ) where++import Distribution.HaskellSuite.Packages+import Distribution.Simple.Compiler+import Distribution.Simple.Utils+import Distribution.InstalledPackageInfo+import Distribution.Package+import Distribution.Text+import Distribution.ModuleName+import Control.Applicative+import Control.Monad+import Control.Monad.State+import Control.Monad.Reader+import Control.Exception+import Data.List+import Data.Typeable+import Data.Proxy+import qualified Data.Map as Map+import Text.Printf+import System.FilePath++-- | This class defines the interface that is used by 'getModuleInfo', so+-- that you can use it in monads other than 'ModuleT'.+--+-- You don't typically have to define your own instances of this class, but+-- here are a couple of cases when you might:+--+-- * A pure (non-'MonadIO') mockup module monad for testing purposes+--+-- * A transformer over 'ModuleT'+--+-- * You need a more complex way to retrieve the module info+class Monad m => MonadModule m where+  -- | The type of module info+  type ModuleInfo m+  lookupInCache :: ModName n => n -> m (Maybe (ModuleInfo m))+  insertInCache :: ModName n => n -> ModuleInfo m -> m ()+  getPackages :: m Packages++  -- | Read the module info, given a list of search paths and the module+  -- name+  readModuleInfo :: ModName n => [FilePath] -> n -> m (ModuleInfo m)++-- | Different libraries (Cabal, haskell-src-exts, ...) use different types+-- to represent module names. Hence this class.+class ModName n where+  modToString :: n -> String++instance ModName String where+  modToString = id++instance ModName ModuleName where+  modToString = display++-- | Convert module name from arbitrary representation to Cabal's one+convertModuleName :: (ModName n) => n -> ModuleName+convertModuleName = fromString . modToString++-- | Tries to find the module in the current set of packages, then find the+-- module's info file, and reads and caches its contents.+--+-- Returns 'Nothing' if the module could not be found in the current set of+-- packages. If the module is found, but something else goes wrong (e.g.+-- there's no info file for it), an exception is thrown.+getModuleInfo :: (MonadModule m, ModName n) => n -> m (Maybe (ModuleInfo m))+getModuleInfo name = do+  cached <- lookupInCache name+  case cached of+    Just i -> return $ Just i+    Nothing -> do+      pkgs <- getPackages+      case findModule'sPackage pkgs name of+        Nothing -> return Nothing+        Just pkg -> do+          i <- readModuleInfo (libraryDirs pkg) name+          insertInCache name i+          return $ Just i++findModule'sPackage :: ModName n => Packages -> n -> Maybe InstalledPackageInfo+findModule'sPackage pkgs m = find ((convertModuleName m `elem`) . exposedModules) pkgs++-- | A standard module monad transformer.+--+-- @i@ is the type of module info, @m@ is the underlying monad.+newtype ModuleT i m a =+  ModuleT+    (StateT (Map.Map ModuleName i)+      (ReaderT (Packages, [FilePath] -> ModuleName -> m i) m)+      a)+  deriving (Functor, Applicative, Monad)++instance MonadTrans (ModuleT i) where+  lift = ModuleT . lift . lift++instance MonadIO m => MonadIO (ModuleT i m) where+  liftIO = ModuleT . liftIO++instance (Functor m, Monad m) => MonadModule (ModuleT i m) where+  type ModuleInfo (ModuleT i m) = i+  lookupInCache n = ModuleT $ Map.lookup (convertModuleName n) <$> get+  insertInCache n i = ModuleT $ modify $ Map.insert (convertModuleName n) i+  getPackages = ModuleT $ asks fst+  readModuleInfo dirs mod =+    lift =<< ModuleT (asks snd) <*> pure dirs <*> pure (convertModuleName mod)++-- | Run a 'ModuleT' action+runModuleT+  :: MonadIO m+  => ModuleT i m a -- ^ the monadic action to run+  -> Packages -- ^ packages in which to look for modules+  -> String -- ^ file extension of info files+  -> (FilePath -> m i) -- ^ how to read information from an info file+  -> Map.Map ModuleName i -- ^ initial set of module infos+  -> m (a, Map.Map ModuleName i)+  -- ^ return value, plus all cached module infos (that is, the initial set+  -- plus all infos that have been read by the action itself)+runModuleT (ModuleT a) pkgs suffix readInfo modMap =+  runReaderT (runStateT a modMap) (pkgs, findAndReadInfo)+  where+    findAndReadInfo dirs name = do+      (base, rel) <- liftIO $ findModuleFile dirs [suffix] name+      readInfo $ base </> rel++-- | Run a 'ModuleT' action.+--+-- This is a simplified version of 'runModuleT'.+evalModuleT+  :: MonadIO m+  => ModuleT i m a -- ^ the monadic action to run+  -> Packages -- ^ packages in which to look for modules+  -> String -- ^ file extension of info files+  -> (FilePath -> m i) -- ^ how to read information from an info file+  -> m a+evalModuleT a pkgs suffix readInfo =+  fst `liftM` runModuleT a pkgs suffix readInfo Map.empty
+ src/Distribution/HaskellSuite/Packages.hs view
@@ -0,0 +1,372 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable,+             TemplateHaskell, ScopedTypeVariables, OverloadedStrings #-}+module Distribution.HaskellSuite.Packages+  (+  -- * Querying package databases+  -- | 'getInstalledPackages' and 'readPackagesInfo' can be used to get+  -- package information from package databases.+  --+  -- They use the 'IsPackageDB' interface, so that you can use them with+  -- your own, custom databases.+  --+  -- Use 'getInstalledPackages' to get all packages defined in a particular+  -- database, and 'readPackagesInfo' when you're searching for+  -- a particular set of packages in a set of databases.+    Packages+  , getInstalledPackages+  , readPackagesInfo+  -- * IsPackageDB class and friends+  , IsPackageDB(..)+  , MaybeInitDB(..)+  , maybeInitDB+  -- * StandardDB+  -- | 'StandardDB' is a simple `IsPackageDB` implementation which cover many+  -- (but not all) use cases. Please see the source code to see what+  -- assumptions it makes and whether they hold for your use case.+  , StandardDB(..)+  , IsDBName(..)++  -- * Auxiliary functions+  -- | 'writeDB' and 'readDB' perform (de)serialization of a package+  -- database using a simple JSON encoding. You may use these to implement+  -- 'writePackageDB' and 'readPackageDB' for your own databases.+  , writeDB+  , readDB+  , initDB+  -- * Exceptions+  , PkgDBError(..)+  , PkgInfoError(..)+  )+  where++import Data.Aeson+import Data.Aeson.Types+import Control.Applicative+import qualified Data.ByteString      as BS+import qualified Data.ByteString.Lazy as LBS+import Control.Exception as E+import Control.Monad+import Data.Typeable+import Data.Tagged+import Data.Proxy+import qualified Data.Map as Map+import Text.Printf+import qualified Distribution.InstalledPackageInfo as Info+import Distribution.Package+import Distribution.Text+import System.FilePath+import System.Directory++-- The following imports are needed only for JSON instances+import Data.Version (Version(..))+import Distribution.Simple.Compiler (PackageDB(..))+import Distribution.License (License(..))+import Distribution.ModuleName(ModuleName)++--------------+-- Querying --+--------------++type Packages = [Info.InstalledPackageInfo]++-- | Get all packages that are registered in a particular database+--+-- If the database doesn't exist, the behaviour is determined by+-- 'maybeInitDB'.+getInstalledPackages+  :: forall db. IsPackageDB db+  => Proxy db+  -> PackageDB+  -> IO Packages+getInstalledPackages _proxy dbspec = do+  mbDb <- locateDB dbspec++  maybe+    (return [])+    (readPackageDB $ maybeInitDB dbspec)+    (mbDb :: Maybe db)++-- | Try to retrieve an 'InstalledPackageInfo' for each of+-- 'InstalledPackageId's from a specified set of 'PackageDB's.+--+-- May throw a 'PkgInfoNotFound' exception.+--+-- If a database doesn't exist, the behaviour is determined by+-- 'maybeInitDB'.+readPackagesInfo+  :: IsPackageDB db+  => Proxy db -> [PackageDB] -> [InstalledPackageId] -> IO Packages+readPackagesInfo proxyDb dbs pkgIds = do+  allPkgInfos <- concat <$> mapM (getInstalledPackages proxyDb) dbs+  let+    pkgMap =+      Map.fromList+        [ (Info.installedPackageId pkgInfo, pkgInfo)+        | pkgInfo <- allPkgInfos+        ]+  forM pkgIds $ \pkgId ->+    maybe+      (throwIO $ PkgInfoNotFound pkgId)+      return+      (Map.lookup pkgId pkgMap)++---------------------------+-- IsPackageDB & friends --+---------------------------++-- | Package database class.+--+-- @db@ will typically be a newtype-wrapped path to the database file,+-- although more sophisticated setups are certainly possible.+  --+  -- Consider using 'StandardDB' first, and implement your own database+  -- type if that isn't enough.+class IsPackageDB db where++  -- | The name of the database. Used to construct some paths.+  dbName :: Tagged db String++  -- | Read a package database.+  --+  -- If the database does not exist, then the first argument tells whether+  -- we should create and initialize it with an empty package list. In+  -- that case, if 'Don'tInitDB' is specified, a 'BadPkgDb' exception is+  -- thrown.+  readPackageDB :: MaybeInitDB -> db -> IO Packages++  -- | Write a package database+  writePackageDB :: db -> Packages -> IO ()++  -- | Get the location of a global package database (if there's one)+  globalDB :: IO (Maybe db)++  -- | Create a db object given a database file path+  dbFromPath :: FilePath -> IO db++  -- Methods that have default implementations++  -- | Convert a package db specification to a db object+  locateDB :: PackageDB -> IO (Maybe db)+  locateDB GlobalPackageDB = globalDB+  locateDB UserPackageDB = Just <$> userDB+  locateDB (SpecificPackageDB p) = Just <$> dbFromPath p++  -- | The user database+  userDB :: IO db+  userDB = do+    let name = untag (dbName :: Tagged db String)+    path <- (</>) <$> haskellPackagesDir <*> pure (name <.> "db")+    dbFromPath path++-- | A flag which tells whether the library should create an empty package+-- database if it doesn't exist yet+data MaybeInitDB = InitDB | Don'tInitDB++-- | This function determines whether a package database should be+-- initialized if it doesn't exist yet.+--+-- The rule is this: if it is a global or a user database, then initialize+-- it; otherwise, don't.+--+-- Rationale: if the database was specified by the user, she could have+-- made a mistake in the path, and we'd rather report it. On the other+-- hand, it is our responsibility to ensure that the user and global+-- databases exist.+maybeInitDB :: PackageDB -> MaybeInitDB+maybeInitDB GlobalPackageDB = InitDB+maybeInitDB UserPackageDB   = InitDB+maybeInitDB SpecificPackageDB {} = Don'tInitDB++----------------+-- StandardDB --+----------------++class IsDBName name where+  getDBName :: Tagged name String++data StandardDB name = StandardDB FilePath++instance IsDBName name => IsPackageDB (StandardDB name) where+  dbName = retag (getDBName :: Tagged name String)++  readPackageDB init (StandardDB db) = readDB init db+  writePackageDB (StandardDB db) = writeDB db+  globalDB = return Nothing+  dbFromPath path = return $ StandardDB path++-------------------------+-- Auxiliary functions --+-------------------------++writeDB :: FilePath -> Packages -> IO ()+writeDB path db = LBS.writeFile path $ encode db++readDB :: MaybeInitDB -> FilePath -> IO Packages+readDB maybeInit path = do+  maybeDoInitDB++  cts <- LBS.fromChunks . return <$> BS.readFile path+    `E.catch` \e ->+      throwIO $ PkgDBReadError path e+  maybe (throwIO $ BadPkgDB path) return $ decode' cts++  where+    maybeDoInitDB+      | InitDB <- maybeInit = initDB path+      | otherwise = return ()++-- | If the path does not exist, create an empty database there. Otherwise,+-- do nothing.+initDB :: FilePath -> IO ()+initDB path = do+  dbExists <- doesFileExist path+  unless dbExists $ do+    writeDB path []++haskellPackagesDir :: IO FilePath+haskellPackagesDir = getAppUserDataDirectory "haskell-packages"++----------------+-- Exceptions --+----------------++errPrefix :: String+errPrefix = "haskell-suite package manager"++data PkgDBError+  = BadPkgDB FilePath -- ^ package database could not be parsed or contains errors+  | PkgDBReadError FilePath IOException -- ^ package db file could not be read+  | PkgExists InstalledPackageId -- ^ attempt to register an already present package id+  | RegisterNullDB -- ^ attempt to register in the global db when it's not present+  deriving (Typeable)+instance Show PkgDBError where+  show (BadPkgDB path) =+    printf "%s: bad package database at %s" errPrefix path+  show (PkgDBReadError path e) =+    printf "%s: package db at %s could not be read: %s"+      errPrefix path (show e)+  show (PkgExists pkgid) =+    printf "%s: package %s is already in the database" errPrefix (display pkgid)+  show (RegisterNullDB) =+    printf "%s: attempt to register in a null global db" errPrefix+instance Exception PkgDBError++data PkgInfoError+  = PkgInfoNotFound InstalledPackageId+  -- ^ requested package id could not be found in any of the package databases+  deriving Typeable+instance Exception PkgInfoError+instance Show PkgInfoError where+  show (PkgInfoNotFound pkgid) =+    printf "%s: package not found: %s" errPrefix (display pkgid)++---------------------+-- Aeson instances --+---------------------++stdToJSON :: Text a => a -> Value+stdToJSON = toJSON . display+stdFromJSON :: Text a => Value -> Parser a+stdFromJSON = maybe mzero return . simpleParse <=< parseJSON++instance ToJSON License where+  toJSON = stdToJSON+instance FromJSON License where+  parseJSON = stdFromJSON++instance ToJSON Version where+  toJSON = stdToJSON+instance FromJSON Version where+  parseJSON = stdFromJSON++instance ToJSON ModuleName where+  toJSON = stdToJSON+instance FromJSON ModuleName where+  parseJSON = stdFromJSON++instance ToJSON PackageName where+  toJSON = stdToJSON+instance FromJSON PackageName where+  parseJSON = stdFromJSON++instance ToJSON PackageIdentifier where+  toJSON = stdToJSON+instance FromJSON PackageIdentifier where+  parseJSON = stdFromJSON++instance ToJSON InstalledPackageId where+  toJSON = stdToJSON+instance FromJSON InstalledPackageId where+  parseJSON = stdFromJSON++instance ToJSON a => ToJSON (Info.InstalledPackageInfo_ a) where+  toJSON i = object+    [ "id" .= Info.installedPackageId i+    , "name" .= Info.sourcePackageId i+    , "license" .= Info.license i+    , "copyright" .= Info.copyright i+    , "maintainer" .= Info.maintainer i+    , "author" .= Info.author i+    , "stability" .= Info.stability i+    , "homepage" .= Info.homepage i+    , "package-url" .= Info.pkgUrl i+    , "synopsis" .= Info.synopsis i+    , "description" .= Info.description i+    , "category" .= Info.category i+    , "exposed" .= Info.exposed i+    , "exposed-modules" .= Info.exposedModules i+    , "hidden-modules" .= Info.hiddenModules i+    , "trusted" .= Info.trusted i+    , "import-dirs" .= Info.importDirs i+    , "library-dirs" .= Info.libraryDirs i+    , "hs-libraries" .= Info.hsLibraries i+    , "extra-libraries" .= Info.extraLibraries i+    , "extra-ghci-libraries" .= Info.extraGHCiLibraries i+    , "include-dirs" .= Info.includeDirs i+    , "includes" .= Info.includes i+    , "depends" .= Info.depends i+    , "hugs-options" .= Info.hugsOptions i+    , "cc-options" .= Info.ccOptions i+    , "ld-options" .= Info.ldOptions i+    , "framework-dirs" .= Info.frameworkDirs i+    , "frameworks" .= Info.frameworks i+    , "haddock-interfaces" .= Info.haddockInterfaces i+    , "haddock-html" .= Info.haddockHTMLs i+    ]++-- FIXME this will break silently if the order of fields changes in the+-- future+instance FromJSON a => FromJSON (Info.InstalledPackageInfo_ a) where+  parseJSON (Object v) = Info.InstalledPackageInfo <$>+    v .: "id" <*>+    v .: "name" <*>+    v .: "license" <*>+    v .: "copyright" <*>+    v .: "maintainer" <*>+    v .: "author" <*>+    v .: "stability" <*>+    v .: "homepage" <*>+    v .: "package-url" <*>+    v .: "synopsis" <*>+    v .: "description" <*>+    v .: "category" <*>+    v .: "exposed" <*>+    v .: "exposed-modules" <*>+    v .: "hidden-modules" <*>+    v .: "trusted" <*>+    v .: "import-dirs" <*>+    v .: "library-dirs" <*>+    v .: "hs-libraries" <*>+    v .: "extra-libraries" <*>+    v .: "extra-ghci-libraries" <*>+    v .: "include-dirs" <*>+    v .: "includes" <*>+    v .: "depends" <*>+    v .: "hugs-options" <*>+    v .: "cc-options" <*>+    v .: "ld-options" <*>+    v .: "framework-dirs" <*>+    v .: "frameworks" <*>+    v .: "haddock-interfaces" <*>+    v .: "haddock-html"+  parseJSON _ = mzero