Permalink
Browse files

Wall police

  • Loading branch information...
1 parent f5d6f88 commit 87d875b3b2532f515d9419167f1b9658f52e24fd @kolmodin kolmodin committed Mar 15, 2008
Showing with 77 additions and 74 deletions.
  1. +5 −1 AnsiColor.hs
  2. +2 −3 Bash.hs
  3. +3 −2 BlingBling.hs
  4. +34 −24 Cabal2Ebuild.hs
  5. +2 −2 Cache.hs
  6. +5 −10 Config.hs
  7. +1 −3 Diff.hs
  8. +2 −3 Error.hs
  9. +0 −6 GenerateEbuild.hs
  10. +1 −1 Index.hs
  11. +4 −3 Main.hs
  12. +0 −2 P2.hs
  13. +6 −2 Package.hs
  14. +1 −4 Portage.hs
  15. +4 −4 Status.hs
  16. +2 −0 Utils.hs
  17. +4 −4 Version.hs
  18. +1 −0 hackport.cabal
View
6 AnsiColor.hs
@@ -9,7 +9,6 @@
module AnsiColor
where
--- import Portage.Config.Type
import Data.List
data Color = Black
@@ -23,20 +22,25 @@ data Color = Black
| Default
deriving Enum
+esc :: [String] -> String
esc [] = ""
esc xs = "\ESC[" ++ (concat . intersperse ";" $ xs) ++ "m"
+col :: Color -> Bool -> Color -> [String]
col fg bf bg = show (fromEnum fg + 30) : bf' [show (fromEnum bg + 40)]
where bf' | bf = ("01" :)
| otherwise = id
+inColor :: Color -> Bool -> Color -> String -> String
inColor c bf bg txt = esc (col c bf bg) ++ txt ++ esc ["00"]
+bold, italic, underline, inverse :: String -> String
bold = ansi "1" "22"
italic = ansi "3" "23"
underline = ansi "4" "24"
inverse = ansi "7" "27"
+ansi :: String -> String -> String -> String
ansi on off txt = esc [on] ++ txt ++ esc [off]
{-
View
5 Bash.hs
@@ -1,6 +1,5 @@
module Bash where
-import Control.Monad.Trans
import Control.Monad.Error
import System.Process
import System.Directory
@@ -71,5 +70,5 @@ runBash command = do
length errors `seq` liftIO (hClose err)
exitCode <- liftIO $ waitForProcess pid
case exitCode of
- ExitFailure err -> throwError $ BashError errors
- ExitSuccess -> return result
+ ExitFailure _ -> throwError $ BashError errors
+ ExitSuccess -> return result
View
5 BlingBling.hs
@@ -5,10 +5,11 @@ import System.IO
-- what nobody needs but everyone wants...
-- FIXME: do something more fun here
+forMbling :: [a] -> (a -> IO b) -> IO [b]
forMbling lst f = do
- init <- hGetBuffering stdout
+ origBuffering <- hGetBuffering stdout
hSetBuffering stdout NoBuffering
xs <- mapM (\x -> putStr "." >> f x) lst
putStrLn ""
- hSetBuffering stdout init
+ hSetBuffering stdout origBuffering
return xs
View
58 Cabal2Ebuild.hs
@@ -27,17 +27,14 @@ module Cabal2Ebuild
,showEBuild) where
import qualified Distribution.PackageDescription as Cabal
- (PackageDescription(..),
- readPackageDescription)
+ (PackageDescription(..))
import qualified Distribution.Package as Cabal (PackageIdentifier(..))
import qualified Distribution.Version as Cabal (showVersion, Dependency(..),
VersionRange(..))
import qualified Distribution.License as Cabal (License(..))
--import qualified Distribution.Compiler as Cabal (CompilerFlavor(..))
import Data.Char (toLower,isUpper)
-import Data.Maybe (catMaybes)
-import Text.Regex
data EBuild = EBuild {
name :: String,
@@ -68,6 +65,7 @@ data Dependency = AnyVersionOf Package
| DependEither Dependency Dependency -- depend || depend
| DependIfUse UseFlag Dependency -- use? ( depend )
+ebuildTemplate :: EBuild
ebuildTemplate = EBuild {
name = "foobar",
version = "0.1",
@@ -105,6 +103,7 @@ cabal2ebuild pkg = ebuildTemplate {
} where
cabalPkgName = Cabal.pkgName (Cabal.package pkg)
+defaultDepGHC :: Dependency
defaultDepGHC = OrLaterVersionOf "6.6.1" "dev-lang/ghc"
-- map the cabal license type to the gentoo license string format
@@ -117,6 +116,7 @@ convertLicense Cabal.PublicDomain = "public-domain"
convertLicense Cabal.AllRightsReserved = ""
convertLicense _ = ""
+licenseComment :: Cabal.License -> String
licenseComment Cabal.AllRightsReserved =
"Note: packages without a license cannot be included in portage"
licenseComment Cabal.OtherLicense =
@@ -127,15 +127,15 @@ convertDependencies :: [Cabal.Dependency] -> [Dependency]
convertDependencies = concatMap convertDependency
convertDependency :: Cabal.Dependency -> [Dependency]
-convertDependency (Cabal.Dependency name _)
- | name `elem` coreLibs = [] -- no explicit dep on core libs
-convertDependency (Cabal.Dependency name versionRange)
+convertDependency (Cabal.Dependency pname _)
+ | pname `elem` coreLibs = [] -- no explicit dep on core libs
+convertDependency (Cabal.Dependency pname versionRange)
= case versionRange of
(Cabal.IntersectVersionRanges v1 v2) -> [convert v1, convert v2]
v -> [convert v]
where
- ebuildName = "dev-haskell/" ++ map toLower name
+ ebuildName = "dev-haskell/" ++ map toLower pname
convert :: Cabal.VersionRange -> Dependency
convert Cabal.AnyVersion = AnyVersionOf ebuildName
@@ -149,6 +149,7 @@ convertDependency (Cabal.Dependency name versionRange)
convert (Cabal.UnionVersionRanges r1 r2)
= DependEither (convert r1) (convert r2)
+coreLibs :: [String]
coreLibs =
["array"
,"base"
@@ -200,32 +201,41 @@ showEBuild ebuild =
ss "DEPEND=". quote' (sepBy "\n\t\t" $ map showDepend $ depend ebuild). nl.
(case my_pn ebuild of
Nothing -> id
- Just pn -> nl. ss "S=". quote ("${WORKDIR}/${MY_P}"). nl)
+ Just _ -> nl. ss "S=". quote ("${WORKDIR}/${MY_P}"). nl)
$ []
where replaceVars = replaceCommonVars (name ebuild) (my_pn ebuild) (version ebuild)
-showDepend (AnyVersionOf package) = package
-showDepend (ThisVersionOf version package) = "~" ++ package ++ "-" ++ version
-showDepend (LaterVersionOf version package) = ">" ++ package ++ "-" ++ version
-showDepend (EarlierVersionOf version package) = "<" ++ package ++ "-" ++ version
-showDepend (OrLaterVersionOf version package) = ">=" ++ package ++ "-" ++ version
-showDepend (OrEarlierVersionOf version package) = "<=" ++ package ++ "-" ++ version
-showDepend (DependEither depend1 depend2) = showDepend depend1
- ++ " || " ++ showDepend depend2
-showDepend (DependIfUse useflag depend@(DependEither _ _))
- = useflag ++ "? " ++ showDepend depend
-showDepend (DependIfUse useflag depend) = useflag ++ "? ( " ++ showDepend depend ++ " )"
+showDepend :: Dependency -> Package
+showDepend (AnyVersionOf p) = p
+showDepend (ThisVersionOf v p) = "~" ++ p ++ "-" ++ v
+showDepend (LaterVersionOf v p) = ">" ++ p ++ "-" ++ v
+showDepend (EarlierVersionOf v p) = "<" ++ p ++ "-" ++ v
+showDepend (OrLaterVersionOf v p) = ">=" ++ p ++ "-" ++ v
+showDepend (OrEarlierVersionOf v p) = "<=" ++ p ++ "-" ++ v
+showDepend (DependEither dep1 dep2) = showDepend dep1
+ ++ " || " ++ showDepend dep2
+showDepend (DependIfUse useflag dep@(DependEither _ _))
+ = useflag ++ "? " ++ showDepend dep
+showDepend (DependIfUse useflag dep) = useflag ++ "? ( " ++ showDepend dep++ " )"
+ss :: String -> String -> String
ss = showString
+
+sc :: Char -> String -> String
sc = showChar
+
+nl :: String -> String
nl = sc '\n'
+quote :: String -> String -> String
quote str = sc '"'. ss str. sc '"'
+
+quote' :: (String -> String) -> String -> String
quote' str = sc '"'. str. sc '"'
sepBy :: String -> [String] -> ShowS
-sepBy s [] = id
-sepBy s [x] = ss x
+sepBy _ [] = id
+sepBy _ [x] = ss x
sepBy s (x:xs) = ss x. ss s. sepBy s xs
getRestIfPrefix ::
@@ -251,9 +261,9 @@ replaceMultiVars ::
String -> -- ^ string to be searched
String -- ^ the result
replaceMultiVars [] str = str
-replaceMultiVars whole@((name,cont):rest) str = case subStr cont str of
+replaceMultiVars whole@((pname,cont):rest) str = case subStr cont str of
Nothing -> replaceMultiVars rest str
- Just (pre,post) -> (replaceMultiVars rest pre)++name++(replaceMultiVars whole post)
+ Just (pre,post) -> (replaceMultiVars rest pre)++pname++(replaceMultiVars whole post)
replaceCommonVars ::
String -> -- ^ PN
View
4 Cache.hs
@@ -12,8 +12,8 @@ import Version
import Control.Arrow
import Data.Char
import Data.List
-import Network.URI
-import Network.HTTP
+import Network.URI (URI, uriPath)
+import Network.HTTP (Request(..), RequestMethod(GET), simpleHTTP, rspBody)
import qualified Data.ByteString.Lazy as L
import System.Time
import System.FilePath
View
15 Config.hs
@@ -2,17 +2,11 @@ module Config where
import Network.URI
import System.Console.GetOpt
-import Control.Exception
import Text.Regex
-import Distribution.Package
-
-import Error
-import MaybeRead
data HackPortOptions
= OverlayPath String
| PortagePath String
- | Category String
| Server String
| TempDir String
| Verbosity String
@@ -49,6 +43,7 @@ data Verbosity
| Normal
| Silent
+packageRegex :: Regex
packageRegex = mkRegex "^(.*?)-([0-9].*)$"
defaultConfig :: Config
@@ -91,17 +86,17 @@ parseConfig opts = let
"diff":"additions":[] -> Right (DiffTree ShowAdditions)
"diff":"newer":[] -> Right (DiffTree ShowNewer)
"diff":"common":[] -> Right (DiffTree ShowCommon)
- "diff":arg:[] -> Left ("Unknown argument to 'diff': Use all,missing,additions,newer or common.\n")
- "diff":arg1:args -> Left ("'diff' takes one argument("++show ((length args)+1)++" given).\n")
+ "diff":arg:[] -> Left ("Unknown argument to diff: '" ++ arg ++ "'. Use all,missing,additions,newer or common.\n")
+ "diff":_:xs -> Left ("'diff' takes one argument("++show ((length xs)+1)++" given).\n")
"update":[] -> Right Update
"update":rest -> Left ("'update' takes zero arguments("++show (length rest)++" given).\n")
"status":[] -> Right Status
- "status":args -> Left ("'status' doesn't take any arguments. ("++show ((length args)+1)++" given).\n")
+ "status":xs-> Left ("'status' doesn't take any arguments. ("++show ((length xs)+1)++" given).\n")
[] -> Right ShowHelp
_ -> Left "Unknown opertation mode\n"
in case mode of
Left err -> Left err
- Right mod -> Right (popts,mod)
+ Right m -> Right (popts,m)
hackageUsage :: IO ()
hackageUsage = putStr $ flip usageInfo hackageOptions $ unlines
View
4 Diff.hs
@@ -2,16 +2,14 @@ module Diff
( diffAction
) where
-import Data.Set as Set (Set)
-import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Monad.Trans
import Data.Char
import Action
import Cache
-import Config
+import Config (DiffMode(..))
import P2
import Portage
import Version
View
5 Error.hs
@@ -2,9 +2,7 @@
module Error where
import Data.Typeable
-import Distribution.Package
-import Control.Monad.Error
-import Control.Exception
+import Control.Monad.Error (Error)
data HackPortError
= ArgumentError String
@@ -52,5 +50,6 @@ hackPortShowError err = case err of
MultipleOverlays overlays -> "You have the following overlays available: '"++unwords overlays++"'. Please choose one by using '-p path-to-overlay'"
NoOverlay -> "You don't have PORTDIR_OVERLAY set in '/etc/make.conf'. Please set it or use '-p path-to-overlay'"
UnknownVerbosityLevel str -> "The verbosity level '"++str++"' is invalid. Please use debug,normal or silent"
+ InvalidServer srv -> "Invalid server address, could not parse: " ++ srv
--WrongCacheVersion -> "The version of the cache is too old. Please update the cache using 'hackport update'"
--InvalidCache -> "Could not read the cache. Please ensure that it's up to date using 'hackport update'"
View
6 GenerateEbuild.hs
@@ -2,16 +2,10 @@ module GenerateEbuild where
import Action
import Cabal2Ebuild
---import Fetch
---import TarUtils
import Config
-import Error
import Prelude hiding (catch)
-import Control.Monad.Trans
import Control.Monad.Error
-import Control.Exception
-import Distribution.PackageDescription
import Distribution.Package
import Data.Version (showVersion)
import Network.URI
View
2 Index.hs
@@ -22,7 +22,7 @@ readIndex str = do
case splitDirectories (tarFileName (entryHeader entr)) of
[".",pkgname,vers,file] -> do
let descr = case parsePackageDescription (unpack (entryData entr)) of
- ParseOk _ descr -> descr
+ ParseOk _ pkg_desc -> pkg_desc
_ -> error $ "Couldn't read cabal file "++show file
return (pkgname,vers,descr)
_ -> fail "doesn't look like the proper path"
View
7 Main.hs
@@ -7,12 +7,12 @@ import Data.List
import Data.Version
import Distribution.Package
import Distribution.PackageDescription
+ (packageDescription, finalizePackageDescription, package)
import System.IO
import System.Info (os, arch)
import qualified Data.Map as Map
import Text.ParserCombinators.Parsec
-
import Action
import qualified Cabal2Ebuild as E
import Cache
@@ -25,7 +25,6 @@ import Status
import Package
import Portage
import P2
-import Utils
list :: String -> HPAction ()
list name = do
@@ -68,6 +67,8 @@ merge pstr = do
case ebuilds of
[] -> throwError (PackageNotFound (pname ++ '-':show v))
[e] -> return e
+ _ -> fail "the impossible happened"
+ _ -> fail "the impossible happened"
category <- do
case m_category of
Just cat -> return cat
@@ -106,7 +107,7 @@ hpmain = do
ShowHelp -> liftIO hackageUsage
List pkg -> list pkg
Merge pkg -> merge pkg
- DiffTree mode -> diffAction mode
+ DiffTree dtmode -> diffAction dtmode
Update -> updateCache
Status -> status
View
2 P2.hs
@@ -15,7 +15,6 @@ import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.List as List
-import Data.Monoid
import System.Directory
import System.IO
@@ -24,7 +23,6 @@ import System.FilePath
import Text.Regex
import Version
-import Utils
type Portage = PortageMap [Ebuild]
type PortageMap a = Map Package a
View
8 Package.hs
@@ -15,34 +15,38 @@ import Control.Monad
import Text.ParserCombinators.Parsec
import Version
-import System.FilePath
--- import Portage.Utilities
type Category = String
type Package = String
type Slot = String
+getPV :: String -> (Category, Package, Version)
getPV xs = case parsePV xs of
Left e ->
error $ "getPV: cat/pkg-ver parse error '" ++ xs ++ "'\n" ++ show e
Right x -> x
+getP :: String -> (Category, Package)
getP xs = case parseP xs of
Left e ->
error $ "getCatPkg: cat/pkg parse error '" ++ xs ++ "'\n" ++ show e
Right x -> x
+parsePV :: String -> Either ParseError (Category, Package, Version)
parsePV = parse (readPV >>= \x -> eof >> return x) "<cat/pkg-ver>"
+readPV :: GenParser Char st (Category, Package, Version)
readPV = do cat <- readCat
char '/'
(pkg,mver) <- readPkgAndVer
case mver of
Nothing -> error "readPV: version expected"
Just ver -> return (cat, pkg, ver)
+parseP :: String -> Either ParseError (Category, Package)
parseP = parse (readP >>= \x -> eof >> return x) "<cat/pkg>"
+readP :: GenParser Char st (Category, Package)
readP = do cat <- readCat
char '/'
(pkg,mver) <- readPkgAndVer
View
5 Portage.hs
@@ -1,17 +1,14 @@
module Portage where
-import Control.Monad.Trans
-import Distribution.Package
import System.Directory
import Text.Regex
import Data.Maybe
-import Data.Version
import Bash
-import MaybeRead
import Action
import Config
+ebuildVersionRegex :: String -> Regex
ebuildVersionRegex name = mkRegex ("^"++name++"-(.*)\\.ebuild$")
filterPackages :: String -> [String] -> IO [String]
View
8 Status.hs
@@ -8,7 +8,6 @@ import P2
import Utils
import Control.Arrow
-import Control.Monad.Error
import Control.Monad.State
import qualified Data.List as List
@@ -51,15 +50,16 @@ status = do
forM_ versions (\v -> putStr v >> putChar ' ')
putStrLn ""
+toColor :: Color -> String -> String
toColor c t = inColor c False Default t
portageDiff :: Portage -> Portage -> (Portage, Portage, Portage)
portageDiff p1 p2 = (in1, ins, in2)
where ins = Map.filter (not . null) $
Map.intersectionWith (List.intersectBy $ comparing eVersion) p1 p2
- in1 = subtract p1 p2
- in2 = subtract p2 p1
- subtract x y = Map.filter (not . null) $
+ in1 = difference p1 p2
+ in2 = difference p2 p1
+ difference x y = Map.filter (not . null) $
Map.differenceWith (\xs ys ->
let lst = foldr (List.deleteBy (comparing eVersion)) xs ys in
if null lst
View
2 Utils.hs
@@ -1,5 +1,7 @@
module Utils where
+comparing :: (Eq b) => (a -> b) -> a -> a -> Bool
comparing f x y = f x == f y
+compareWith :: (Ord b) => (a -> b) -> a -> a -> Ordering
compareWith f x y = compare (f x) (f y)
View
8 Version.hs
@@ -76,10 +76,10 @@ parseVersion :: String -> Either ParseError Version
parseVersion = parse (readVersion >>= \x -> eof >> return x) "<version number>"
readVersion :: CharParser st Version
-readVersion = do (ver, verr) <- readVer
- (c, cr ) <- readC
- (suf, sufr) <- readSufs
- (rev, revr) <- readRev
+readVersion = do (ver, _verr) <- readVer
+ (c, _cr ) <- readC
+ (suf, _sufr) <- readSufs
+ (rev, _revr) <- readRev
return (Version ver c suf rev)
readVer :: CharParser st ([Int], String)
View
1 hackport.cabal
@@ -17,3 +17,4 @@ Executable hackport
else
Build-Depends: base < 3
+ ghc-options: -Wall

0 comments on commit 87d875b

Please sign in to comment.