Skip to content

Commit

Permalink
Merge pull request #1 from Heather/master
Browse files Browse the repository at this point in the history
lesser code maid, warning driven
  • Loading branch information
Sergei Trofimovich committed Aug 15, 2013
2 parents fa9028f + 709284a commit 0ab1543
Showing 1 changed file with 28 additions and 10 deletions.
38 changes: 28 additions & 10 deletions Main.hs
Original file line number Original file line Diff line number Diff line change
@@ -1,3 +1,5 @@
{-# LANGUAGE PatternGuards #-}

module Main ( main ) where module Main ( main ) where


--import qualified Data.ByteString as B --import qualified Data.ByteString as B
Expand All @@ -18,8 +20,8 @@ main = do
let (packages_file, wd) = let (packages_file, wd) =
case args of case args of
[] -> (Nothing, ".") [] -> (Nothing, ".")
[wd] -> (Nothing, wd) [wx] -> (Nothing, wx)
[pf,wd] -> (Just pf, wd) [pf,wx] -> (Just pf, wx)
ebuilds <- ebuilds <-
case packages_file of case packages_file of
Just pf -> do pkgs <- filter (not . L.isPrefixOf "#") . lines <$> readFile pf Just pf -> do pkgs <- filter (not . L.isPrefixOf "#") . lines <$> readFile pf
Expand Down Expand Up @@ -73,16 +75,22 @@ findPackages dir = do
files <- filterM doesFileExist items files <- filterM doesFileExist items
return (dirs,files) return (dirs,files)


packageRegex :: R.Regex
packageRegex = R.compile "^(.*)/(.*?)-([\\d.]+)([-_].*?)?$" [] packageRegex = R.compile "^(.*)/(.*?)-([\\d.]+)([-_].*?)?$" []

keywordRegex :: R.Regex
keywordRegex = R.compile "^KEYWORDS=\"(.*)\".*" [R.multiline] keywordRegex = R.compile "^KEYWORDS=\"(.*)\".*" [R.multiline]
versionRegex name = R.compile ("^" ++ name ++ "-(.*).ebuild$") []


--versionRegex name = R.compile ("^" ++ name ++ "-(.*).ebuild$") []

extractCPVR_pkgLine :: String -> (String, String, String)
extractCPVR_pkgLine pkg_line = extractCPVR_pkgLine pkg_line =
case R.match packageRegex pkg_line [] of case R.match packageRegex pkg_line [] of
Just [_, cat,pkg,ver] -> (cat, pkg, ver) Just [_, cat,pkg,ver] -> (cat, pkg, ver)
Just [_, cat,pkg,ver,suf] -> (cat, pkg, ver ++ suf) Just [_, cat,pkg,ver,suf] -> (cat, pkg, ver ++ suf)
x -> error (show x) x -> error (show x)


extractCPVR_m :: FilePath -> Maybe String
extractCPVR_m text = extractCPVR_m text =
case reverse (splitDirectories text) of case reverse (splitDirectories text) of
-- ../gentoo-haskell/x11-wm/xmonad/xmonad-0.8 -- ../gentoo-haskell/x11-wm/xmonad/xmonad-0.8
Expand All @@ -95,17 +103,19 @@ extractCPVR_m text =
-- [ xmonad-0.8 , . ] -- [ xmonad-0.8 , . ]
[pvr, _] -> Just pvr [pvr, _] -> Just pvr
-- ?? -- ??
x -> Just ("?:" ++ text) _ -> Just ("?:" ++ text)


extractCPVR :: FilePath -> String
extractCPVR text = extractCPVR text =
case extractCPVR_m text of case extractCPVR_m text of
Just x -> x Just x -> x
Nothing -> error text Nothing -> error text


extractKeywords :: [Char] -> [Arch]
extractKeywords text = map toArch $ words k extractKeywords text = map toArch $ words k
where (Just [_,k]) = R.match keywordRegex text [] where (Just [_,k]) = R.match keywordRegex text []


cpvToEbuild (c,p,v,r) = c </> p </> p <-> v ++ r ++ ".ebuild" -- cpvToEbuild (c,p,v,r) = c </> p </> p <-> v ++ r ++ ".ebuild"


(</>) :: String -> String -> String (</>) :: String -> String -> String
b </> n = b ++ '/':n b </> n = b ++ '/':n
Expand All @@ -121,18 +131,23 @@ data Arch
= Stable String = Stable String
| Masked String | Masked String
| Unavailable String deriving (Eq,Show) | Unavailable String deriving (Eq,Show)

fromArch :: Arch -> String
fromArch (Stable a) = a fromArch (Stable a) = a
fromArch (Masked a) = a fromArch (Masked a) = a
fromArch (Unavailable a) = a fromArch (Unavailable a) = a


toArch :: [Char] -> Arch
toArch str = toArch str =
case str of case str of
('~':arch) -> Masked arch ('~':arch) -> Masked arch
('-':arch) -> Unavailable arch ('-':arch) -> Unavailable arch
_ -> Stable str _ -> Stable str


sameArch a b = (fromArch a) == (fromArch b) -- sameArch :: Arch -> Arch -> Bool
-- sameArch a b = (fromArch a) == (fromArch b)


showArch :: Arch -> String
showArch (Stable a) = a showArch (Stable a) = a
showArch (Masked a) = '~' : a showArch (Masked a) = '~' : a
showArch (Unavailable a) = '-' : a showArch (Unavailable a) = '-' : a
Expand All @@ -150,11 +165,14 @@ arches = map toArch . sort . words $ "alpha amd64 ia64 ppc ppc64 sparc x86 x86-f
----------------------------------------------------------------------- -----------------------------------------------------------------------


data Alignment data Alignment
= LeftAlign { fromAlign :: Int } = LeftAlign { fromAlign :: Int }
| CenterAlign { fillChar :: Char, fromAlign :: Int } | CenterAlign { _fillChar :: Char, fromAlign :: Int }
| RightAlign { fromAlign :: Int } | RightAlign { fromAlign :: Int }


prettyColumns :: [Alignment]
prettyColumns = LeftAlign 35 : map (\arch -> RightAlign (2 + length (fromArch arch))) arches prettyColumns = LeftAlign 35 : map (\arch -> RightAlign (2 + length (fromArch arch))) arches

prettyHeader :: [[Char]]
prettyHeader = "package" : map fromArch arches prettyHeader = "package" : map fromArch arches


pretty :: [Alignment] -> [String] -> IO () pretty :: [Alignment] -> [String] -> IO ()
Expand Down

0 comments on commit 0ab1543

Please sign in to comment.