aboutsummaryrefslogtreecommitdiff
path: root/src/Bangs.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Bangs.hs')
-rw-r--r--src/Bangs.hs30
1 files changed, 25 insertions, 5 deletions
diff --git a/src/Bangs.hs b/src/Bangs.hs
index 017d03b..274e96b 100644
--- a/src/Bangs.hs
+++ b/src/Bangs.hs
@@ -1,7 +1,13 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, DeriveGeneric, GeneralizedNewtypeDeriving #-}
-module Bangs (Bangs) where
+module Bangs (
+ DDGBangs,
+ toBangs,
+ Bangs
+) where
+import GHC.Prim
+import GHC.Generics (Generic)
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Text (Text)
@@ -10,10 +16,24 @@ import qualified Data.Map.Strict as M
-- The map stored is equivalent to `HM.HashMap Shortcut URL`.
-- For now, we're omitting category information as I don't want to force our
-- own custom bangs to need that info.
-data Bangs = Bangs (M.Map Text Text) deriving (Show)
-instance FromJSON Bangs where
- parseJSON b = fmap (Bangs . M.fromList) $
+newtype Bangs = Bangs {
+ unBangs :: M.Map Text Text
+} deriving (Show, Generic, FromJSON, ToJSON)
+
+newtype DDGBangs = DDGBangs (M.Map Text Text) deriving (Show)
+toBangs :: DDGBangs -> Bangs
+toBangs = coerce
+
+instance FromJSON DDGBangs where
+ parseJSON b = fmap (DDGBangs . M.fromList) $
(parseJSON b :: Parser [Value])
>>= mapM (withObject "Bang" $ \ob ->
(,) <$> ob .: "t" <*> ob .: "u")
+-- left-biased union
+instance Semigroup Bangs where
+ Bangs a <> Bangs b = Bangs $ a `M.union` b
+
+instance Monoid Bangs where
+ mempty = Bangs M.empty
+ mconcat = Bangs . M.unions . map unBangs