{-# LANGUAGE DeriveGeneric #-}
module Vgrep.Environment.Config.Monoid
  ( ConfigMonoid (..)
  , ColorsMonoid (..)
  , KeybindingsMonoid (..)
  ) where

import Data.Monoid
import Generics.Deriving.Monoid (mappenddefault, memptydefault)
import GHC.Generics
import Graphics.Vty.Attributes  (Attr)

import Vgrep.KeybindingMap (KeybindingMap (..))

-- $setup
-- >>> import Data.Map.Strict
-- >>> import Vgrep.Command
-- >>> import qualified Vgrep.Key as Key

-- | A 'Monoid' for reading partial configs. The 'ConfigMonoid' can be converted
-- to an actual 'Vgrep.Environment.Config.Config' using
-- 'Vgrep.Environment.Config.fromConfigMonoid'.
--
-- The Monoid consists mostly of 'First a' values, so the most important config
-- (the one that overrides all the others) should be read first.
data ConfigMonoid = ConfigMonoid
    { ConfigMonoid -> ColorsMonoid
_mcolors      :: ColorsMonoid
    , ConfigMonoid -> First Int
_mtabstop     :: First Int
    , ConfigMonoid -> First String
_meditor      :: First String
    , ConfigMonoid -> KeybindingsMonoid
_mkeybindings :: KeybindingsMonoid
    } deriving (ConfigMonoid -> ConfigMonoid -> Bool
(ConfigMonoid -> ConfigMonoid -> Bool)
-> (ConfigMonoid -> ConfigMonoid -> Bool) -> Eq ConfigMonoid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigMonoid -> ConfigMonoid -> Bool
$c/= :: ConfigMonoid -> ConfigMonoid -> Bool
== :: ConfigMonoid -> ConfigMonoid -> Bool
$c== :: ConfigMonoid -> ConfigMonoid -> Bool
Eq, Int -> ConfigMonoid -> ShowS
[ConfigMonoid] -> ShowS
ConfigMonoid -> String
(Int -> ConfigMonoid -> ShowS)
-> (ConfigMonoid -> String)
-> ([ConfigMonoid] -> ShowS)
-> Show ConfigMonoid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigMonoid] -> ShowS
$cshowList :: [ConfigMonoid] -> ShowS
show :: ConfigMonoid -> String
$cshow :: ConfigMonoid -> String
showsPrec :: Int -> ConfigMonoid -> ShowS
$cshowsPrec :: Int -> ConfigMonoid -> ShowS
Show, (forall x. ConfigMonoid -> Rep ConfigMonoid x)
-> (forall x. Rep ConfigMonoid x -> ConfigMonoid)
-> Generic ConfigMonoid
forall x. Rep ConfigMonoid x -> ConfigMonoid
forall x. ConfigMonoid -> Rep ConfigMonoid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigMonoid x -> ConfigMonoid
$cfrom :: forall x. ConfigMonoid -> Rep ConfigMonoid x
Generic)

instance Semigroup ConfigMonoid where
    <> :: ConfigMonoid -> ConfigMonoid -> ConfigMonoid
(<>) = ConfigMonoid -> ConfigMonoid -> ConfigMonoid
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault

instance Monoid ConfigMonoid where
    mempty :: ConfigMonoid
mempty  = ConfigMonoid
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault


-- | A 'Monoid' for reading partial 'Vgrep.Environment.Config.Colors'
-- configurations.
--
-- Note that the attributes are not merged, but overridden:
--
-- >>> import Graphics.Vty.Attributes
-- >>> let leftStyle  = defAttr `withStyle` standout
-- >>> let rightStyle = defAttr `withForeColor` black
-- >>> let l = mempty { _mnormal = First (Just leftStyle)}
-- >>> let r = mempty { _mnormal = First (Just rightStyle)}
-- >>> _mnormal (l <> r) == First (Just (leftStyle <> rightStyle))
-- False
-- >>> _mnormal (l <> r) == First (Just leftStyle)
-- True
data ColorsMonoid = ColorsMonoid
    { ColorsMonoid -> First Attr
_mlineNumbers   :: First Attr
    , ColorsMonoid -> First Attr
_mlineNumbersHl :: First Attr
    , ColorsMonoid -> First Attr
_mnormal        :: First Attr
    , ColorsMonoid -> First Attr
_mnormalHl      :: First Attr
    , ColorsMonoid -> First Attr
_mfileHeaders   :: First Attr
    , ColorsMonoid -> First Attr
_mselected      :: First Attr
    } deriving (ColorsMonoid -> ColorsMonoid -> Bool
(ColorsMonoid -> ColorsMonoid -> Bool)
-> (ColorsMonoid -> ColorsMonoid -> Bool) -> Eq ColorsMonoid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorsMonoid -> ColorsMonoid -> Bool
$c/= :: ColorsMonoid -> ColorsMonoid -> Bool
== :: ColorsMonoid -> ColorsMonoid -> Bool
$c== :: ColorsMonoid -> ColorsMonoid -> Bool
Eq, Int -> ColorsMonoid -> ShowS
[ColorsMonoid] -> ShowS
ColorsMonoid -> String
(Int -> ColorsMonoid -> ShowS)
-> (ColorsMonoid -> String)
-> ([ColorsMonoid] -> ShowS)
-> Show ColorsMonoid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorsMonoid] -> ShowS
$cshowList :: [ColorsMonoid] -> ShowS
show :: ColorsMonoid -> String
$cshow :: ColorsMonoid -> String
showsPrec :: Int -> ColorsMonoid -> ShowS
$cshowsPrec :: Int -> ColorsMonoid -> ShowS
Show, (forall x. ColorsMonoid -> Rep ColorsMonoid x)
-> (forall x. Rep ColorsMonoid x -> ColorsMonoid)
-> Generic ColorsMonoid
forall x. Rep ColorsMonoid x -> ColorsMonoid
forall x. ColorsMonoid -> Rep ColorsMonoid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColorsMonoid x -> ColorsMonoid
$cfrom :: forall x. ColorsMonoid -> Rep ColorsMonoid x
Generic)

instance Semigroup ColorsMonoid where
    <> :: ColorsMonoid -> ColorsMonoid -> ColorsMonoid
(<>) = ColorsMonoid -> ColorsMonoid -> ColorsMonoid
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault

instance Monoid ColorsMonoid where
    mempty :: ColorsMonoid
mempty = ColorsMonoid
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault


-- | A 'Monoid' for reading a partial 'Vgrep.Environment.Config.Keybindings'
-- configuration.
--
-- Mappings are combined using left-biased 'Data.Map.Strict.union':
--
-- >>> let l = Just (KeybindingMap (fromList [(Key.Chord mempty Key.Down, ResultsDown), (Key.Chord mempty Key.Up, ResultsUp)]))
-- >>> let r = Just (KeybindingMap (fromList [(Key.Chord mempty Key.Down, PagerDown)]))
-- >>> l <> r
-- Just (KeybindingMap {unKeybindingMap = fromList [(Chord (fromList []) Up,ResultsUp),(Chord (fromList []) Down,ResultsDown)]})
-- >>> r <> l
-- Just (KeybindingMap {unKeybindingMap = fromList [(Chord (fromList []) Up,ResultsUp),(Chord (fromList []) Down,PagerDown)]})
--
-- In particular, @'Just' ('Data.Map.Strict.fromList' [])@ (declaring an empty
-- list of mappings) and @'Nothing'@ (not declaring anything) are equivalent,
-- given that there are already default mappings:
--
-- >>> l <> Just (KeybindingMap (fromList [])) == l <> Nothing
-- True
--
-- This means that new keybindings override the previous ones if they collide,
-- otherwise they are simply added. To remove a keybinding, it has to be mapped
-- to 'Unset' explicitly.
data KeybindingsMonoid = KeybindingsMonoid
    { KeybindingsMonoid -> Maybe KeybindingMap
_mresultsKeybindings :: Maybe KeybindingMap
    , KeybindingsMonoid -> Maybe KeybindingMap
_mpagerKeybindings   :: Maybe KeybindingMap
    , KeybindingsMonoid -> Maybe KeybindingMap
_mglobalKeybindings  :: Maybe KeybindingMap
    } deriving (KeybindingsMonoid -> KeybindingsMonoid -> Bool
(KeybindingsMonoid -> KeybindingsMonoid -> Bool)
-> (KeybindingsMonoid -> KeybindingsMonoid -> Bool)
-> Eq KeybindingsMonoid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeybindingsMonoid -> KeybindingsMonoid -> Bool
$c/= :: KeybindingsMonoid -> KeybindingsMonoid -> Bool
== :: KeybindingsMonoid -> KeybindingsMonoid -> Bool
$c== :: KeybindingsMonoid -> KeybindingsMonoid -> Bool
Eq, Int -> KeybindingsMonoid -> ShowS
[KeybindingsMonoid] -> ShowS
KeybindingsMonoid -> String
(Int -> KeybindingsMonoid -> ShowS)
-> (KeybindingsMonoid -> String)
-> ([KeybindingsMonoid] -> ShowS)
-> Show KeybindingsMonoid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeybindingsMonoid] -> ShowS
$cshowList :: [KeybindingsMonoid] -> ShowS
show :: KeybindingsMonoid -> String
$cshow :: KeybindingsMonoid -> String
showsPrec :: Int -> KeybindingsMonoid -> ShowS
$cshowsPrec :: Int -> KeybindingsMonoid -> ShowS
Show, (forall x. KeybindingsMonoid -> Rep KeybindingsMonoid x)
-> (forall x. Rep KeybindingsMonoid x -> KeybindingsMonoid)
-> Generic KeybindingsMonoid
forall x. Rep KeybindingsMonoid x -> KeybindingsMonoid
forall x. KeybindingsMonoid -> Rep KeybindingsMonoid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeybindingsMonoid x -> KeybindingsMonoid
$cfrom :: forall x. KeybindingsMonoid -> Rep KeybindingsMonoid x
Generic)

instance Semigroup KeybindingsMonoid where
    <> :: KeybindingsMonoid -> KeybindingsMonoid -> KeybindingsMonoid
(<>) = KeybindingsMonoid -> KeybindingsMonoid -> KeybindingsMonoid
forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault

instance Monoid KeybindingsMonoid where
    mempty :: KeybindingsMonoid
mempty = KeybindingsMonoid
forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault