diff options
-rw-r--r-- | src/Bangs.hs | 31 |
1 files changed, 20 insertions, 11 deletions
diff --git a/src/Bangs.hs b/src/Bangs.hs index 274e96b..699ce38 100644 --- a/src/Bangs.hs +++ b/src/Bangs.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, DeriveGeneric, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} module Bangs ( DDGBangs, @@ -13,22 +13,31 @@ 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. +-- M.Map BangName (SearchUrl, DisplayName) newtype Bangs = Bangs { - unBangs :: M.Map Text Text -} deriving (Show, Generic, FromJSON, ToJSON) + unBangs :: M.Map Text (Text, Text) +} deriving (Show, Generic) -newtype DDGBangs = DDGBangs (M.Map Text Text) deriving (Show) +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 :: Parser [Value]) - >>= mapM (withObject "Bang" $ \ob -> - (,) <$> ob .: "t" <*> ob .: "u") + parseJSON b = fmap (DDGBangs . M.fromList) + $ parseJSON b + >>= mapM + (\ob -> (,) <$> ob .: "t" <*> ((,) <$> ob .: "u" <*> ob .: "s")) -- left-biased union instance Semigroup Bangs where |