diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Bangs.hs | 30 | ||||
-rw-r--r-- | src/Main.hs | 5 |
2 files changed, 28 insertions, 7 deletions
diff --git a/src/Bangs.hs b/src/Bangs.hs index 017d03b..274e96b 100644 --- a/src/Bangs.hs +++ b/src/Bangs.hs @@ -1,7 +1,13 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DeriveGeneric, GeneralizedNewtypeDeriving #-} -module Bangs (Bangs) where +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) @@ -10,10 +16,24 @@ 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. -data Bangs = Bangs (M.Map Text Text) deriving (Show) -instance FromJSON Bangs where - parseJSON b = fmap (Bangs . M.fromList) $ +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 diff --git a/src/Main.hs b/src/Main.hs index 997bbf5..1517ebd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,10 +2,11 @@ module Main (main) where -import Yesod +import Data.Aeson import Data.ByteString (ByteString) import Data.IORef import Network.HTTP.Simple +import Yesod import Bangs @@ -17,5 +18,5 @@ data Search = Search { main :: IO () main = do - ans <- (httpJSON "https://duckduckgo.com/bang.v255.js") :: IO (Response Bangs) + ans <- (httpJSON "https://duckduckgo.com/bang.v255.js") :: IO (Response DDGBangs) print ans |