{-# LANGUAGE TypeFamilies, FlexibleContexts, ScopedTypeVariables #-}
module Distribution.HaskellSuite.Compiler
(
Is(..)
, CompileFn
, Simple
, simple
, main
, customMain
)
where
import Distribution.Version
import Distribution.HaskellSuite.Packages
import {-# SOURCE #-} Distribution.HaskellSuite.Cabal
import Distribution.Simple.Compiler
import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.InstalledPackageInfo (InstalledPackageInfo, sourcePackageId)
import Distribution.Package
import Distribution.Text
import Distribution.ModuleName (ModuleName)
import Control.Monad
import Control.Exception
import Data.List
import Data.Function
import Language.Haskell.Exts.CPP
import Language.Haskell.Exts.Extension
type CompileFn
= FilePath
-> Maybe Language
-> [Extension]
-> CpphsOptions
-> PackageId
-> PackageDBStack
-> [UnitId]
-> [FilePath]
-> IO ()
class IsPackageDB (DB compiler) => Is compiler where
type DB compiler
name :: compiler -> String
version :: compiler -> Version
fileExtensions :: compiler -> [String]
compile :: compiler -> CompileFn
languages :: compiler -> [Language]
languageExtensions :: compiler -> [Extension]
installLib
:: compiler
-> FilePath
-> FilePath
-> Maybe FilePath
-> PackageIdentifier
-> [ModuleName]
-> IO ()
installLib t buildDir targetDir _dynlibTargetDir _pkg mods =
forM_ (fileExtensions t) $ \ext ->
findModuleFiles [buildDir] [ext] mods
>>= installOrdinaryFiles normal targetDir
register
:: compiler
-> PackageDB
-> InstalledPackageInfo
-> IO ()
register _tool 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 = installedUnitId pkg
writePackageDB db $ pkg : removePackage pkgid pkgs
unregister
:: compiler
-> PackageDB
-> PackageId
-> IO ()
unregister _tool dbspec pkg = do
let
pkgCriterion =
(case versionNumbers $ pkgVersion $ packageId pkg of
[] ->
((==) `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 (installedUnitId p)
writePackageDB db packagesLeft
list
:: compiler
-> PackageDB
-> IO ()
list _tool 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 . installedUnitId
removePackage :: UnitId -> Packages -> Packages
removePackage pkgid = filter ((pkgid /=) . installedUnitId)
data Simple db = Simple
{ stName :: String
, stVer :: Version
, stLangs :: [Language]
, stLangExts :: [Extension]
, stCompile :: CompileFn
, stExts :: [String]
}
simple
:: String
-> Version
-> [Language]
-> [Extension]
-> CompileFn
-> [String]
-> 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