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

4 files changed, 35 insertions, 16 deletions

diff --git a/bangs-ddgless.cabal b/bangs-ddgless.cabal
index 456f23d..38ff3d1 100644
--- a/bangs-ddgless.cabal
+++ b/bangs-ddgless.cabal
@@ -7,16 +7,12 @@ cabal-version: 1.12
 name:           bangs-ddgless
 version:        0.1.0.0
 category:       Web
-homepage:       https://github.com/githubuser/bangs-ddgless#readme
-author:         Author name here
-maintainer:     example@example.com
-copyright:      2023 Author name here
-license:        BSD3
-license-file:   LICENSE
+homepage:       https://codeberg.org/lialenck/bangs-ddgless
+author:         Lia Lenckowski
+maintainer:     lialenck@protonmail.com
+copyright:      2023 Lia Lenckowski
+license:        AGPL
 build-type:     Simple
-extra-source-files:
-    README.md
-    CHANGELOG.md
 
 executable bangs-ddgless
   main-is: Main.hs
@@ -31,6 +27,7 @@ executable bangs-ddgless
     , base >=4.7 && <5
     , bytestring
     , containers
+    , ghc-prim
     , http-conduit
     , text
     , time
diff --git a/package.yaml b/package.yaml
index 0c3b4eb..1cf2c86 100644
--- a/package.yaml
+++ b/package.yaml
@@ -19,6 +19,7 @@ dependencies:
 - http-conduit
 - containers
 - text
+- ghc-prim
 
 ghc-options:
 - -Wall
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
diff --git a/src/Main.hs b/src/Main.hs
index 997bbf5..1517ebd 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,10 +2,11 @@
 
 module Main (main) where
 
-import Yesod
+import Data.Aeson
 import Data.ByteString (ByteString)
 import Data.IORef
 import Network.HTTP.Simple
+import Yesod
 
 import Bangs
 
@@ -17,5 +18,5 @@ data Search = Search {
 
 main :: IO ()
 main = do
-    ans <- (httpJSON "https://duckduckgo.com/bang.v255.js") :: IO (Response Bangs)
+    ans <- (httpJSON "https://duckduckgo.com/bang.v255.js") :: IO (Response DDGBangs)
     print ans