Commits

Colin Woodbury committed 422aad4

Cleaned up the AurConnection fix - Added `--auradebug`

- Added the `--auradebug` option so the aura session settings can be
easily viewed.

Comments (0)

Files changed (4)

Aura/AurConnection.hs

           args' | t == MultiInfo = rpcAddMultiInfoArgs args
                 | otherwise      = rpcAddArg args
 
-aurPkgUrl :: String -> String
-aurPkgUrl n = "https://aur.archlinux.org/packages.php?ID=" ++ n
+aurPkgUrl :: Int -> String
+aurPkgUrl n = "https://aur.archlinux.org/packages.php?ID=" ++ show n
 
 rpcBaseUrl :: String
 rpcBaseUrl = "https://aur.archlinux.org/rpc.php?"
                        , projectURLOf :: String
                        , aurURLOf :: String
                        , licenseOf :: String
-                       , votesOf :: String
+                       , votesOf :: Int
                        , descriptionOf :: String
                        } deriving (Eq,Show)
 
   isError <- valFromObj "type" json >>= return . (== "error")
   if isError then Error "AUR API lookup failed." else Ok json
 
+-- Upgrade to AUR 2.0 changed several return types to Ints,
+-- but Text.JSON parses them as Rationals.
 makePkgInfo :: JSObject JSValue -> Result PkgInfo
 makePkgInfo pkgJSON = do
   ur <- valFromObj "URL" pkgJSON
   na <- valFromObj "Name" pkgJSON
   ve <- valFromObj "Version" pkgJSON
   li <- valFromObj "License" pkgJSON
-  vo <- valFromObj "NumVotes" pkgJSON >>= return . show . extractRat
+  vo <- valFromObj "NumVotes" pkgJSON >>= return . fromJSRat
   de <- valFromObj "Description" pkgJSON
-  au <- valFromObj "ID" pkgJSON >>= return . aurPkgUrl . show . extractRat
-  ou <- valFromObj "OutOfDate" pkgJSON >>= return . (/= 0) . extractRat
+  au <- valFromObj "ID" pkgJSON >>= return . aurPkgUrl . fromJSRat
+  ou <- valFromObj "OutOfDate" pkgJSON >>= return . (/= 0) . fromJSRat
   return $ PkgInfo na ve ou ur au li vo de
 
--- Temporary fix.
-extractRat :: JSValue -> Int
-extractRat (JSRational _ r) = round $ fromRational r
-extractRat _                = error "THE SYSTEM IS DOWN"
+fromJSRat :: JSValue -> Int
+fromJSRat (JSRational _ r) = round (fromRational r :: Float)
+fromJSRat _                = error "JSValue given was not a JSRational!"
 
 ------------
 -- PKGBUILDS
 
 -- System Libraries
 import System.Console.GetOpt
+--import Data.Maybe (fromJust)
 
 -- Custom Libraries
 import Utilities (notNull)
 import Shell (yellow)
 import Aura.Languages
+--import Zero ((?>>=))
 
 type FlagMap = [(Flag,String)]
 
           | Unsuppress
           | HotEdit
           | NoConfirm
+          | Debug
           | Backup
           | Clean
           | Abandon
               , ( ['x'], ["unsuppress"],   Unsuppress  )
               , ( [],    ["hotedit"],      HotEdit     )
               , ( [],    ["conf"],         ViewConf    ) 
-              , ( [],    ["languages"],    Languages   ) ]
+              , ( [],    ["languages"],    Languages   ) 
+              , ( [],    ["auradebug"],    Debug       ) ]
 
 -- These are intercepted Pacman flags. Their functionality is different.
 pacmanOptions :: [OptDescr Flag]
 
 languageOptions :: [OptDescr Flag]
 languageOptions = map simpleMakeOption
-                  [ ( [], ["japanese","日本語"],   JapOut      )
-                  , ( [], ["polish","polski"],     PolishOut   )
-                  , ( [], ["croatian","hrvatski"], CroatianOut )
-                  , ( [], ["swedish","svenska"],   SwedishOut  )
-                  , ( [], ["german", "deutsch"],   GermanOut   )
-                  , ( [], ["spanish", "español"],  SpanishOut  )
-                  , ( [], ["portuguese","português"], PortuOut ) ]
+                  [ ( [], ["japanese","日本語"],      JapOut      )
+                  , ( [], ["polish","polski"],        PolishOut   )
+                  , ( [], ["croatian","hrvatski"],    CroatianOut )
+                  , ( [], ["swedish","svenska"],      SwedishOut  )
+                  , ( [], ["german","deutsch"],       GermanOut   )
+                  , ( [], ["spanish","español"],      SpanishOut  )
+                  , ( [], ["portuguese","português"], PortuOut    ) ]
 
 -- `Hijacked` flags. They have original pacman functionality, but
 -- that is masked and made unique in an Aura context.
 
 dualFlagMap :: FlagMap
 dualFlagMap = [ (NoConfirm,"--noconfirm") ]
-
+ 
 -- Does the whole lot and filters out the garbage.
 reconvertFlags :: [Flag] -> FlagMap -> [String]
 reconvertFlags flags fm = filter notNull $ map (reconvertFlag fm) flags
 -- Converts an intercepted Pacman flag back into its raw string form.
 reconvertFlag :: FlagMap -> Flag -> String
 reconvertFlag flagMap f = case f `lookup` flagMap of
-                            Just x  -> x
                             Nothing -> ""
+                            Just x  -> x
+-- This is wrong somehow. Why?
+--reconvertFlag flagMap f = return (f `lookup` flagMap) ?>>= fromJust
 
 settingsFlags :: [Flag]
-settingsFlags = [Unsuppress,NoConfirm,HotEdit,JapOut]
+settingsFlags = [Unsuppress,NoConfirm,HotEdit,Debug]
 
 auraOperMsg :: Language -> String
 auraOperMsg lang = usageInfo (yellow $ auraOperTitle lang) $ auraOperations lang
 
 Move aura to haskell-http.
 
+Create `auraup` script for upgrading aura when things break.
+
 OPTIONS TO IMPLEMENT
 --------------------
 -Ci -> `--info` Gives some stats about the package cache.
       (auraFlags,input,pacOpts) = parseFlags language rest
       auraFlags' = filter (`notElem` settingsFlags) auraFlags
       pacOpts'   = pacOpts ++ reconvertFlags auraFlags dualFlagMap
-  settings   <- getSettings language auraFlags
+  settings <- getSettings language auraFlags
+  unless (Debug `notElem` auraFlags) $ displaySettings settings
   exitStatus <- executeOpts settings (auraFlags', nub input, nub pacOpts')
   exitWith exitStatus
 
                     , mustConfirm     = getConfirmation auraFlags
                     , mayHotEdit      = getHotEdit auraFlags }
 
+displaySettings :: Settings -> IO ()
+displaySettings ss = do
+  let yn a = if a then "Yes!" else "No."
+      env  = environmentOf ss
+      pac  = case getEnvVar "PACMAN" env of Nothing -> "pacman"; Just c -> c
+  mapM_ putStrLn [ --"True User         => " ++ getTrueUser env
+                   "Using Sudo?       => " ++ yn (varExists "SUDO_USER" env)
+                 , "Language          => " ++ show (langOf ss)
+                 , "Pacman Command    => " ++ pac
+                 , "Ignored Pkgs      => " ++ unwords (ignoredPkgsOf ss)
+                 , "Pkg Cache Path    => " ++ cachePathOf ss
+                 , "Log File Path     => " ++ logFilePathOf ss
+                 , "Silent Building?  => " ++ yn (suppressMakepkg ss)
+                 , "Must Confirm?     => " ++ yn (mustConfirm ss)
+                 , "PKGBUILD editing? => " ++ yn (mayHotEdit ss) ]
+
 -- After determining what Flag was given, dispatches a function.
 -- The `flags` must be sorted to guarantee the pattern matching
 -- below will work properly.
                              , cyan $ projectURLOf info
                              , aurURLOf info
                              , licenseOf info
-                             , votesOf info
+                             , show $ votesOf info
                              , descriptionOf info ]
 
 -- This is quite limited. It only accepts one word/pattern.