hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ghcVersion -> CabalApi.

This commit is contained in:
Kazu Yamamoto 2013-03-04 13:55:03 +09:00
parent 13bb6cb599
commit 69cc0f8ce4
2 changed files with 25 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
CabalApi.hs
View File

@ -6,16 +6,22 @@ module CabalApi (
, cabalBuildInfo , cabalBuildInfo
, cabalAllDependPackages , cabalAllDependPackages
, cabalAllExtentions , cabalAllExtentions
, getGHCVersion
) where ) where
import Control.Applicative import Control.Applicative
import Control.Exception (throwIO)
import Data.List (intercalate)
import Data.Maybe (fromJust, maybeToList, mapMaybe) import Data.Maybe (fromJust, maybeToList, mapMaybe)
import Data.Set (fromList, toList) import Data.Set (fromList, toList)
import Distribution.Package (Dependency(Dependency), PackageName(PackageName)) import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
import Distribution.PackageDescription import Distribution.PackageDescription
import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Simple.Program (ghcProgram)
import Distribution.Simple.Program.Types (programName, programFindVersion)
import Distribution.Text (display) import Distribution.Text (display)
import Distribution.Verbosity (silent) import Distribution.Verbosity (silent)
import Distribution.Version (versionBranch)
import Language.Haskell.Extension (Extension(..)) import Language.Haskell.Extension (Extension(..))
import System.FilePath import System.FilePath
import Types import Types
@ -129,3 +135,18 @@ fromPackageDescription f1 f2 f3 f4 pd = lib ++ exe ++ tests ++ bench
uniqueAndSort :: [String] -> [String] uniqueAndSort :: [String] -> [String]
uniqueAndSort = toList . fromList uniqueAndSort = toList . fromList
----------------------------------------------------------------
getGHCVersion :: IO (String, Int)
getGHCVersion = ghcVer >>= toTupple
where
ghcVer = programFindVersion ghcProgram silent (programName ghcProgram)
toTupple Nothing = throwIO $ userError "ghc not found"
toTupple (Just v)
| length vs < 2 = return (verstr, 0)
| otherwise = return (verstr, ver)
where
vs = versionBranch v
ver = (vs !! 0) * 100 + (vs !! 1)
verstr = intercalate "." . map show $ vs

24
Cradle.hs
View File

@ -1,13 +1,10 @@
module Cradle where module Cradle where
import CabalApi (getGHCVersion)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Exception (throwIO) import Control.Exception (throwIO)
import Control.Monad import Control.Monad
import Data.List (isSuffixOf, intercalate) import Data.List (isSuffixOf)
import Distribution.Simple.Program (ghcProgram)
import Distribution.Simple.Program.Types (programName, programFindVersion)
import Distribution.Verbosity (silent)
import Distribution.Version (versionBranch)
import System.Directory import System.Directory
import System.FilePath ((</>),takeDirectory) import System.FilePath ((</>),takeDirectory)
import Types import Types
@ -15,7 +12,7 @@ import Types
-- An error would be thrown -- An error would be thrown
findCradle :: Maybe FilePath -> IO Cradle findCradle :: Maybe FilePath -> IO Cradle
findCradle (Just sbox) = do findCradle (Just sbox) = do
(strver, ver) <- ghcVersion (strver, ver) <- getGHCVersion
conf <- checkPackageConf sbox strver conf <- checkPackageConf sbox strver
let confOpts = ghcPackageConfOptions ver conf let confOpts = ghcPackageConfOptions ver conf
wdir <- getCurrentDirectory wdir <- getCurrentDirectory
@ -36,7 +33,7 @@ findCradle (Just sbox) = do
, cradleGHCVersion = strver , cradleGHCVersion = strver
} }
findCradle Nothing = do findCradle Nothing = do
(strver, ver) <- ghcVersion (strver, ver) <- getGHCVersion
wdir <- getCurrentDirectory wdir <- getCurrentDirectory
cfiles <- cabalDir wdir cfiles <- cabalDir wdir
case cfiles of case cfiles of
@ -72,19 +69,6 @@ cabalDir dir = do
where where
isCabal name = ".cabal" `isSuffixOf` name && length name > 6 isCabal name = ".cabal" `isSuffixOf` name && length name > 6
ghcVersion :: IO (String, Int)
ghcVersion = ghcVer >>= toTupple
where
ghcVer = programFindVersion ghcProgram silent (programName ghcProgram)
toTupple Nothing = throwIO $ userError "ghc not found"
toTupple (Just v)
| length vs < 2 = return (verstr, 0)
| otherwise = return (verstr, ver)
where
vs = versionBranch v
ver = (vs !! 0) * 100 + (vs !! 1)
verstr = intercalate "." . map show $ vs
packageConfName :: FilePath -> String -> FilePath packageConfName :: FilePath -> String -> FilePath
packageConfName path ver = path </> "packages-" ++ ver ++ ".conf" packageConfName path ver = path </> "packages-" ++ ver ++ ".conf"