aboutsummaryrefslogtreecommitdiff
path: root/src/Data/Bang.hs
blob: 2bf0966dca45bbcbafe0e812a71c1fa240def8f8 (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
40
41
42
43
44
45
46
47
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}

module Data.Bang (
    DDGBangs,
    toBangs,
    Bangs
) where

import GHC.Prim
import GHC.Generics (Generic)
import Data.Aeson
import Data.Text (Text)
import qualified Data.Map.Strict as M

-- M.Map BangName (SearchUrl, DisplayName)
newtype Bangs = Bangs {
    unBangs :: M.Map Text (Text, Text)
} deriving (Show, Generic)

instance FromJSON Bangs where
    parseJSON b = parseJSON b >>= fmap Bangs . sequence . fmap getInfo
      where getInfo v = (,) <$> v .: "url" <*> v .: "name"

instance ToJSON Bangs where
    toJSON (Bangs m) = toJSON
        $ (\(url, name) -> object ["url" .= url, "name" .= name])
        <$> m

    -- TODO toEncoding. semi important; makes startup/updates faster

newtype DDGBangs = DDGBangs (M.Map Text (Text, Text)) deriving (Show)
toBangs :: DDGBangs -> Bangs
toBangs = coerce

instance FromJSON DDGBangs where
    parseJSON b = fmap (DDGBangs . M.fromList)
        $ parseJSON b
        >>= mapM
        (\ob -> (,) <$> ob .: "t" <*> ((,) <$> ob .: "u" <*> ob .: "s"))

-- 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