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