module Hbro.Config where
import qualified Hbro.Keys as Key
import Hbro.IPC
import Hbro.Util
import Control.Lens hiding(set)
import Control.Monad.Base
import Control.Monad.Error hiding(forM_, mapM_)
import Data.List
import Data.Map (Map)
import qualified Data.Map as M
import Graphics.UI.Gtk.Gdk.EventM
import Graphics.UI.Gtk.WebKit.WebNavigationAction
import Network.URI as N hiding(parseURI, parseURIReference)
import Prelude hiding(mapM_)
data ResourceAction = Load | Download
data Verbosity = Quiet | Normal | Verbose deriving(Eq, Show)
data Config m = Config {
_homePage :: URI,
_verbosity :: Verbosity,
_keyBindings :: Map Key.Mode (Key.Bindings m),
_onDownload :: URI -> String -> Int -> m (),
_onKeyStroke :: [Key.Stroke] -> m (),
_onLinkClicked :: MouseButton -> URI -> m (),
_onLoadRequested :: URI -> m (),
_onLoadFinished :: m (),
_onNewWindow :: URI -> m (),
_onResourceOpened :: URI -> String -> m ResourceAction,
_onTitleChanged :: String -> m (),
_commands :: CommandsMap m
}
makeLenses ''Config
instance Show (Config m) where
show c = "Home page = " ++ (show $ c^.homePage)
++ "\nVerbosity = " ++ (show $ c^.verbosity)
class (Monad m) => ConfigReader n m | m -> n where
readConfig :: Simple Lens (Config n) a -> m a
instance ConfigReader n ((->) (Config n)) where
readConfig l = view l
class (Monad m) => ConfigWriter n m | m -> n where
writeConfig :: Simple Lens (Config n) a -> a -> m ()
type ConfigState n m = (ConfigReader n m, ConfigWriter n m)
modifyConfig :: (ConfigState n m) => Simple Lens (Config n) a -> (a -> a) -> m ()
modifyConfig l f = writeConfig l . f =<< readConfig l
instance Eq NavigationReason where
a == b = (fromEnum a) == (fromEnum b)
instance Show NavigationReason where
show WebNavigationReasonLinkClicked = "Link clicked"
show WebNavigationReasonFormSubmitted = "Form submitted"
show WebNavigationReasonBackForward = "Back/forward"
show WebNavigationReasonReload = "Reload"
show WebNavigationReasonFormResubmitted = "Form resubmitted"
show WebNavigationReasonOther = "Other"
unlessQuiet :: (MonadBase IO m, ConfigReader n m) => m () -> m ()
unlessQuiet f = do
quiet' <- readConfig verbosity
case quiet' of
Quiet -> return ()
_ -> f
whenLoud :: (MonadBase IO m, ConfigReader n m) => m () -> m ()
whenLoud f = do
verbose' <- readConfig verbosity
case verbose' of
Verbose -> f
_ -> return ()
log, logV :: (MonadBase IO m, ConfigReader n m) => String -> m ()
log = unlessQuiet . io . putStrLn
logV = whenLoud . io . putStrLn
bind :: (MonadBase IO m, ConfigState m m) => Key.Mode -> String -> m () -> m ()
bind mode strokes action = case newBindings of
Just b -> do
oldValue <- readConfig keyBindings
let newValue = M.insertWith Key.merge mode b oldValue
void $ writeConfig keyBindings newValue
return ()
_ -> return ()
where
newBindings = Key.mkBinding strokes action