hbro-contrib 1.4.0.0 → 1.5.0.0
raw patch · 5 files changed
+37/−23 lines, 5 filesdep ~hbro
Dependency ranges changed: hbro
Files
- Data/Aeson/Extended.hs +14/−0
- Hbro/Bookmarks.hs +7/−7
- Hbro/History.hs +2/−2
- Hbro/StatusBar.hs +11/−11
- hbro-contrib.cabal +3/−3
Data/Aeson/Extended.hs view
@@ -2,18 +2,32 @@ {-# LANGUAGE NoImplicitPrelude #-} module Data.Aeson.Extended (module X, module Data.Aeson.Extended) where +-- {{{ Imports import ClassyPrelude import Data.Aeson as X import Data.Aeson.Encode.Pretty as X import qualified Data.ByteString.Lazy as Lazy+import Data.Text as T +import Network.URI+-- }}} data JsonException = UnableDecode String deriving(Eq) instance Exception JsonException instance Show JsonException where show (UnableDecode s) = s++-- | Trivial wrapper around 'URI', used to avoid orphan instances.+newtype WrappedURI = WrappedURI { unwrapURI :: URI }++instance FromJSON WrappedURI where+ parseJSON (String s) = maybe mzero (return . WrappedURI) . parseURIReference $ T.unpack s+ parseJSON _ = mzero++instance ToJSON WrappedURI where+ toJSON (WrappedURI uri) = toJSON $ show uri decodeM :: (FromJSON a, MonadThrow m) => Lazy.ByteString -> m a decodeM = either (throwM . UnableDecode) return . eitherDecode
Hbro/Bookmarks.hs view
@@ -37,22 +37,22 @@ -- {{{ Type definitions data Entry = Entry- { _uri :: URI- , _tags :: Set Text- }+ { _uri :: URI+ , _tags :: Set Text+ } deriving instance Eq Entry deriving instance Ord Entry instance Describable Entry where- describe (Entry uri tags) = unwords $ map (\x -> "[" ++ x ++ "]") (Set.toList tags) ++ [tshow uri]+ describe (Entry uri tags) = unwords $ map (\x -> "[" ++ x ++ "]") (Set.toList tags) ++ [tshow uri] instance FromJSON Entry where- parseJSON (Object v) = Entry <$> v .: "uri" <*> v .: "tags"- parseJSON _ = mzero+ parseJSON (Object v) = Entry <$> (unwrapURI <$> v .: "uri") <*> v .: "tags"+ parseJSON _ = mzero instance ToJSON Entry where- toJSON (Entry u t) = object ["uri" .= u, "tags" .= t]+ toJSON (Entry u t) = object ["uri" .= WrappedURI u, "tags" .= t] -- }}} -- | Return bookmarks file
Hbro/History.hs view
@@ -47,11 +47,11 @@ describe (Entry time uri title) = unwords [pack (formatTime defaultTimeLocale dateFormat time), tshow uri, title] instance FromJSON Entry where- parseJSON (Object v) = Entry <$> v .: "time" <*> v .: "uri" <*> v .: "title"+ parseJSON (Object v) = Entry <$> v .: "time" <*> (unwrapURI <$> v .: "uri") <*> v .: "title" parseJSON _ = mzero instance ToJSON Entry where- toJSON (Entry time uri title) = object ["time" .= time, "uri" .= uri, "title" .= title]+ toJSON (Entry time uri title) = object ["time" .= time, "uri" .= WrappedURI uri, "title" .= title] data HistoryException = InvalidSelection deriving(Eq)
Hbro/StatusBar.hs view
@@ -33,8 +33,8 @@ gAsync $ labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = gray}] mainView <- ask- addHandler (mainView^.scrolledHandlerL) . const $ do- adjustment <- getAdjustment Vertical $ mainView^.scrollWindowL+ addHandler (mainView^.scrolledHandler_) . const $ do+ adjustment <- getAdjustment Vertical $ mainView^.scrollWindow_ current <- get adjustment adjustmentValue lower <- get adjustment adjustmentLower upper <- get adjustment adjustmentUpper@@ -53,7 +53,7 @@ gAsync $ labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 65535 65535 65535}] mainView <- ask getWebView >>= \w -> get w webViewZoomLevel >>= updateZoomLabel- void $ addHandler (mainView^.zoomLevelChangedHandlerL) updateZoomLabel+ void $ addHandler (mainView^.zoomLevelChangedHandler_) updateZoomLabel where updateZoomLabel = gAsync . labelSetMarkup widget . escapeMarkup . show @@ -64,7 +64,7 @@ (keySignal :: Signal KeyMapPressed) <- ask void . addHandler keySignal $ \(strokes, isBound) -> gAsync $ do labelSetText widget . unwords $ map describe strokes- labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = green <| isBound |> red}]+ labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = if isBound then green else red}] -- | Write current load progress in the given 'Label'.@@ -72,19 +72,19 @@ installProgressWidget widget = do mainView <- ask -- Load started- addHandler (mainView^.loadStartedHandlerL) $ \_ -> gAsync $ do+ addHandler (mainView^.loadStartedHandler_) $ \_ -> gAsync $ do labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = red}] labelSetText widget (asText "0%") -- Progress changed- addHandler (mainView^.progressChangedHandlerL) $ \progress -> gAsync $ do+ addHandler (mainView^.progressChangedHandler_) $ \progress -> gAsync $ do labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = yellow}] labelSetText widget $ tshow progress ++ "%" -- Load finished- addHandler (mainView^.loadFinishedHandlerL) $ \_ -> gAsync $ do+ addHandler (mainView^.loadFinishedHandler_) $ \_ -> gAsync $ do labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = green}] labelSetText widget (asText "100%") -- Error- addHandler (mainView^.loadFailedHandlerL) $ \(_uri, _e) -> gAsync $ do+ addHandler (mainView^.loadFailedHandler_) $ \(_uri, _e) -> gAsync $ do labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = red}] labelSetText widget $ asText "100%" @@ -97,12 +97,12 @@ installURIWidget normalColors secureColors widget = do mainView <- ask -- URI changed- addHandler (mainView^.uriChangedHandlerL) $ labelSetURI normalColors secureColors widget+ addHandler (mainView^.uriChangedHandler_) $ labelSetURI normalColors secureColors widget -- Link hovered- addHandler (mainView^.linkHoveredHandlerL) $ \(uri, _title) ->+ addHandler (mainView^.linkHoveredHandler_) $ \(uri, _title) -> labelSetURI normalColors secureColors widget uri -- Link unhovered- addHandler (mainView^.linkUnhoveredHandlerL) $ \_ -> void . logErrors $+ addHandler (mainView^.linkUnhoveredHandler_) $ \_ -> void . logErrors $ labelSetURI normalColors secureColors widget =<< getCurrentURI return ()
hbro-contrib.cabal view
@@ -1,5 +1,5 @@ Name: hbro-contrib-Version: 1.4.0.0+Version: 1.5.0.0 Synopsis: Third-party extensions to hbro. Description: Cf README Homepage: https://github.com/k0ral/hbro-contrib@@ -31,7 +31,7 @@ directory, glib, gtk3 >= 0.12.3,- hbro >= 1.4,+ hbro >= 1.5, lens, monad-control, mtl,@@ -58,4 +58,4 @@ Hbro.Misc Hbro.Settings Hbro.StatusBar- Ghc-options: -Wall -fno-warn-unused-do-bind -threaded+ Ghc-options: -Wall -fno-warn-unused-do-bind