{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}

module Data.Bang (
    DDGBangs,
    toBangs,
    Bangs,
    singletonBangs
) where

import GHC.Prim
import GHC.Generics (Generic)
import Data.Aeson
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)

singletonBangs :: Text -> Text -> Text -> Bangs
singletonBangs bn bu bdp = Bangs $ M.singleton bn (bu, bdp)

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

    -- this could be optimized by folding over 'm' to create a bytestring builder,
    -- but I don't think the complexity/unsafety is worth the small performance gain
    toEncoding (Bangs m) = toEncoding
        $ (\(url, name) -> object ["url" .= url, "name" .= name])
        <$> m

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