Skip to content
This repository has been archived by the owner on Jan 15, 2022. It is now read-only.

Commit

Permalink
As a convention, use a trailing underscore for lenses.
Browse files Browse the repository at this point in the history
  • Loading branch information
koral committed Jun 26, 2015
1 parent 87e33e1 commit 00756f2
Show file tree
Hide file tree
Showing 8 changed files with 127 additions and 127 deletions.
18 changes: 9 additions & 9 deletions library/Hbro/Boot.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ hbro settings = do
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)

Expand Down Expand Up @@ -102,18 +102,18 @@ mainThread (settings, options) uiThread = logErrors_ $ do
. 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."
Expand All @@ -124,11 +124,11 @@ getUIFiles :: (MonadIO m, Functor m) => CliOptions -> m [FilePath]
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
Expand Down
6 changes: 3 additions & 3 deletions library/Hbro/Config.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@
module Hbro.Config (
-- * Types
Config
, homePageL
, homePage_
-- * Getter/setter
, get
, set
Expand All @@ -32,12 +32,12 @@ import qualified Network.URI as N
-- | 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/"
Expand Down
2 changes: 1 addition & 1 deletion library/Hbro/Core.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,7 +101,7 @@ getPageData = dataSourceGetData =<< io . webFrameGetDataSource =<< io . webViewG

-- {{{ 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
Expand Down
6 changes: 3 additions & 3 deletions library/Hbro/Gui.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ import Hbro.Gui.MainView hiding (initialize)
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
Expand Down Expand Up @@ -52,12 +52,12 @@ initialize (pack -> file) = do
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]
Expand Down
120 changes: 60 additions & 60 deletions library/Hbro/Gui/MainView.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -80,38 +80,38 @@ instance Event Scrolled where

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
Expand Down Expand Up @@ -180,40 +180,40 @@ initialize mainView = do
-- -- 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'
Expand Down Expand Up @@ -269,7 +269,7 @@ scroll :: (MonadIO m, MonadLogger m) => Axis -> Position -> MainView -> m MainVi
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
Expand All @@ -285,5 +285,5 @@ scroll axis percentage mainView = do

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 ()
Loading

0 comments on commit 00756f2

Please sign in to comment.