diff --git a/README.rst b/README.rst --- a/README.rst +++ b/README.rst @@ -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 diff --git a/hbro.cabal b/hbro.cabal --- a/hbro.cabal +++ b/hbro.cabal @@ -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 diff --git a/library/Hbro/Boot.hs b/library/Hbro/Boot.hs --- a/library/Hbro/Boot.hs +++ b/library/Hbro/Boot.hs @@ -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 () diff --git a/library/Hbro/Config.hs b/library/Hbro/Config.hs --- a/library/Hbro/Config.hs +++ b/library/Hbro/Config.hs @@ -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/" diff --git a/library/Hbro/Core.hs b/library/Hbro/Core.hs --- a/library/Hbro/Core.hs +++ b/library/Hbro/Core.hs @@ -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." diff --git a/library/Hbro/Gdk/KeyVal.hsc b/library/Hbro/Gdk/KeyVal.hsc --- a/library/Hbro/Gdk/KeyVal.hsc +++ b/library/Hbro/Gdk/KeyVal.hsc @@ -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 diff --git a/library/Hbro/Gui.hs b/library/Hbro/Gui.hs --- a/library/Hbro/Gui.hs +++ b/library/Hbro/Gui.hs @@ -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] diff --git a/library/Hbro/Gui/MainView.hs b/library/Hbro/Gui/MainView.hs --- a/library/Hbro/Gui/MainView.hs +++ b/library/Hbro/Gui/MainView.hs @@ -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 () diff --git a/library/Hbro/Gui/PromptBar.hs b/library/Hbro/Gui/PromptBar.hs --- a/library/Hbro/Gui/PromptBar.hs +++ b/library/Hbro/Gui/PromptBar.hs @@ -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 diff --git a/library/Hbro/Keys.hs b/library/Hbro/Keys.hs --- a/library/Hbro/Keys.hs +++ b/library/Hbro/Keys.hs @@ -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 diff --git a/library/Hbro/Options.hs b/library/Hbro/Options.hs --- a/library/Hbro/Options.hs +++ b/library/Hbro/Options.hs @@ -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 diff --git a/library/Hbro/Prelude.hs b/library/Hbro/Prelude.hs --- a/library/Hbro/Prelude.hs +++ b/library/Hbro/Prelude.hs @@ -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) diff --git a/library/Network/URI/Extended.hs b/library/Network/URI/Extended.hs --- a/library/Network/URI/Extended.hs +++ b/library/Network/URI/Extended.hs @@ -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