diff options
| -rw-r--r-- | bangs-ddgless.cabal | 15 | ||||
| -rw-r--r-- | package.yaml | 1 | ||||
| -rw-r--r-- | src/Bangs.hs | 30 | ||||
| -rw-r--r-- | src/Main.hs | 5 |
4 files changed, 35 insertions, 16 deletions
diff --git a/bangs-ddgless.cabal b/bangs-ddgless.cabal index 456f23d..38ff3d1 100644 --- a/bangs-ddgless.cabal +++ b/bangs-ddgless.cabal @@ -7,16 +7,12 @@ cabal-version: 1.12 name: bangs-ddgless version: 0.1.0.0 category: Web -homepage: https://github.com/githubuser/bangs-ddgless#readme -author: Author name here -maintainer: example@example.com -copyright: 2023 Author name here -license: BSD3 -license-file: LICENSE +homepage: https://codeberg.org/lialenck/bangs-ddgless +author: Lia Lenckowski +maintainer: lialenck@protonmail.com +copyright: 2023 Lia Lenckowski +license: AGPL build-type: Simple -extra-source-files: - README.md - CHANGELOG.md executable bangs-ddgless main-is: Main.hs @@ -31,6 +27,7 @@ executable bangs-ddgless , base >=4.7 && <5 , bytestring , containers + , ghc-prim , http-conduit , text , time diff --git a/package.yaml b/package.yaml index 0c3b4eb..1cf2c86 100644 --- a/package.yaml +++ b/package.yaml @@ -19,6 +19,7 @@ dependencies: - http-conduit - containers - text +- ghc-prim ghc-options: - -Wall 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 |