different parser for duckduckgo's bang format, and our own

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