hbro 1.1.0.0 → 1.1.1.0
raw patch · 18 files changed
+90/−89 lines, 18 filesdep ~hbro
Dependency ranges changed: hbro
Files
- Hbro/Boot.hs +54/−26
- Hbro/Clipboard.hs +0/−1
- Hbro/Config.hs +6/−12
- Hbro/Core.hs +1/−3
- Hbro/Dyre.hs +0/−1
- Hbro/Gtk/ScrolledWindow.hs +0/−1
- Hbro/Gui.hs +1/−1
- Hbro/IPC.hs +3/−18
- Hbro/Keys.hs +1/−1
- Hbro/Main.hs +2/−8
- Hbro/Network.hs +0/−1
- Hbro/Notification.hs +1/−1
- Hbro/Options.hs +6/−1
- Hbro/Prompt.hs +1/−1
- Hbro/Util.hs +0/−1
- Hbro/Webkit/WebSettings.hs +0/−1
- Hbro/Webkit/WebView.hs +0/−1
- hbro.cabal +14/−10
Hbro/Boot.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, GeneralizedNewtypeDeriving, RankNTypes #-} module Hbro.Boot (hbro) where -- {{{ Imports@@ -8,7 +7,7 @@ import Hbro.Error import Hbro.Gui (GUI, GUIReader(..)) import qualified Hbro.Gui as Gui-import Hbro.IPC (IPC, IPCReader, readIPC)+import Hbro.IPC (IPC(..), IPCReader(..)) import qualified Hbro.IPC as IPC import qualified Hbro.Keys as Key import Hbro.Notification@@ -32,6 +31,7 @@ import Data.List import qualified Data.Map as M hiding(null) -- import Data.Maybe+import Data.Version import Graphics.UI.Gtk.Abstract.Widget import Graphics.UI.Gtk.Gdk.EventM@@ -42,35 +42,42 @@ import Graphics.UI.Gtk.WebKit.WebPolicyDecision import Graphics.UI.Gtk.WebKit.WebView as W +import Paths_hbro+ import Prelude hiding(init) import System.Directory import System.Environment.XDG.BaseDir import System.Exit+import System.FilePath import System.Glib.Signals+import System.Posix.Files+import System.Posix.Process import System.Posix.Signals+import System.ZMQ3 (Rep(..)) import qualified System.ZMQ3 as ZMQ -- }}} -- | Main function to call in the configuration file (cf file @Hbro/Main.hs@). -- First, commandline options are parsed, then configuration is dynamically applied.-hbro :: K () -> (Config K -> Config K) -> IO ()-hbro setup f = do+hbro :: K () -> IO ()+hbro setup = do opts <- Options.get when (opts^.Options.help) $ putStrLn Options.usage >> exitSuccess+ when (opts^.Options.version) $ putStrLn (showVersion version) >> exitSuccess when (opts^.Options.verbose) . putStrLn $ "Commandline options: " ++ show opts when (opts^.Options.recompile) $ Dyre.recompile >>= maybe exitSuccess (\e -> putStrLn e >> exitFailure) - Dyre.wrap hbro' opts (f, setup, opts)+ Dyre.wrap hbro' opts (setup, opts) -hbro' :: (Config K -> Config K, K (), CliOptions) -> IO ()-hbro' (f, customSetup, options) = do- config <- initConfig f options- gui <- initGUI config- ipc <- initIPC config+hbro' :: (K (), CliOptions) -> IO ()+hbro' (customSetup, options) = do+ config <- initConfig options+ gui <- initGUI+ ipc <- initIPC void $ installHandler sigINT (Catch onInterrupt) Nothing (result, logs) <- runK options config gui ipc $ main customSetup@@ -80,29 +87,47 @@ unless (options^.Options.quiet) $ putStrLn "Exiting..." -- {{{ Initialization-initConfig :: (MonadBase IO m) => (Config K -> Config K) -> CliOptions -> m (Config K)-initConfig f options = do- socketDir' <- io $ getTemporaryDirectory- theUIFile <- io $ getUserConfigDir "hbro" >/> "ui.xml"- let config = f- . set socketDir socketDir'- . set uIFile theUIFile+initConfig :: (MonadBase IO m) => CliOptions -> m (Config K)+initConfig options = do+ let config = id . (options^.Options.quiet ? set verbosity Quiet ?? id) . (options^.Options.verbose ? set verbosity Verbose ?? id) $ def-- when (config^.verbosity == Verbose) . io . putStrLn $ "Start-up configuration: \n" ++ show config return config -initGUI :: (MonadBase IO m) => Config K -> m (GUI K)-initGUI config = do- io $ void GTK.initGUI- Gui.buildFrom $ config^.uIFile+initGUI :: (MonadBase IO m) => m (GUI K)+initGUI = do+ file <- io (getUserConfigDir "hbro" >/> "ui.xml")+ fallback <- io $ getDataFileName "examples/ui.xml" + file' <- io $ firstReadableOf [file, fallback] -initIPC :: (MonadBase IO m) => Config K -> m IPC-initIPC config = IPC.init =<< (IPC.getSocketPath $ config^.socketDir)+ case file' of+ Just f -> do+ io $ void GTK.initGUI+ Gui.buildFrom f+ _ -> io $ putStrLn "No UI file found." >> exitFailure+ where+ firstReadableOf [] = return Nothing+ firstReadableOf (x:y) = do+ isReadable <- fileAccess x True False False+ isReadable ? return (Just x) ?? firstReadableOf y+++initIPC :: (MonadBase IO m) => m IPC+initIPC = io $ do+ theContext <- ZMQ.init 1+ socket <- ZMQ.socket theContext Rep+ ZMQ.bind socket =<< getSocketURI+ return $ IPC theContext socket+++getSocketURI :: (MonadBase IO m) => m String+getSocketURI = do+ dir <- io getTemporaryDirectory+ pid <- io getProcessID+ return $ "ipc://" ++ dir </> "hbro." ++ show pid -- }}} @@ -140,6 +165,9 @@ -- Apply custom setup customSetup + config <- readConfig id+ logV $ "Start-up configuration: \n" ++ show config+ -- Load startpage startURI <- Options.getStartURI maybe goHome load startURI@@ -148,7 +176,7 @@ io GTK.mainGUI -- Clean & close- void . (`IPC.sendCommand` "QUIT") =<< IPC.getSocketPath =<< readConfig socketDir+ void . (`IPC.sendCommand` "QUIT") =<< getSocketURI io $ takeMVar threadSync io . ZMQ.close =<< readIPC IPC.receiver
Hbro/Clipboard.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} -- | Designed to be imported as @qualified@. module Hbro.Clipboard where
Hbro/Config.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, TemplateHaskell, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, TemplateHaskell, UndecidableInstances #-} module Hbro.Config where -- {{{ Imports@@ -32,9 +32,6 @@ -- | Custom settings provided by the user data Config m = Config {--- Paths- _socketDir :: FilePath, -- ^ Directory where IPC sockets will be created (e.g. @/tmp@)- _UIFile :: FilePath, -- ^ Path to XML file describing UI (used by @GtkBuilder@) _homePage :: URI, -- ^ Startup page -- Parameters _verbosity :: Verbosity, -- ^ Logs verbosity@@ -54,9 +51,7 @@ makeLenses ''Config instance Show (Config m) where- show c = "Socket directory = " ++ c^.socketDir- ++ "\nUI file = " ++ c^.uIFile- ++ "\nHome page = " ++ (show $ c^.homePage)+ show c = "Home page = " ++ (show $ c^.homePage) ++ "\nVerbosity = " ++ (show $ c^.verbosity) @@ -64,6 +59,10 @@ class (Monad m) => ConfigReader n m | m -> n where readConfig :: Simple Lens (Config n) a -> m a +instance ConfigReader n ((->) (Config n)) where+ readConfig l = view l++ -- | 'MonadWriter' for 'Config' class (Monad m) => ConfigWriter n m | m -> n where writeConfig :: Simple Lens (Config n) a -> a -> m ()@@ -85,11 +84,6 @@ show WebNavigationReasonFormResubmitted = "Form resubmitted" show WebNavigationReasonOther = "Other" -- }}}----- | Return socket URI used for the current process.-getSocketURI :: (MonadBase IO m, ConfigReader n m) => m String-getSocketURI = getSocketPath =<< readConfig socketDir -- | Run an action unless verbosity is 'Quiet' unlessQuiet :: (MonadBase IO m, ConfigReader n m) => m () -> m ()
Hbro/Core.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeFamilies #-}+{-# LANGUAGE FlexibleInstances, TypeFamilies #-} module Hbro.Core where -- {{{ Imports@@ -110,8 +110,6 @@ -- {{{ Default configuration instance Default (Config K) where def = Config {- _socketDir = "/tmp",- _UIFile = "~/.config/hbro/ui.xml", _homePage = maybe undefined id . N.parseURI $ "https://duckduckgo.com/", _verbosity = Normal, _keyBindings = defaultKeyBindings,
Hbro/Dyre.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} -- | Dynamic reconfiguration. Designed to be imported as @qualified@. module Hbro.Dyre where
Hbro/Gtk/ScrolledWindow.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} module Hbro.Gtk.ScrolledWindow where -- {{{ Imports
Hbro/Gui.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances, TemplateHaskell #-} module Hbro.Gui ( Buildable(..), StatusBar(..),
Hbro/IPC.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, RankNTypes, TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-} -- | Designed to be imported as @qualified@. module Hbro.IPC where @@ -7,7 +7,6 @@ import Hbro.Util import Control.Lens hiding(Context, Rep)-import Control.Monad hiding(mapM_) import Control.Monad.Base -- import Control.Monad.Error hiding(mapM_) -- import Control.Monad.Writer@@ -21,12 +20,10 @@ import Prelude hiding(log, mapM_, read) -import System.FilePath-import System.Posix.Process -- import System.Posix.Types -- import System.Process-import System.ZMQ3 as ZMQ hiding(close, init, message, receive, send, socket)-import qualified System.ZMQ3 as ZMQ (init, receive, send, socket)+import System.ZMQ3 hiding(close, init, message, receive, send, socket)+import qualified System.ZMQ3 as ZMQ (receive, send) -- }}} -- {{{ Types@@ -42,18 +39,6 @@ newtype CommandsMap m = CommandsMap { unwrap :: Map String ([String] -> m String) } -- }}}---- | Open a listening socket at given location-init :: (MonadBase IO m) => String -> m IPC-init uri = io $ do- theContext <- ZMQ.init 1- socket <- ZMQ.socket theContext Rep- bind socket uri- return $ IPC theContext socket---- | Return the socket path to use for the given browser's process ID.-getSocketPath :: (Functor m, MonadBase IO m) => FilePath -> m String-getSocketPath socketDir = ((("ipc://" ++ socketDir </> "hbro.") ++) . show) <$> io getProcessID -- | Send message through given socket send :: (MonadBase IO m, Sender a) => Socket a -> String -> m ()
Hbro/Keys.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, TemplateHaskell, TupleSections #-}+{-# LANGUAGE FlexibleInstances, TemplateHaskell, TupleSections #-} -- | Key bindings model. -- Designed to be imported as @qualified@. module Hbro.Keys (
Hbro/Main.hs view
@@ -2,14 +2,8 @@ -- {{{ Imports import Hbro--import Control.Lens--import Paths_hbro -- }}} --- | Default main function provided as example+-- Default main function provided as example main :: IO ()-main = do- theUIFile <- getDataFileName "examples/ui.xml"- hbro (return ()) (set uIFile theUIFile)+main = hbro $ return ()
Hbro/Network.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} -- | Functions from 'Network.URI' rewritten with 'MonadError' instead of 'Maybe'. module Hbro.Network where
Hbro/Notification.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-} module Hbro.Notification where -- {{{ Imports
Hbro/Options.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, RankNTypes, TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances, TemplateHaskell #-} -- | Commandline options tools. Designed to be imported as @qualified@. module Hbro.Options ( CliOptions(),@@ -7,6 +7,7 @@ help, quiet, verbose,+ version, vanilla, recompile, denyReconf,@@ -45,6 +46,7 @@ _help :: Bool, _quiet :: Bool, _verbose :: Bool,+ _version :: Bool, _vanilla :: Bool, _recompile :: Bool, _denyReconf :: Bool,@@ -60,6 +62,7 @@ ++ (view help opts ? " HELP" ?? "") ++ (view quiet opts ? " QUIET" ?? "") ++ (view verbose opts ? " VERBOSE" ?? "")+ ++ (view version opts ? " VERSION" ?? "") ++ (view vanilla opts ? " VANILLA" ?? "") ++ (view recompile opts ? " RECOMPILE" ?? "") ++ (view denyReconf opts ? " DENY_RECONFIGURATION" ?? "")@@ -72,6 +75,7 @@ _help = False, _quiet = False, _verbose = False,+ _version = False, _vanilla = False, _recompile = False, _denyReconf = False,@@ -95,6 +99,7 @@ Option ['h'] ["help"] (NoArg (\o -> o { _help = True })) "Print this help.", Option ['q'] ["quiet"] (NoArg (\o -> o { _quiet = True })) "Do not print any log.", Option ['v'] ["verbose"] (NoArg (\o -> o { _verbose = True })) "Print detailed logs.",+ Option ['V'] ["version"] (NoArg (\o -> o { _version = True })) "Print version.", Option ['1'] ["vanilla"] (NoArg (\o -> o { _vanilla = True })) "Do not read custom configuration file.", Option ['r'] ["recompile"] (NoArg (\o -> o { _recompile = True })) "Only recompile configuration.", Option [] ["deny-reconf"] (NoArg id) "Do not recompile configuration even if it has changed.",
Hbro/Prompt.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances, TemplateHaskell #-} -- | Designed to be imported as @qualified@. module Hbro.Prompt( PromptBar(..),
Hbro/Util.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-} module Hbro.Util where -- {{{ Imports
Hbro/Webkit/WebSettings.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} -- | Designed to be imported as @qualified@. module Hbro.Webkit.WebSettings where
Hbro/Webkit/WebView.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, RankNTypes, TemplateHaskell #-} -- | Rewrite many 'Graphics.UI.Gtk.WebKit.WebView' functions in a monadic way. -- Designed to be imported as @qualified@. module Hbro.Webkit.WebView where
hbro.cabal view
@@ -1,5 +1,5 @@ Name: hbro-Version: 1.1.0.0+Version: 1.1.1.0 Synopsis: Minimal KISS compliant browser -- Description: Homepage: http://projects.haskell.org/hbro/@@ -8,8 +8,8 @@ License: OtherLicense License-file: LICENSE -- Copyright:-Author: koral-Maintainer: koral at mailoo dot org+Author: koral <koral at mailoo dot org>+Maintainer: koral <koral at mailoo dot org> Cabal-version: >=1.8 Build-type: Simple@@ -53,7 +53,6 @@ Hbro.Clipboard, Hbro.Config, Hbro.Core,- Hbro.Dyre, Hbro.Error, Hbro.Gui, Hbro.IPC,@@ -66,6 +65,15 @@ Hbro.Gtk.ScrolledWindow, Hbro.Webkit.WebSettings, Hbro.Webkit.WebView+ Extensions:+ ConstraintKinds,+ FlexibleContexts,+ FunctionalDependencies,+ GeneralizedNewtypeDeriving,+ MultiParamTypeClasses,+ RankNTypes++ Other-modules: Hbro.Dyre, Paths_hbro Ghc-options: -Wall Flag threaded@@ -74,14 +82,10 @@ Executable hbro Build-depends:- hbro,+ hbro >= 1.1.1.0, base == 4.*,- data-default,- directory, glib,- gtk,- lens,- mtl+ gtk Main-is: Main.hs Hs-Source-Dirs: Hbro Ghc-options: -Wall