packages feed

hbro-contrib 1.3.0.0 → 1.4.0.0

raw patch · 8 files changed

+73/−64 lines, 8 filesdep +directorydep −system-fileiodep ~hbro

Dependencies added: directory

Dependencies removed: system-fileio

Dependency ranges changed: hbro

Files

Data/Aeson/Extended.hs view
@@ -4,12 +4,16 @@  import           ClassyPrelude -import           Control.Monad.Except- import           Data.Aeson               as X import           Data.Aeson.Encode.Pretty as X import qualified Data.ByteString.Lazy     as Lazy  -decodeM :: (FromJSON a, MonadError Text m) => Lazy.ByteString -> m a-decodeM = either (throwError . pack) return . eitherDecode+data JsonException = UnableDecode String deriving(Eq)++instance Exception JsonException+instance Show JsonException where+  show (UnableDecode s) = s++decodeM :: (FromJSON a, MonadThrow m) => Lazy.ByteString -> m a+decodeM = either (throwM . UnableDecode) return . eitherDecode
Hbro/Bookmarks.hs view
@@ -28,11 +28,11 @@ -- import Data.Random.RVar -- import Data.Random.Source.DevRandom -import           Filesystem           hiding (readFile, writeFile)- import           Network.URI.Extended  import           Safe++import           System.Directory -- }}}  -- {{{ Type definitions@@ -57,53 +57,53 @@  -- | Return bookmarks file getBookmarksFile :: (BaseIO m) => m FilePath-getBookmarksFile = getAppDataDirectory "hbro" >/> "bookmarks"+getBookmarksFile = getAppUserDataDirectory "hbro" >/> "bookmarks"  -- | Check if the given bookmark 'Entry' is tagged with the given tag. hasTag :: Text -> Entry -> Bool hasTag tag = member tag . _tags  -- | Add current webpage to bookmarks with given tags-addCurrent :: (ControlIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadError Text m, Alternative m) => [Text] -> m ()+addCurrent :: (ControlIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadThrow m, Alternative m) => [Text] -> m () addCurrent tags = (`addCurrent'` tags) =<< getBookmarksFile  -- | Like 'add', but you can specify the bookmarks file path-addCurrent' :: (ControlIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadError Text m, Alternative m) => FilePath -> [Text] -> m ()+addCurrent' :: (ControlIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadThrow m, Alternative m) => FilePath -> [Text] -> m () addCurrent' file tags = do     uri <- getCurrentURI     void . add file $ Entry uri (Set.fromList tags)  -- | Add a custom entry to bookmarks-add :: (ControlIO m, MonadLogger m, MonadError Text m, Alternative m)+add :: (ControlIO m, MonadLogger m, MonadThrow m, Alternative m)     => FilePath      -- ^ Bookmarks file     -> Entry         -- ^ Custom bookmark entry     -> m () add file newEntry = do   info $ "New bookmark: " ++ describe newEntry   tryIO . io . copyFile file $ file <.> "bak"-  entries <- (decodeM =<< readFileE file) <|> return Set.empty-  writeFileE file . encodePretty $ Set.insert newEntry entries+  entries <- (decodeM =<< readFile file) <|> return Set.empty+  writeFile file . encodePretty $ Set.insert newEntry entries  -- | Open a dmenu with all (sorted alphabetically) bookmarks entries, and return the user's selection, if any.-select :: (ControlIO m, MonadError Text m) => m URI+select :: (ControlIO m, MonadThrow m) => m URI select = (`select'` defaultDmenuOptions) =<< getBookmarksFile  -- | Like 'select', but you can specify the bookmarks file path-select' :: (ControlIO m, MonadError Text m) => FilePath -> [Text] -> m URI-select' file dmenuOptions = parseURIReferenceM . lastDef "" . words =<< dmenu dmenuOptions . unlines . sort . map (describe :: Entry -> Text) . Set.toList =<< decodeM =<< readFileE file+select' :: (ControlIO m, MonadThrow m) => FilePath -> [Text] -> m URI+select' file dmenuOptions = parseURIReference . lastDef "" . words =<< dmenu dmenuOptions . unlines . sort . map (describe :: Entry -> Text) . Set.toList =<< decodeM =<< readFile file  -- | Open a dmenu with all (sorted alphabetically) bookmarks tags, and return the user's selection, if any.-selectByTag :: (ControlIO m, MonadLogger m, MonadError Text m) => m [URI]+selectByTag :: (ControlIO m, MonadLogger m, MonadThrow m) => m [URI] selectByTag = (`selectByTag'` defaultDmenuOptions) =<< getBookmarksFile  -- | Like 'selectByTag', but you can specify the bookmarks file path-selectByTag' :: (ControlIO m, MonadLogger m, MonadError Text m)+selectByTag' :: (ControlIO m, MonadLogger m, MonadThrow m)           => FilePath          -- ^ Bookmarks' database file           -> [Text]            -- ^ dmenu's commandline options           -> m [URI] selectByTag' file dmenuOptions = do -- Read bookmarks file-    entries <- decodeM =<< readFileE file+    entries <- decodeM =<< readFile file     let tags = unlines . Set.toList . foldl' Set.union Set.empty $ map _tags entries  -- Let user select a tag@@ -135,19 +135,19 @@   -- | Remove all bookmarks entries matching the given tag.-deleteByTag :: (ControlIO m, MonadLogger m, MonadError Text m) => m ()+deleteByTag :: (ControlIO m, MonadLogger m, MonadThrow m) => m () deleteByTag = (`deleteByTag'` defaultDmenuOptions) =<< getBookmarksFile  -- | Like 'selectByTag', but you can specify the bookmarks file path-deleteByTag' :: (ControlIO m, MonadLogger m, MonadError Text m)+deleteByTag' :: (ControlIO m, MonadLogger m, MonadThrow m)               => FilePath          -- ^ Bookmarks' database file               -> [Text]            -- ^ dmenu's commandline options               -> m () deleteByTag' file dmenuOptions = do-    entries <- decodeM =<< readFileE file+    entries <- decodeM =<< readFile file     let tags = unlines . Set.toList . foldl' Set.union Set.empty . map _tags $ Set.toList entries      tag <- dmenu dmenuOptions tags     info $ "Deleting bookmarks with tag " ++ tag     tryIO . io . copyFile file $ file <.> "bak"-    writeFileE file . encodePretty $ Set.filter (not . hasTag tag) entries+    writeFile file . encodePretty $ Set.filter (not . hasTag tag) entries
Hbro/Download.hs view
@@ -19,16 +19,16 @@                  -> URI      -- ^ URI to download                  -> Text     -- ^ Destination file name                  -> m ()-aria (fpToText -> destination) (tshow -> uri) outputFile+aria (pack -> destination) (tshow -> uri) outputFile   = downloadWith "aria2c" [uri, "-d", destination, "-o", outputFile, "-q"] outputFile  wget destination (tshow -> uri) outputFile   = downloadWith "wget" [uri, "-O", dest] outputFile-    where dest = fpToText (destination </> fpFromText outputFile)+    where dest = pack (destination </> unpack outputFile)  axel destination (tshow -> uri) outputFile   = downloadWith "axel" [uri, "-o", dest] outputFile-    where dest = fpToText (destination </> fpFromText outputFile)+    where dest = pack (destination </> unpack outputFile)  downloadWith :: (ControlIO m) => Text -> [Text] -> Text -> m () downloadWith (unpack -> program) (map unpack -> args) (unpack -> outputFile) = handleIO (io . print) . io $ do
Hbro/History.hs view
@@ -7,6 +7,7 @@ -- | Designed to be imported as @qualified@. module Hbro.History     ( Entry(..)+    , HistoryException(..)     , log     , log'     , add@@ -24,9 +25,9 @@ import qualified Data.Set            as Set import           Data.Time -import           Filesystem          (copyFile, getAppDataDirectory)- import           Network.URI++import           System.Directory -- }}}  -- {{{ Type definitions@@ -52,20 +53,25 @@ instance ToJSON Entry where     toJSON (Entry time uri title) = object ["time" .= time, "uri" .= uri, "title" .= title] +data HistoryException = InvalidSelection deriving(Eq)++instance Exception HistoryException+instance Show HistoryException where+  show InvalidSelection = "Invalid history item selected." -- }}}  dateFormat :: String dateFormat = "%F %T"  getHistoryFile :: (BaseIO m) => m FilePath-getHistoryFile = getAppDataDirectory "hbro" >/> "history"+getHistoryFile = getAppUserDataDirectory "hbro" >/> "history"  -- | Log current visited page to history database-log :: (ControlIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadError Text m, Alternative m) => m ()+log :: (ControlIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadThrow m, Alternative m) => m () log = log' =<< getHistoryFile  -- | Like 'log', but you can specify the history file path-log' :: (ControlIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadError Text m, Alternative m) => FilePath -> m ()+log' :: (ControlIO m, MonadLogger m, MonadReader r m, Has MainView r, MonadThrow m, Alternative m) => FilePath -> m () log' file = do     uri      <- getCurrentURI     title    <- getPageTitle@@ -74,25 +80,25 @@     add' file (Entry now uri title)  -- | Add a new entry to history database-add :: (ControlIO m, MonadLogger m, MonadError Text m, Alternative m) => Entry -> m ()+add :: (ControlIO m, MonadLogger m, MonadThrow m, Alternative m) => Entry -> m () add newEntry = (`add'` newEntry) =<< getHistoryFile  -- | Like 'add', but you can specify the history file path-add' :: (ControlIO m, MonadLogger m, MonadError Text m, Alternative m) => FilePath -> Entry -> m ()+add' :: (ControlIO m, MonadLogger m, MonadThrow m, Alternative m) => FilePath -> Entry -> m () add' file newEntry = do-    debug $ "Adding new entry <" ++ tshow (_uri newEntry) ++ "> to history file <" ++ fpToText file ++ ">"+    debug $ "Adding new entry <" ++ tshow (_uri newEntry) ++ "> to history file <" ++ pack file ++ ">"     tryIO . io . copyFile file $ file <.> "bak"-    entries <- (decodeM =<< readFileE file) <|> return Set.empty+    entries <- (decodeM =<< readFile file) <|> return Set.empty -    writeFileE file . encodePretty $ Set.insert newEntry entries+    writeFile file . encodePretty $ Set.insert newEntry entries  -- | Open a dmenu with all (sorted alphabetically) history entries, and return the user's selection, if any-select :: (ControlIO m, MonadError Text m) => m Entry+select :: (ControlIO m, MonadThrow m) => m Entry select = (`select'` defaultDmenuOptions) =<< getHistoryFile  -- | Like 'select', but you can specify the history file path-select' :: (ControlIO m, MonadError Text m) => FilePath -> [Text] -> m Entry+select' :: (ControlIO m, MonadThrow m) => FilePath -> [Text] -> m Entry select' file dmenuOptions = do-  entries <- zip [1..] . sortBy (flip (comparing _time)) <$> (decodeM =<< readFileE file)+  entries <- zip [1..] . sortBy (flip (comparing _time)) <$> (decodeM =<< readFile file)   result  <- dmenu dmenuOptions . unlines $ map (\(i :: Int, e :: Entry) -> tshow i ++ " " ++ describe e) entries-  maybe (throwError "Invalid history item selected") return ((`lookup` entries) =<< readMay =<< headMay (words result))+  maybe (throwM InvalidSelection) return ((`lookup` entries) =<< readMay =<< headMay (words result))
Hbro/Misc.hs view
@@ -21,11 +21,11 @@  -- | Open dmenu with given input and return selected entry. -- This will block effectively the current thread.-dmenu :: (ControlIO m, MonadError Text m)+dmenu :: (ControlIO m, MonadThrow m)       => [Text]    -- ^ dmenu's commandline options       -> Text      -- ^ dmenu's input       -> m Text    -- ^ Selected entry-dmenu options input = handleIO (\_ -> throwError "Dmenu canceled.") $ do+dmenu options input = do     (in_, out, err, pid) <- io $ runInteractiveProcess "dmenu" (map unpack options) Nothing Nothing     hPut in_ input     io $ hClose in_@@ -40,25 +40,25 @@   -- | List preceding URIs in dmenu and let the user select which one to load.-goBackList :: (ControlIO m, MonadReader r m, Has MainView r, MonadError Text m) => m URI+goBackList :: (ControlIO m, MonadReader r m, Has MainView r, MonadThrow m) => m URI goBackList = do     list           <- io . webViewGetBackForwardList =<< getWebView     n              <- io $ webBackForwardListGetBackLength list     backList       <- io $ webBackForwardListGetBackListWithLimit list n     dmenuList      <- io $ mapM itemToEntry backList -    parseURIReferenceM . headDef "" . words =<< (dmenu defaultDmenuOptions . unlines . catMaybes) dmenuList+    parseURIReference . headDef "" . words =<< (dmenu defaultDmenuOptions . unlines . catMaybes) dmenuList   -- | List succeeding URIs in dmenu and let the user select which one to load.-goForwardList :: (ControlIO m, MonadReader r m, Has MainView r, MonadError Text m) => m URI+goForwardList :: (ControlIO m, MonadReader r m, Has MainView r, MonadThrow m) => m URI goForwardList = do     list        <- io . webViewGetBackForwardList =<< getWebView     n           <- io $ webBackForwardListGetForwardLength list     forwardList <- io $ webBackForwardListGetForwardListWithLimit list n     dmenuList   <- io $ mapM itemToEntry forwardList -    parseURIReferenceM . headDef "" . words =<< (dmenu defaultDmenuOptions . unlines . catMaybes) dmenuList+    parseURIReference . headDef "" . words =<< (dmenu defaultDmenuOptions . unlines . catMaybes) dmenuList   itemToEntry :: WebHistoryItem -> IO (Maybe Text)
Hbro/StatusBar.hs view
@@ -92,7 +92,7 @@   -- | Write current URI, or the destination of a hovered link, in the given Label.-installURIWidget :: (ControlIO m, MonadResource m, MonadReader r m, Has MainView r, MonadLogger m)+installURIWidget :: (ControlIO m, MonadResource m, MonadReader r m, Has MainView r, MonadLogger m, MonadCatch m)                  => URIColors -> URIColors -> Label -> m () installURIWidget normalColors secureColors widget = do     mainView <- ask@@ -102,7 +102,7 @@     addHandler (mainView^.linkHoveredHandlerL) $ \(uri, _title) ->         labelSetURI normalColors secureColors widget uri -- Link unhovered-    addHandler (mainView^.linkUnhoveredHandlerL) $ \_ -> void . runExceptT . logErrors $+    addHandler (mainView^.linkUnhoveredHandlerL) $ \_ -> void . logErrors $         labelSetURI normalColors secureColors widget =<< getCurrentURI      return ()
examples/hbro.hs view
@@ -27,13 +27,12 @@ import qualified Data.Map                           as Map import qualified Data.Set                           as Set -import           Filesystem- import           Graphics.UI.Gtk.WebKit.WebSettings  import qualified Network.URI                        as N import           Network.URI.Extended +import           System.Directory import           System.Glib.Attributes.Extended import           System.Process.Extended -- }}}@@ -47,16 +46,16 @@     destination <- io getHomeDirectory     Download.aria destination uri filename -myLoadFinishedHandler :: (ControlIO m, MonadReader r m, Has MainView r, MonadLogger m, MonadError Text m, Alternative m) => m ()+myLoadFinishedHandler :: (ControlIO m, MonadReader r m, Has MainView r, MonadLogger m, MonadThrow m, Alternative m) => m () myLoadFinishedHandler = History.log  -- Those key bindings are suited for an azerty keyboard-myKeyMap :: (God r m) => KeyMap m+myKeyMap :: (God r m, MonadCatch m) => KeyMap m myKeyMap = defaultKeyMap <> Map.fromList   -- Browse     [ [_Control .| _Left]  >:  goBackList    >>= load     , [_Control .| _Right] >:  goForwardList >>= load-    , [_Control .| _g]     >:  promptM "DuckDuckGo search" "" >>= parseURIReferenceM . ("http://duckduckgo.com/html?q=" ++) . pack . escapeURIString isAllowedInURI . unpack >>= load+    , [_Control .| _g]     >:  promptM "DuckDuckGo search" "" >>= parseURIReference . ("http://duckduckgo.com/html?q=" ++) . pack . escapeURIString isAllowedInURI . unpack >>= load -- Bookmarks     , [_Control .| _d]     >:  promptM "Bookmark with tags:" "" >>= Bookmarks.addCurrent . words     -- , [_Control .| _D]     >:  promptM "Bookmark all instances with tag:" "" >>= \tags -> do@@ -75,7 +74,7 @@   -- Setup run at start-up-myStartUp :: (God r m) => m ()+myStartUp :: (God r m, MonadCatch m) => m () myStartUp = do     Config.set homePageL myHomePage
hbro-contrib.cabal view
@@ -1,8 +1,8 @@ Name:                hbro-contrib-Version:             1.3.0.0+Version:             1.4.0.0 Synopsis:            Third-party extensions to hbro. Description:         Cf README-Homepage:            https://bitbucket.org/k0ral/hbro-contrib+Homepage:            https://github.com/k0ral/hbro-contrib Category:            Browser,Web  License:             OtherLicense@@ -28,9 +28,10 @@         bytestring,         classy-prelude >= 0.9.4,         containers,+        directory,         glib,         gtk3 >= 0.12.3,-        hbro >= 1.3.0.0,+        hbro >= 1.4,         lens,         monad-control,         mtl,@@ -42,7 +43,6 @@         -- random-fu,         resourcet,         safe,-        system-fileio,         -- taggy-lens,         text,         time,@@ -50,12 +50,12 @@         unix,         webkitgtk3     Exposed-modules:-        Data.Aeson.Extended,-        Hbro.Bookmarks,-        Hbro.Download,-        -- Hbro.Feed,-        Hbro.History,-        Hbro.Misc,-        Hbro.Settings,+        Data.Aeson.Extended+        Hbro.Bookmarks+        Hbro.Download+        -- Hbro.Feed+        Hbro.History+        Hbro.Misc+        Hbro.Settings         Hbro.StatusBar     Ghc-options: -Wall -fno-warn-unused-do-bind -threaded