hbro 1.6.0.0 → 1.7.0.0
raw patch · 8 files changed
+102/−88 lines, 8 filesdep +microlens-platformdep +template-haskelldep −lensdep ~hbro
Dependencies added: microlens-platform, template-haskell
Dependencies removed: lens
Dependency ranges changed: hbro
Files
- hbro.cabal +4/−3
- library/Hbro/Boot.hs +2/−1
- library/Hbro/Config.hs +10/−12
- library/Hbro/Gui.hs +3/−1
- library/Hbro/Gui/MainView.hs +26/−25
- library/Hbro/Gui/PromptBar.hs +36/−25
- library/Hbro/Options.hs +12/−12
- library/Hbro/Prelude.hs +9/−9
hbro.cabal view
@@ -1,5 +1,5 @@ Name: hbro-Version: 1.6.0.0+Version: 1.7.0.0 Synopsis: Minimal extensible web-browser Description: Cf README Homepage: https://github.com/k0ral/hbro@@ -39,7 +39,7 @@ -- http-conduit, -- http-conduit-browser, -- http-types,- lens >= 4.4,+ microlens-platform, lifted-async >= 0.6, lifted-base >= 0.2.3.3, mtl >= 2.2,@@ -57,6 +57,7 @@ safe, semigroups, stm-chans,+ template-haskell, text, -- text-icu, time >= 1.5,@@ -118,7 +119,7 @@ Executable hbro Build-depends:- hbro >= 1.5,+ hbro >= 1.7, base == 4.* Main-is: Main.hs Hs-Source-Dirs: executable
library/Hbro/Boot.hs view
@@ -24,13 +24,14 @@ import Control.Concurrent.Async.Lifted import Control.Concurrent.STM.MonadIO-import Control.Lens hiding ((<|), (??), (|>)) import Control.Monad.Trans.Resource import Data.UUID import Data.Version hiding (Version) import Graphics.UI.Gtk.General.General as Gtk++import Lens.Micro.Platform import Network.URI.Extended
library/Hbro/Config.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-} -- | General configuration parameters. -- The recommended way to import this module is: -- @@@ -15,28 +14,27 @@ Config , homePage_ -- * Getter/setter- , get- , set+ , Hbro.Config.get+ , Hbro.Config.set ) where -- {{{ Imports import Hbro.Prelude -import Control.Concurrent.STM.MonadIO-import Control.Lens hiding (set)-import qualified Control.Lens as L (set)+import Control.Concurrent.STM.MonadIO +import Lens.Micro.Platform as Lens+ import Network.URI (URI) import qualified Network.URI as N -- }}} -- | Custom settings provided by the user-declareLenses [d|- data Config = Config- { homePage_ :: URI- }- |]+data Config = Config URI +homePage_ :: Lens' Config URI+homePage_ f (Config a) = (\b -> Config b) <$> f a+ instance Describable Config where describe c = "Home page = " <> show (c^.homePage_) @@ -47,4 +45,4 @@ get l = fmap (view l) (readTVar =<< ask) set :: (MonadIO m, MonadReader r m, Has (TVar Config) r) => Lens' Config a -> a -> m ()-set l v = void . (`modifyTVar` L.set l v) =<< ask+set l v = void . (`modifyTVar` Lens.set l v) =<< ask
library/Hbro/Gui.hs view
@@ -28,7 +28,6 @@ import Hbro.Logger import Hbro.Prelude -import Control.Lens.Getter import Control.Monad.Trans.Resource import Graphics.Rendering.Pango.Enums@@ -37,6 +36,9 @@ import Graphics.UI.Gtk.General.General.Extended (gAsync, gSync) import qualified Graphics.UI.Gtk.General.General.Extended as Gtk import Graphics.UI.Gtk.Windows.Window++import Lens.Micro.Platform+ import System.Glib.Signals hiding (Signal) -- }}}
library/Hbro/Gui/MainView.hs view
@@ -50,8 +50,6 @@ import Hbro.Prelude import Hbro.WebView.Signals -import Control.Lens hiding (set, snoc)- import qualified Graphics.UI.Gtk.Abstract.Container as Gtk import Graphics.UI.Gtk.Abstract.Widget import qualified Graphics.UI.Gtk.Builder as Gtk@@ -67,6 +65,8 @@ import Graphics.UI.Gtk.WebKit.WebPolicyDecision import Graphics.UI.Gtk.WebKit.WebSettings +import Lens.Micro.Platform hiding(set)+ import Network.URI import System.Glib.Attributes.Extended@@ -78,29 +78,30 @@ instance Event Scrolled where describeInput _ _ = Just "Scrolled" -declareLenses [d|- data MainView = MainView- { scrollWindow_ :: ScrolledWindow -- ^ 'ScrolledWindow' containing the webview- , webView_ :: WebView- , downloadHandler_ :: Signal Download- , keyPressedHandler_ :: Signal KeyPressed- , linkClickedHandler_ :: Signal LinkClicked- , linkHoveredHandler_ :: Signal LinkHovered- , linkUnhoveredHandler_ :: Signal LinkUnhovered- , loadCommittedHandler_ :: Signal LoadCommitted- , loadFailedHandler_ :: Signal LoadFailed- , loadFinishedHandler_ :: Signal LoadFinished- , loadRequestedHandler_ :: Signal LoadRequested- , loadStartedHandler_ :: Signal LoadStarted- , newWindowHandler_ :: Signal NewWindow- , progressChangedHandler_ :: Signal ProgressChanged- -- , resourceOpenedHandlerL :: Signal ResourceOpened- , scrolledHandler_ :: Signal Scrolled- , titleChangedHandler_ :: Signal TitleChanged- , uriChangedHandler_ :: Signal URIChanged- , zoomLevelChangedHandler_ :: Signal ZoomLevelChanged- }- |]+data MainView = MainView+ { _scrollWindow :: ScrolledWindow -- ^ 'ScrolledWindow' containing the webview+ , _webView :: WebView+ , _downloadHandler :: Signal Download+ , _keyPressedHandler :: Signal KeyPressed+ , _linkClickedHandler :: Signal LinkClicked+ , _linkHoveredHandler :: Signal LinkHovered+ , _linkUnhoveredHandler :: Signal LinkUnhovered+ , _loadCommittedHandler :: Signal LoadCommitted+ , _loadFailedHandler :: Signal LoadFailed+ , _loadFinishedHandler :: Signal LoadFinished+ , _loadRequestedHandler :: Signal LoadRequested+ , _loadStartedHandler :: Signal LoadStarted+ , _newWindowHandler :: Signal NewWindow+ , _progressChangedHandler :: Signal ProgressChanged+ -- , resourceOpenedHandler :: Signal ResourceOpened+ , _scrolledHandler :: Signal Scrolled+ , _titleChangedHandler :: Signal TitleChanged+ , _uriChangedHandler :: Signal URIChanged+ , _zoomLevelChangedHandler :: Signal ZoomLevelChanged+ }+++makeLensesWith (lensRules & lensField .~ lensGen) ''MainView -- * Commonly used getters
library/Hbro/Gui/PromptBar.hs view
@@ -43,8 +43,6 @@ import Hbro.Prelude import Control.Concurrent.Async.Lifted-import Control.Lens.Getter-import Control.Lens.TH import Control.Monad.Trans.Maybe import Control.Monad.Trans.Resource hiding(throwM) @@ -58,6 +56,8 @@ import Graphics.UI.Gtk.General.General.Extended import Graphics.UI.Gtk.Layout.HBox +import Lens.Micro.Platform+ import Network.URI.Extended import System.Glib.Attributes.Extended@@ -80,17 +80,17 @@ describeInput _ = Just . (<>) "Prompt validated with value: " -- | No exported constructor, please use 'buildFrom'-declareLenses [d|- data PromptBar = PromptBar- { box_ :: HBox- , description_ :: Label- , entry_ :: Entry- , changed_ :: Signal Changed- , closed_ :: Signal Closed- , validated_ :: Signal Validated- }- |]+data PromptBar = PromptBar+ { _box :: HBox+ , _description :: Label+ , _entry :: Entry+ , _changed :: Signal Changed+ , _closed :: Signal Closed+ , _validated :: Signal Validated+ } +makeLensesWith (lensRules & lensField .~ lensGen) ''PromptBar+ data PromptException = PromptInterrupted deriving(Eq, Show) instance Exception PromptException where@@ -125,20 +125,26 @@ boxName = "promptBox" initialize :: (MonadIO m) => PromptBar -> m PromptBar-initialize =- withM_ description_ (gAsync . (`labelSetAttributes` [allItalic, allBold]))- >=> withM_ description_ (gAsync . (`labelSetAttributes` [AttrForeground {paStart = 0, paEnd = -1, paColor = gray}]))- >=> withM_ entry_ (gAsync . (\e -> widgetModifyBase e StateNormal black))- >=> withM_ entry_ (gAsync . (\e -> widgetModifyText e StateNormal gray))+initialize promptBar = do+ mapM gAsync+ [ labelSetAttributes (promptBar ^. description_) [allItalic, allBold]+ , labelSetAttributes (promptBar ^. description_) [AttrForeground {paStart = 0, paEnd = -1, paColor = gray}]+ , widgetModifyBase (promptBar ^. entry_) StateNormal black+ , widgetModifyText (promptBar ^. entry_) StateNormal gray+ ]+ return promptBar open :: (MonadIO m) => Text -> Text -> PromptBar -> m PromptBar-open description defaultText =- withM_ description_ (gAsync . (`labelSetText` description))- >=> withM_ entry_ (gAsync . (`entrySetText` defaultText))- >=> withM_ box_ (gAsync . widgetShow)- >=> withM_ entry_ (gAsync . widgetGrabFocus)- >=> withM_ entry_ (gAsync . (`editableSetPosition` (-1)))+open description defaultText promptBar = do+ mapM gAsync+ [ labelSetText (promptBar ^. description_) description+ , entrySetText (promptBar ^. entry_) defaultText+ , widgetShow $ promptBar ^. box_+ , widgetGrabFocus $ promptBar ^. entry_+ , editableSetPosition (promptBar ^. entry_) (-1)+ ]+ return promptBar close :: (ControlIO m, MonadLogger m) => PromptBar -> m PromptBar close promptBar = do@@ -151,8 +157,13 @@ -- | Close prompt, that is: clean its content, signals and callbacks clean :: (ControlIO m) => PromptBar -> m PromptBar-clean = withM_ entry_ (gAsync . (`widgetRestoreText` StateNormal))- >=> withM_ entry_ (gAsync . (\e -> widgetModifyText e StateNormal gray))+clean promptBar = do+ mapM gAsync+ [ widgetRestoreText (promptBar ^. entry_) StateNormal+ , widgetModifyText (promptBar ^. entry_) StateNormal gray+ ]+ return promptBar+ -- {{{ Prompts
library/Hbro/Options.hs view
@@ -21,10 +21,10 @@ import Hbro.Error import Hbro.Prelude -import Control.Lens.Getter-import Control.Lens.TH import Control.Monad.Logger +import Lens.Micro.Platform+ import Network.URI import Options.Applicative.Builder@@ -37,16 +37,16 @@ data Command = Rebuild | Version -- | Available options-declareLenses [d|- data CliOptions = CliOptions- { startURI_ :: Maybe URI- , socketPath_ :: Maybe FilePath- , uiFile_ :: Maybe FilePath- , dyreMode_ :: Dyre.Mode- , dyreDebug_ :: Bool- , logLevel_ :: LogLevel- } deriving(Eq)- |]+data CliOptions = CliOptions+ { _startURI :: Maybe URI+ , _socketPath :: Maybe FilePath+ , _uiFile :: Maybe FilePath+ , _dyreMode :: Dyre.Mode+ , _dyreDebug :: Bool+ , _logLevel :: LogLevel+ } deriving(Eq)++makeLensesWith (lensRules & lensField .~ lensGen) ''CliOptions instance Describable CliOptions where describe opts = unwords $ catMaybes
library/Hbro/Prelude.hs view
@@ -20,8 +20,7 @@ , abort , doNothing -- * Lens util- , withM- , withM_+ , lensGen , fwd ) where @@ -30,7 +29,6 @@ WrappedMonad, optional) import Control.Arrow as X (Kleisli (..), left, right) import Control.Conditional as X (ToBool (..))-import Control.Lens import Control.Monad as X (MonadPlus (..), forM_, forM_, guard, join, unless, void, when, (<=<), (>=>))@@ -57,6 +55,10 @@ import qualified GHC.Show as Show +import Language.Haskell.TH.Syntax++import Lens.Micro.Platform+ import Prelude as X hiding (break, drop, dropWhile, error, filter, lines, readFile, replicate,@@ -111,12 +113,10 @@ -- }}} -- {{{ Lens util--- | Alias for 'mapMOf'-withM :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t-withM = mapMOf--withM_ :: Monad m => Over (->) (WrappedMonad m) s t a a -> (a -> m ()) -> s -> m t-withM_ l f = mapMOf l (fwd f)+-- | Lens field generator+lensGen _ _ n = case nameBase n of+ '_':x -> [TopName (mkName $ x ++ "_")]+ _ -> [] fwd :: (Monad m) => (a -> m ()) -> a -> m a fwd f x = f x >> return x