{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} 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 -- 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