blob: 274e96bb0c56bd0661ea2084e658b97c8d5da857 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
{-# LANGUAGE OverloadedStrings, DeriveGeneric, GeneralizedNewtypeDeriving #-}
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)
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.
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
|
