hbro 1.4.0.0 → 1.4.0.1
raw patch · 13 files changed
+145/−152 lines, 13 filesdep +randomdep +uuiddep −aesondep ~webkitgtk3
Dependencies added: random, uuid
Dependencies removed: aeson
Dependency ranges changed: webkitgtk3
Files
- README.rst +1/−1
- hbro.cabal +5/−4
- library/Hbro/Boot.hs +15/−14
- library/Hbro/Config.hs +3/−3
- library/Hbro/Core.hs +3/−3
- library/Hbro/Gdk/KeyVal.hsc +1/−1
- library/Hbro/Gui.hs +3/−3
- library/Hbro/Gui/MainView.hs +62/−61
- library/Hbro/Gui/PromptBar.hs +32/−32
- library/Hbro/Keys.hs +1/−1
- library/Hbro/Options.hs +18/−18
- library/Hbro/Prelude.hs +1/−2
- library/Network/URI/Extended.hs +0/−9
README.rst view
@@ -110,7 +110,7 @@ - javascript's ``window.open`` requests open in the same window instead of spawning a new one; - toggling to source mode reloads current webpage (which may be undesired) -Patches or suggestions are welcome to deal with the following issues.+Patches or suggestions to deal with these issues are welcome. License
hbro.cabal view
@@ -1,5 +1,5 @@ Name: hbro-Version: 1.4.0.0+Version: 1.4.0.1 Synopsis: Minimal extensible web-browser Description: Cf README Homepage: https://github.com/k0ral/hbro@@ -22,7 +22,6 @@ Library Build-depends:- aeson, base == 4.*, bytestring, classy-prelude >= 0.12,@@ -51,6 +50,7 @@ pango, parsec, process,+ random, resourcet >= 1.1.5, safe, semigroups,@@ -61,6 +61,7 @@ transformers, transformers-base, unix,+ uuid, webkitgtk3 >= 0.13.1.2, zeromq4-haskell if impl(ghc < 7.10)@@ -107,7 +108,7 @@ -- Includes: include/cbits.h -- Install-includes: include/cbits.h Hs-Source-Dirs: library- Ghc-options: -Wall -fno-warn-unused-do-bind -threaded+ Ghc-options: -Wall -fno-warn-unused-do-bind Flag threaded Description: Build with -threaded@@ -115,7 +116,7 @@ Executable hbro Build-depends:- hbro >= 1.3.0.0,+ hbro >= 1.4.0.0, base == 4.* Main-is: Main.hs Hs-Source-Dirs: executable
library/Hbro/Boot.hs view
@@ -25,6 +25,7 @@ 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@@ -35,8 +36,8 @@ import System.Directory import System.Info-import System.Posix.Process import System.Posix.Signals+import System.Random import qualified System.ZMQ4 as ZMQ (version) -- }}} @@ -68,7 +69,7 @@ case options of Left Rebuild -> Dyre.recompile >>= mapM_ putStrLn Left Version -> printVersions- Right runOptions -> runResourceT . runThreadedLoggingT (runOptions^.logLevelL) $ Dyre.wrap (runOptions^.dyreModeL)+ Right runOptions -> runResourceT . runThreadedLoggingT (runOptions^.logLevel_) $ Dyre.wrap (runOptions^.dyreMode_) (withAsyncBound guiThread . mainThread) (settings, runOptions) @@ -102,18 +103,18 @@ . withReaderT (builder, ) . withReaderT (keySignal, ) . withAsync (bindCommands socketURI (commandMap settings)) . const $ do- bindKeys (mainView^.keyPressedHandlerL) keySignal (keyMap settings)+ bindKeys (mainView^.keyPressedHandler_) keySignal (keyMap settings) - addHandler (mainView^.linkClickedHandlerL) defaultLinkClickedHandler- addHandler (mainView^.loadRequestedHandlerL) defaultLoadRequestedHandler- addHandler (mainView^.newWindowHandlerL) defaultNewWindowHandler- addHandler (mainView^.titleChangedHandlerL) defaultTitleChangedHandler+ addHandler (mainView^.linkClickedHandler_) defaultLinkClickedHandler+ addHandler (mainView^.loadRequestedHandler_) defaultLoadRequestedHandler+ addHandler (mainView^.newWindowHandler_) defaultNewWindowHandler+ addHandler (mainView^.titleChangedHandler_) defaultTitleChangedHandler startUp settings debug . ("Start-up configuration: \n" ++) . describe =<< Config.get id - maybe goHome (load <=< getStartURI) (options^.startURIL)+ maybe goHome (load <=< getStartURI) (options^.startURI_) io $ wait uiThread debug "All threads correctly exited."@@ -124,17 +125,17 @@ getUIFiles options = do fileFromConfig <- getAppUserDataDirectory "hbro" >/> "ui.xml" fileFromPackage <- getDataFileName "examples/ui.xml"- return $ catMaybes [options^.uiFileL, Just fileFromConfig, Just fileFromPackage]+ return $ catMaybes [options^.uiFile_, Just fileFromConfig, Just fileFromPackage] -- | Return socket URI used by this instance getSocketURI :: (MonadIO m, Functor m) => CliOptions -> m Text-getSocketURI options = maybe getDefaultSocketURI (return . normalize) $ options^.socketPathL+getSocketURI options = maybe getDefaultSocketURI (return . normalize) $ options^.socketPath_ where normalize = ("ipc://" ++) . pack getDefaultSocketURI = do- dir <- pack <$> io getTemporaryDirectory- pid <- io getProcessID- return $ "ipc://" ++ dir ++ "/hbro." ++ tshow pid+ dir <- pack <$> io getTemporaryDirectory+ uuid <- io (randomIO :: IO UUID)+ return $ "ipc://" ++ dir ++ "/hbro-" ++ tshow uuid -- | Parse URI passed in commandline, check whether it is a file path or an internet URI -- and return the corresponding normalized URI (that is: prefixed with "file://" or "http://")@@ -143,7 +144,7 @@ fileURI <- io . doesFileExist $ show uri workingDir <- pack <$> io getCurrentDirectory - parseURIReference ("file://" ++ workingDir ++ "/" ++ tshow uri) <| fileURI |> return uri+ if fileURI then parseURIReference ("file://" ++ workingDir ++ "/" ++ tshow uri) else return uri -- maybe abort return =<< logErrors (parseURIReference fileURI') printVersions :: IO ()
library/Hbro/Config.hs view
@@ -13,7 +13,7 @@ module Hbro.Config ( -- * Types Config- , homePageL+ , homePage_ -- * Getter/setter , get , set@@ -32,12 +32,12 @@ -- | Custom settings provided by the user declareLenses [d| data Config = Config- { homePageL :: URI+ { homePage_ :: URI } |] instance Describable Config where- describe c = "Home page = " ++ tshow (c^.homePageL)+ describe c = "Home page = " ++ tshow (c^.homePage_) instance Default Config where def = Config $ fromJust . N.parseURI $ "https://duckduckgo.com/"
library/Hbro/Core.hs view
@@ -101,7 +101,7 @@ -- {{{ Browsing goHome :: (MonadIO m, MonadLogger m, MonadReader r m, Has MainView r, Has (TVar Config) r, MonadThrow m) => m ()-goHome = load =<< Config.get homePageL+goHome = load =<< Config.get homePage_ load :: (MonadIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadThrow m) => URI -> m () load uri = do@@ -137,11 +137,11 @@ -- goForward = load' =<< Browser.stepForward =<< getURI reload = gAsync . webViewReload =<< getWebView goBack = do- gAsync . webViewGoBack =<< getWebView unlessM (gSync . webViewCanGoBack =<< getWebView) $ warning "Unable to go back."+ gAsync . webViewGoBack =<< getWebView goForward = do- gAsync . webViewGoForward =<< getWebView unlessM (gSync . webViewCanGoForward =<< getWebView) $ warning "Unable to go forward."+ gAsync . webViewGoForward =<< getWebView reloadBypassCache, stopLoading :: (MonadIO m, MonadLogger m, MonadReader r m, Has MainView r) => m () reloadBypassCache = getWebView >>= gAsync . webViewReloadBypassCache >> debug "Reloading without cache."
library/Hbro/Gdk/KeyVal.hsc view
@@ -23,7 +23,7 @@ -- | Single characters are returned as is. For other keys, the corresponding keyName wrapped into @\<\>@ is returned. instance Describable KeyVal where- describe (KeyVal key) = name <| (length name < 2) |> ("<" ++ name ++ ">")+ describe (KeyVal key) = if length name < 2 then name else "<" ++ name ++ ">" where name = Gtk.keyName key keyVal, shortKeyVal, longKeyVal :: Parser KeyVal
library/Hbro/Gui.hs view
@@ -21,7 +21,7 @@ import qualified Hbro.Gui.MainView as MainView import Hbro.Gui.NotificationBar (NotificationBar) import qualified Hbro.Gui.NotificationBar as NotifBar-import Hbro.Gui.PromptBar (PromptBar, closedL)+import Hbro.Gui.PromptBar (PromptBar, closed_) import qualified Hbro.Gui.PromptBar as Prompt import Hbro.Gui.StatusBar import Hbro.Logger@@ -52,12 +52,12 @@ notifBar <- NotifBar.initialize =<< NotifBar.buildFrom builder statusBar <- StatusBar <$> getWidget builder "statusBox" - let webView = mainView^.webViewL+ let webView = mainView^.webView_ gAsync . widgetShowAll $ mainWindow Prompt.close promptBar gAsync $ windowSetDefault mainWindow (Just webView)- addHandler (promptBar^.closedL) (const . gAsync $ widgetGrabFocus webView)+ addHandler (promptBar^.closed_) (const . gAsync $ widgetGrabFocus webView) -- io $ scrolledWindowSetPolicy (gui^.scrollWindowL) PolicyNever PolicyNever -- io $ G.set (gui^.scrollWindowL) [ scrolledWindowHscrollbarPolicy := PolicyNever, scrolledWindowVscrollbarPolicy := PolicyNever]
library/Hbro/Gui/MainView.hs view
@@ -6,24 +6,24 @@ {-# LANGUAGE TypeFamilies #-} module Hbro.Gui.MainView ( MainView- , scrollWindowL- , webViewL- , downloadHandlerL- , keyPressedHandlerL- , linkClickedHandlerL- , linkHoveredHandlerL- , linkUnhoveredHandlerL- , loadCommittedHandlerL- , loadFailedHandlerL- , loadFinishedHandlerL- , loadRequestedHandlerL- , loadStartedHandlerL- , newWindowHandlerL- , progressChangedHandlerL- , scrolledHandlerL- , titleChangedHandlerL- , uriChangedHandlerL- , zoomLevelChangedHandlerL+ , scrollWindow_+ , webView_+ , downloadHandler_+ , keyPressedHandler_+ , linkClickedHandler_+ , linkHoveredHandler_+ , linkUnhoveredHandler_+ , loadCommittedHandler_+ , loadFailedHandler_+ , loadFinishedHandler_+ , loadRequestedHandler_+ , loadStartedHandler_+ , newWindowHandler_+ , progressChangedHandler_+ , scrolledHandler_+ , titleChangedHandler_+ , uriChangedHandler_+ , zoomLevelChangedHandler_ , Axis(..) , Position(..) , getWebView@@ -59,7 +59,8 @@ import Graphics.UI.Gtk.General.General.Extended import qualified Graphics.UI.Gtk.Misc.Adjustment as Gtk import Graphics.UI.Gtk.Scrolling.ScrolledWindow-import Graphics.UI.Gtk.WebKit.DOM.Document+import Graphics.UI.Gtk.WebKit.DOM.Document hiding+ (scroll) import Graphics.UI.Gtk.WebKit.Extended hiding (LoadStatus (..), networkRequestGetUri)@@ -80,38 +81,38 @@ declareLenses [d| data MainView = MainView- { scrollWindowL :: ScrolledWindow -- ^ 'ScrolledWindow' containing the webview- , webViewL :: WebView- , downloadHandlerL :: Signal Download- , keyPressedHandlerL :: Signal KeyPressed- , linkClickedHandlerL :: Signal LinkClicked- , linkHoveredHandlerL :: Signal LinkHovered- , linkUnhoveredHandlerL :: Signal LinkUnhovered- , loadCommittedHandlerL :: Signal LoadCommitted- , loadFailedHandlerL :: Signal LoadFailed- , loadFinishedHandlerL :: Signal LoadFinished- , loadRequestedHandlerL :: Signal LoadRequested- , loadStartedHandlerL :: Signal LoadStarted- , newWindowHandlerL :: Signal NewWindow- , progressChangedHandlerL :: Signal ProgressChanged+ { 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- , scrolledHandlerL :: Signal Scrolled- , titleChangedHandlerL :: Signal TitleChanged- , uriChangedHandlerL :: Signal URIChanged- , zoomLevelChangedHandlerL :: Signal ZoomLevelChanged+ , scrolledHandler_ :: Signal Scrolled+ , titleChangedHandler_ :: Signal TitleChanged+ , uriChangedHandler_ :: Signal URIChanged+ , zoomLevelChangedHandler_ :: Signal ZoomLevelChanged } |] -- * Commonly used getters getWebView :: (MonadReader r m, Has MainView r) => m WebView-getWebView = asks $ view webViewL+getWebView = asks $ view webView_ getWebSettings :: (MonadIO m, MonadReader r m, Has MainView r) => m WebSettings-getWebSettings = gSync . webViewGetWebSettings =<< asks (view webViewL)+getWebSettings = gSync . webViewGetWebSettings =<< asks (view webView_) getDOM :: (MonadIO m, MonadReader r m, Has MainView r) => m (Maybe Document)-getDOM = gSync . webViewGetDomDocument =<< asks (view webViewL)+getDOM = gSync . webViewGetDomDocument =<< asks (view webView_) getAdjustment :: (MonadIO m) => Axis -> ScrolledWindow -> m Gtk.Adjustment getAdjustment Horizontal = gSync . scrolledWindowGetHAdjustment@@ -180,40 +181,40 @@ -- -- True -> (putStrLn "OK") -- (maybe (return ()) (`networkRequestSetUri` "about:blank") request) - attachDownload webView $ mainView^.downloadHandlerL- attachKeyPressed webView $ mainView^.keyPressedHandlerL- attachLinkHovered webView (mainView^.linkHoveredHandlerL) (mainView^.linkUnhoveredHandlerL)- attachLoadCommitted webView $ mainView^.loadCommittedHandlerL- attachLoadFailed webView $ mainView^.loadFailedHandlerL- attachLoadFinished webView $ mainView^.loadFinishedHandlerL- attachLoadStarted webView $ mainView^.loadStartedHandlerL- attachNavigationRequest webView (mainView^.linkClickedHandlerL) (mainView^.loadRequestedHandlerL)- attachNewWebView webView $ mainView^.newWindowHandlerL- attachNewWindow webView $ mainView^.newWindowHandlerL- attachProgressChanged webView $ mainView^.progressChangedHandlerL+ attachDownload webView $ mainView^.downloadHandler_+ attachKeyPressed webView $ mainView^.keyPressedHandler_+ attachLinkHovered webView (mainView^.linkHoveredHandler_) (mainView^.linkUnhoveredHandler_)+ attachLoadCommitted webView $ mainView^.loadCommittedHandler_+ attachLoadFailed webView $ mainView^.loadFailedHandler_+ attachLoadFinished webView $ mainView^.loadFinishedHandler_+ attachLoadStarted webView $ mainView^.loadStartedHandler_+ attachNavigationRequest webView (mainView^.linkClickedHandler_) (mainView^.loadRequestedHandler_)+ attachNewWebView webView $ mainView^.newWindowHandler_+ attachNewWindow webView $ mainView^.newWindowHandler_+ attachProgressChanged webView $ mainView^.progressChangedHandler_ -- attachResourceOpened webView (mainView^.resourceOpenedHandler)- attachScrolled mainView $ mainView^.scrolledHandlerL- attachTitleChanged webView $ mainView^.titleChangedHandlerL- attachUriChanged webView $ mainView^.uriChangedHandlerL- attachZoomLevelChanged webView $ mainView^.zoomLevelChangedHandlerL+ attachScrolled mainView $ mainView^.scrolledHandler_+ attachTitleChanged webView $ mainView^.titleChangedHandler_+ attachUriChanged webView $ mainView^.uriChangedHandler_+ attachZoomLevelChanged webView $ mainView^.zoomLevelChangedHandler_ initSettings webView return mainView- where webView = mainView^.webViewL+ where webView = mainView^.webView_ canRender :: (MonadIO m, MonadReader r m, Has MainView r) => Text -> m Bool-canRender mimetype = gSync . (`webViewCanShowMimeType` mimetype) =<< asks (view webViewL)+canRender mimetype = gSync . (`webViewCanShowMimeType` mimetype) =<< asks (view webView_) render :: (MonadReader r m, Has MainView r, MonadIO m, MonadLogger m) => Text -> URI -> m () render page uri = do debug $ "Rendering <" ++ tshow uri ++ ">"- -- loadString page uri =<< get' webViewL+ -- loadString page uri =<< get' webView_ -- debug $ "Base URI: " ++ show (baseOf uri) - loadString page (baseOf uri) =<< asks (view webViewL)+ loadString page (baseOf uri) =<< asks (view webView_) where baseOf uri' = uri' { uriPath = unpack . (`snoc` '/') . intercalate "/" . initSafe . splitOn "/" . pack $ uriPath uri'@@ -269,7 +270,7 @@ scroll axis percentage mainView = do debug $ "Set scroll " ++ tshow axis ++ " = " ++ tshow percentage - adj <- getAdjustment axis $ mainView^.scrollWindowL+ adj <- getAdjustment axis $ mainView^.scrollWindow_ page <- get adj Gtk.adjustmentPageSize current <- get adj Gtk.adjustmentValue lower <- get adj Gtk.adjustmentLower@@ -285,5 +286,5 @@ attachScrolled :: (ControlIO m, MonadLogger m) => MainView -> Signal Scrolled -> m (ConnectId Gtk.Adjustment) attachScrolled mainView signal = do- adjustment <- getAdjustment Vertical $ mainView^.scrollWindowL+ adjustment <- getAdjustment Vertical $ mainView^.scrollWindow_ liftBaseWith $ \runInIO -> gSync . Gtk.onValueChanged adjustment . void . runInIO $ emit signal ()
library/Hbro/Gui/PromptBar.hs view
@@ -11,8 +11,8 @@ module Hbro.Gui.PromptBar ( -- * Types PromptBar- , boxL- , closedL+ , box_+ , closed_ , buildFrom , labelName , entryName@@ -82,12 +82,12 @@ -- | No exported constructor, please use 'buildFrom' declareLenses [d| data PromptBar = PromptBar- { boxL :: HBox- , descriptionL :: Label- , entryL :: Entry- , changedL :: Signal Changed- , closedL :: Signal Closed- , validatedL :: Signal Validated+ { box_ :: HBox+ , description_ :: Label+ , entry_ :: Entry+ , changed_ :: Signal Changed+ , closed_ :: Signal Closed+ , validated_ :: Signal Validated } |] @@ -113,7 +113,7 @@ <*> pure closedSignal <*> pure validated - onEntryChanged entry $ emit (promptBar^.changedL)+ onEntryChanged entry $ emit (promptBar^.changed_) onEntryCanceled entry . async $ close promptBar onEntryValidated entry $ emit validated @@ -128,33 +128,33 @@ initialize :: (MonadIO m) => PromptBar -> m PromptBar initialize =- withM_ descriptionL (gAsync . (`labelSetAttributes` [allItalic, allBold]))- >=> withM_ descriptionL (gAsync . (`labelSetAttributes` [AttrForeground {paStart = 0, paEnd = -1, paColor = gray}]))- >=> withM_ entryL (gAsync . (\e -> widgetModifyBase e StateNormal black))- >=> withM_ entryL (gAsync . (\e -> widgetModifyText e StateNormal gray))+ 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)) open :: (MonadIO m) => Text -> Text -> PromptBar -> m PromptBar open description defaultText =- withM_ descriptionL (gAsync . (`labelSetText` description))- >=> withM_ entryL (gAsync . (`entrySetText` defaultText))- >=> withM_ boxL (gAsync . widgetShow)- >=> withM_ entryL (gAsync . widgetGrabFocus)- >=> withM_ entryL (gAsync . (`editableSetPosition` (-1)))+ withM_ description_ (gAsync . (`labelSetText` description))+ >=> withM_ entry_ (gAsync . (`entrySetText` defaultText))+ >=> withM_ box_ (gAsync . widgetShow)+ >=> withM_ entry_ (gAsync . widgetGrabFocus)+ >=> withM_ entry_ (gAsync . (`editableSetPosition` (-1))) close :: (ControlIO m, MonadLogger m) => PromptBar -> m PromptBar close promptBar = do runMaybeT $ do- guard =<< get (promptBar^.boxL) widgetVisible- emit (promptBar^.closedL) ()- gAsync . widgetHide $ promptBar^.boxL+ guard =<< get (promptBar^.box_) widgetVisible+ emit (promptBar^.closed_) ()+ gAsync . widgetHide $ promptBar^.box_ void $ clean promptBar return promptBar -- | Close prompt, that is: clean its content, signals and callbacks clean :: (ControlIO m) => PromptBar -> m PromptBar-clean = withM_ entryL (gAsync . (`widgetRestoreText` StateNormal))- >=> withM_ entryL (gAsync . (\e -> widgetModifyText e StateNormal gray))+clean = withM_ entry_ (gAsync . (`widgetRestoreText` StateNormal))+ >=> withM_ entry_ (gAsync . (\e -> widgetModifyText e StateNormal gray)) -- {{{ Prompts@@ -169,8 +169,8 @@ clean promptBar open description startValue promptBar - cancelation <- listenTo $ promptBar^.closedL- validation <- listenTo $ promptBar^.validatedL+ cancelation <- listenTo $ promptBar^.closed_+ validation <- listenTo $ promptBar^.validated_ result <- io $ waitEitherCancel cancelation validation close promptBar@@ -190,10 +190,10 @@ iprompt description startValue f promptBar = do clean promptBar - update <- addHandler (promptBar^.changedL) f+ update <- addHandler (promptBar^.changed_) f open description startValue promptBar - io . wait =<< listenTo (promptBar^.closedL)+ io . wait =<< listenTo (promptBar^.closed_) close promptBar release update @@ -211,11 +211,11 @@ uriPrompt description startValue promptBar = do clean promptBar - update <- addHandler (promptBar^.changedL) $ checkURI promptBar+ update <- addHandler (promptBar^.changed_) $ checkURI promptBar open description startValue promptBar - validation <- listenTo $ promptBar^.validatedL- cancelation <- listenTo $ promptBar^.closedL+ validation <- listenTo $ promptBar^.validated_+ cancelation <- listenTo $ promptBar^.closed_ result <- io $ waitEitherCancel cancelation validation release update@@ -231,11 +231,11 @@ checkURI :: (MonadIO m, MonadLogger m) => PromptBar -> Text -> m () checkURI promptBar v = do debug $ "Is URI ? " ++ tshow (isURIReference $ unpack v)- gAsync $ widgetModifyText (promptBar^.entryL) StateNormal (green <| isURIReference (unpack v) |> red)+ gAsync $ widgetModifyText (promptBar^.entry_) StateNormal (if isURIReference (unpack v) then green else red) getPromptValue :: (MonadIO m) => PromptBar -> m Text-getPromptValue = gSync . entryGetText . view entryL+getPromptValue = gSync . entryGetText . view entry_ getPromptValueM :: (MonadIO m, MonadReader r m, Has PromptBar r) => m Text getPromptValueM = getPromptValue =<< ask
library/Hbro/Keys.hs view
@@ -133,4 +133,4 @@ emit output (strokesL, isJust found) async . logErrors $ fromMaybe doNothing found- return $ empty <| reset |> strokesL+ return $ if reset then empty else strokesL
library/Hbro/Options.hs view
@@ -7,12 +7,12 @@ module Hbro.Options ( Command(..) , CliOptions()- , startURIL- , socketPathL- , uiFileL- , dyreModeL- , dyreDebugL- , logLevelL+ , startURI_+ , socketPath_+ , uiFile_+ , dyreMode_+ , dyreDebug_+ , logLevel_ , parseOptions ) where @@ -39,23 +39,23 @@ -- | Available options declareLenses [d| data CliOptions = CliOptions- { startURIL :: Maybe URI- , socketPathL :: Maybe FilePath- , uiFileL :: Maybe FilePath- , dyreModeL :: Dyre.Mode- , dyreDebugL :: Bool- , logLevelL :: LogLevel+ { startURI_ :: Maybe URI+ , socketPath_ :: Maybe FilePath+ , uiFile_ :: Maybe FilePath+ , dyreMode_ :: Dyre.Mode+ , dyreDebug_ :: Bool+ , logLevel_ :: LogLevel } deriving(Eq) |] instance Describable CliOptions where describe opts = unwords $ catMaybes- [ ("URI=" ++) . tshow <$> (opts^.startURIL)- , ("SOCKET=" ++) . pack <$> (opts^.socketPathL)- , ("UI=" ++) . pack <$> (opts^.uiFileL)- , Just . ("DYRE_MODE=" ++) . tshow $ opts^.dyreModeL- , Just "DYRE_DEBUG" <| opts^.dyreDebugL |> Nothing- , Just . ("LOG-LEVEL=" ++) . tshow $ opts^.logLevelL+ [ ("URI=" ++) . tshow <$> (opts^.startURI_)+ , ("SOCKET=" ++) . pack <$> (opts^.socketPath_)+ , ("UI=" ++) . pack <$> (opts^.uiFile_)+ , Just . ("DYRE_MODE=" ++) . tshow $ opts^.dyreMode_+ , if opts^.dyreDebug_ then Just "DYRE_DEBUG" else Nothing+ , Just . ("LOG-LEVEL=" ++) . tshow $ opts^.logLevel_ ] instance Default CliOptions where
library/Hbro/Prelude.hs view
@@ -35,8 +35,7 @@ import Control.Applicative as X (Alternative (..), WrappedMonad, optional) import Control.Arrow as X (Kleisli (..), left, right)-import Control.Conditional as X (ToBool (..), (<<|), (<|),- (|>), (|>>))+import Control.Conditional as X (ToBool (..)) import Control.Lens import Control.Monad.Base as X (MonadBase (..)) import Control.Monad.Reader.Extended as X hiding (get)
library/Network/URI/Extended.hs view
@@ -13,18 +13,9 @@ import Hbro.Error import Hbro.Prelude -import Data.Aeson- import Network.URI as X hiding (parseURI, parseURIReference) import qualified Network.URI as N -- }}}--instance FromJSON URI where- parseJSON (String t) = maybe mzero return $ parseURIReference t- parseJSON _ = mzero--instance ToJSON URI where- toJSON = String . tshow -- | Generalized version of 'N.parseURIReference'. parseURIReference :: (MonadThrow m) => Text -> m URI