1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
import Control.Monad
import Data.List
import Data.Maybe (fromMaybe)
import Debian.Apt.Methods
import Debian.Report
import Debian.Sources
import Foreign.C.Types
import System.Environment (getArgs, getProgName)
import System.Exit (exitFailure)
import Text.XML.HaXml
import Text.XML.HaXml.Pretty (document)
import Text.XML.HaXml.Posn
import Text.PrettyPrint.HughesPJ
import System.IO
import System.Posix.Env
-- * main
main :: IO ()
main =
do (sourcesAFP, sourcesBFP) <- parseArgs
let arch = "i386" -- not actually used for anything right now, could be when binary package list is enabled
cacheDir = "." -- FIXME: replace with tempdir later
sourcesA <- liftM parseSourcesList $ readFile sourcesAFP
sourcesB <- liftM parseSourcesList $ readFile sourcesBFP
trumpMap <- trumped (fetch emptyFetchCallbacks []) cacheDir arch sourcesA sourcesB
print (showXML "trump.xsl" (trumpedXML trumpMap))
where
showXML :: String -> CFilter Posn -> Doc
showXML styleSheet = document . mkDocument styleSheet . cfilterToElem
-- cliff says this is broken with regards to cdata
cfilterToElem :: CFilter Posn -> Element Posn
cfilterToElem f = case f (CString False "" noPos) of
[CElem e _] -> xmlEscape stdXmlEscaper e
[] -> error "RSS produced no output"
_ -> error "RSS produced more than one output"
-- <?xml-stylesheet type="text/xsl" href="cdcatalog.xsl"?>
mkDocument :: String -> Element Posn -> Document Posn
mkDocument styleSheet elem =
let xmlDecl = XMLDecl "1.0" (Just (EncodingDecl "utf-8")) (Just True)
prolog = Prolog (Just xmlDecl) [] Nothing [PI ("xml-stylesheet","type=\"text/xsl\" href=\""++styleSheet++"\"")]
symTable = []
in
Document prolog [] elem []
-- * command-line helper functions
helpText :: String -> Doc
helpText progName =
(text "Usage:" <+> text progName <+> text "<old sources.list>" <+> text "<new sources.list>"$+$
text [] $+$
(fsep $ map text $ words $ "Find all the packages referenced by the second sources.list which trump packages find in the first sources.list.")
)
parseArgs :: IO (String, String)
parseArgs =
do args <- getArgs
case args of
[dista, distb] -> return (dista, distb)
_ -> exitWithHelp helpText
where
-- |exitFailure with nicely formatted help text on stderr
exitWithHelp :: (String -> Doc) -- ^ generate help text, the argument is the result of getProgName
-> IO a -- ^ no value is returned, this function always calls exitFailure
exitWithHelp helpText =
do progName <- getProgName
hPutStrLn stderr =<< renderWidth (helpText progName)
exitFailure
-- |render a Doc using the current terminal width
renderWidth :: Doc -> IO String
renderWidth doc =
do columns <- return . fromMaybe 80 =<< getWidth
return $ renderStyle (Style PageMode columns 1.0) doc
foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong
-- get the number of rows and columns using ioctl (0, TIOCGWINSZ, &w)
-- @see also: getWidth
getWinSize :: IO (Int,Int)
getWinSize = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size
return (fromIntegral b, fromIntegral a)
-- get the number of colums.
-- First tries getWinSize, if that returns 0, then try the COLUMNS
-- shell variable.
getWidth :: IO (Maybe Int)
getWidth =
do (cols, _) <- getWinSize
case cols of
0 -> return . fmap read =<< getEnv "COLUMNS"
_ -> return (Just cols)
|
