-- |
--   Copyright   :  (c) Sam Truzjan 2013
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  stable
--   Portability :  portable
--
--   This module defines a simple key\/value list ordered by keys
--   which both faster and more suitable for bencode dictionaries than
--   just [(k,v)].
--

{-# LANGUAGE CPP           #-}
{-# LANGUAGE DeriveGeneric #-}

module Data.BEncode.BDict
       ( BKey
       , BDictMap (..)

         -- * Construction
       , Data.BEncode.BDict.empty
       , Data.BEncode.BDict.singleton

         -- * Query
       , Data.BEncode.BDict.null
       , Data.BEncode.BDict.member
       , Data.BEncode.BDict.lookup

         -- * Combine
       , Data.BEncode.BDict.union

         -- * Maps
       , Data.BEncode.BDict.map
       , Data.BEncode.BDict.mapWithKey

         -- * Folds
       , Data.BEncode.BDict.foldMapWithKey
       , Data.BEncode.BDict.bifoldMap

         -- * Conversion
       , Data.BEncode.BDict.fromAscList
       , Data.BEncode.BDict.toAscList
       ) where

import Control.DeepSeq
import Data.ByteString as BS
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
import Data.Monoid (Monoid (mappend, mempty))
#endif
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup (Semigroup ((<>)))
#endif
import GHC.Generics (Generic)

type BKey = ByteString

-- STRICTNESS NOTE: the BKey is always evaluated since we either use a
-- literal or compare before insert to the dict
--
-- LAYOUT NOTE: we don't use [StrictPair BKey a] since it introduce
-- one more constructor per cell
--

-- | BDictMap is an ascending list of key\/value pairs sorted by keys.
data BDictMap a
  = Cons !BKey a !(BDictMap a)
  | Nil
    deriving (Int -> BDictMap a -> ShowS
[BDictMap a] -> ShowS
BDictMap a -> String
(Int -> BDictMap a -> ShowS)
-> (BDictMap a -> String)
-> ([BDictMap a] -> ShowS)
-> Show (BDictMap a)
forall a. Show a => Int -> BDictMap a -> ShowS
forall a. Show a => [BDictMap a] -> ShowS
forall a. Show a => BDictMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> BDictMap a -> ShowS
showsPrec :: Int -> BDictMap a -> ShowS
$cshow :: forall a. Show a => BDictMap a -> String
show :: BDictMap a -> String
$cshowList :: forall a. Show a => [BDictMap a] -> ShowS
showList :: [BDictMap a] -> ShowS
Show, ReadPrec [BDictMap a]
ReadPrec (BDictMap a)
Int -> ReadS (BDictMap a)
ReadS [BDictMap a]
(Int -> ReadS (BDictMap a))
-> ReadS [BDictMap a]
-> ReadPrec (BDictMap a)
-> ReadPrec [BDictMap a]
-> Read (BDictMap a)
forall a. Read a => ReadPrec [BDictMap a]
forall a. Read a => ReadPrec (BDictMap a)
forall a. Read a => Int -> ReadS (BDictMap a)
forall a. Read a => ReadS [BDictMap a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (BDictMap a)
readsPrec :: Int -> ReadS (BDictMap a)
$creadList :: forall a. Read a => ReadS [BDictMap a]
readList :: ReadS [BDictMap a]
$creadPrec :: forall a. Read a => ReadPrec (BDictMap a)
readPrec :: ReadPrec (BDictMap a)
$creadListPrec :: forall a. Read a => ReadPrec [BDictMap a]
readListPrec :: ReadPrec [BDictMap a]
Read, BDictMap a -> BDictMap a -> Bool
(BDictMap a -> BDictMap a -> Bool)
-> (BDictMap a -> BDictMap a -> Bool) -> Eq (BDictMap a)
forall a. Eq a => BDictMap a -> BDictMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => BDictMap a -> BDictMap a -> Bool
== :: BDictMap a -> BDictMap a -> Bool
$c/= :: forall a. Eq a => BDictMap a -> BDictMap a -> Bool
/= :: BDictMap a -> BDictMap a -> Bool
Eq, Eq (BDictMap a)
Eq (BDictMap a) =>
(BDictMap a -> BDictMap a -> Ordering)
-> (BDictMap a -> BDictMap a -> Bool)
-> (BDictMap a -> BDictMap a -> Bool)
-> (BDictMap a -> BDictMap a -> Bool)
-> (BDictMap a -> BDictMap a -> Bool)
-> (BDictMap a -> BDictMap a -> BDictMap a)
-> (BDictMap a -> BDictMap a -> BDictMap a)
-> Ord (BDictMap a)
BDictMap a -> BDictMap a -> Bool
BDictMap a -> BDictMap a -> Ordering
BDictMap a -> BDictMap a -> BDictMap a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (BDictMap a)
forall a. Ord a => BDictMap a -> BDictMap a -> Bool
forall a. Ord a => BDictMap a -> BDictMap a -> Ordering
forall a. Ord a => BDictMap a -> BDictMap a -> BDictMap a
$ccompare :: forall a. Ord a => BDictMap a -> BDictMap a -> Ordering
compare :: BDictMap a -> BDictMap a -> Ordering
$c< :: forall a. Ord a => BDictMap a -> BDictMap a -> Bool
< :: BDictMap a -> BDictMap a -> Bool
$c<= :: forall a. Ord a => BDictMap a -> BDictMap a -> Bool
<= :: BDictMap a -> BDictMap a -> Bool
$c> :: forall a. Ord a => BDictMap a -> BDictMap a -> Bool
> :: BDictMap a -> BDictMap a -> Bool
$c>= :: forall a. Ord a => BDictMap a -> BDictMap a -> Bool
>= :: BDictMap a -> BDictMap a -> Bool
$cmax :: forall a. Ord a => BDictMap a -> BDictMap a -> BDictMap a
max :: BDictMap a -> BDictMap a -> BDictMap a
$cmin :: forall a. Ord a => BDictMap a -> BDictMap a -> BDictMap a
min :: BDictMap a -> BDictMap a -> BDictMap a
Ord, (forall x. BDictMap a -> Rep (BDictMap a) x)
-> (forall x. Rep (BDictMap a) x -> BDictMap a)
-> Generic (BDictMap a)
forall x. Rep (BDictMap a) x -> BDictMap a
forall x. BDictMap a -> Rep (BDictMap a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BDictMap a) x -> BDictMap a
forall a x. BDictMap a -> Rep (BDictMap a) x
$cfrom :: forall a x. BDictMap a -> Rep (BDictMap a) x
from :: forall x. BDictMap a -> Rep (BDictMap a) x
$cto :: forall a x. Rep (BDictMap a) x -> BDictMap a
to :: forall x. Rep (BDictMap a) x -> BDictMap a
Generic)

instance NFData a => NFData (BDictMap a) where
  rnf :: BDictMap a -> ()
rnf  BDictMap a
Nil         = ()
  rnf (Cons BKey
_ a
v BDictMap a
xs)= a -> ()
forall a. NFData a => a -> ()
rnf a
v () -> () -> ()
forall a b. a -> b -> b
`seq` BDictMap a -> ()
forall a. NFData a => a -> ()
rnf BDictMap a
xs

instance Functor BDictMap where
  fmap :: forall a b. (a -> b) -> BDictMap a -> BDictMap b
fmap = (a -> b) -> BDictMap a -> BDictMap b
forall a b. (a -> b) -> BDictMap a -> BDictMap b
Data.BEncode.BDict.map
  {-# INLINE fmap #-}

instance Foldable BDictMap where
  foldMap :: forall m a. Monoid m => (a -> m) -> BDictMap a -> m
foldMap a -> m
f = BDictMap a -> m
go
    where
      go :: BDictMap a -> m
go  BDictMap a
Nil          = m
forall a. Monoid a => a
mempty
      go (Cons BKey
_ a
v BDictMap a
xs) = a -> m
f a
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` BDictMap a -> m
go BDictMap a
xs
  {-# INLINE foldMap #-}

instance Semigroup (BDictMap a) where
  <> :: BDictMap a -> BDictMap a -> BDictMap a
(<>) = BDictMap a -> BDictMap a -> BDictMap a
forall a. BDictMap a -> BDictMap a -> BDictMap a
Data.BEncode.BDict.union

instance Monoid (BDictMap a) where
  mempty :: BDictMap a
mempty  = BDictMap a
forall a. BDictMap a
Data.BEncode.BDict.empty
  mappend :: BDictMap a -> BDictMap a -> BDictMap a
mappend = BDictMap a -> BDictMap a -> BDictMap a
forall a. Semigroup a => a -> a -> a
(<>)

-- | /O(1)/. The empty dicionary.
empty :: BDictMap a
empty :: forall a. BDictMap a
empty = BDictMap a
forall a. BDictMap a
Nil
{-# INLINE empty #-}

-- | /O(1)/. Dictionary of one key-value pair.
singleton :: BKey -> a -> BDictMap a
singleton :: forall a. BKey -> a -> BDictMap a
singleton BKey
k a
v = BKey -> a -> BDictMap a -> BDictMap a
forall a. BKey -> a -> BDictMap a -> BDictMap a
Cons BKey
k a
v BDictMap a
forall a. BDictMap a
Nil
{-# INLINE singleton #-}

-- | /O(1)/. Is the dictionary empty?
null :: BDictMap a -> Bool
null :: forall a. BDictMap a -> Bool
null BDictMap a
Nil = Bool
True
null BDictMap a
_   = Bool
False
{-# INLINE null #-}

-- | /O(n)/. Is the key a member of the dictionary?
member :: BKey -> BDictMap a -> Bool
member :: forall a. BKey -> BDictMap a -> Bool
member BKey
key = BDictMap a -> Bool
forall a. BDictMap a -> Bool
go
  where
    go :: BDictMap a -> Bool
go  BDictMap a
Nil          = Bool
False
    go (Cons BKey
k a
_ BDictMap a
xs)
      | BKey
k BKey -> BKey -> Bool
forall a. Eq a => a -> a -> Bool
== BKey
key  = Bool
True
      | Bool
otherwise = BDictMap a -> Bool
go BDictMap a
xs

-- | /O(n)/. Lookup the value at a key in the dictionary.
lookup :: BKey -> BDictMap a -> Maybe a
lookup :: forall a. BKey -> BDictMap a -> Maybe a
lookup BKey
x = BDictMap a -> Maybe a
forall {a}. BDictMap a -> Maybe a
go
  where
    go :: BDictMap a -> Maybe a
go BDictMap a
Nil = Maybe a
forall a. Maybe a
Nothing
    go (Cons BKey
k a
v BDictMap a
xs)
      |   BKey
k BKey -> BKey -> Bool
forall a. Eq a => a -> a -> Bool
== BKey
x  = a -> Maybe a
forall a. a -> Maybe a
Just a
v
      | Bool
otherwise = BDictMap a -> Maybe a
go BDictMap a
xs
{-# INLINE lookup #-}

-- | /O(n + m)/. Merge two dictionaries by taking pair from both given
-- dictionaries. Dublicated keys are /not/ filtered.
--
union :: BDictMap a -> BDictMap a -> BDictMap a
union :: forall a. BDictMap a -> BDictMap a -> BDictMap a
union BDictMap a
Nil BDictMap a
xs  = BDictMap a
xs
union BDictMap a
xs  BDictMap a
Nil = BDictMap a
xs
union bd :: BDictMap a
bd@(Cons BKey
k a
v BDictMap a
xs) bd' :: BDictMap a
bd'@(Cons BKey
k' a
v' BDictMap a
xs')
  |   BKey
k BKey -> BKey -> Bool
forall a. Ord a => a -> a -> Bool
< BKey
k'  = BKey -> a -> BDictMap a -> BDictMap a
forall a. BKey -> a -> BDictMap a -> BDictMap a
Cons BKey
k  a
v  (BDictMap a -> BDictMap a -> BDictMap a
forall a. BDictMap a -> BDictMap a -> BDictMap a
union BDictMap a
xs BDictMap a
bd')
  | Bool
otherwise = BKey -> a -> BDictMap a -> BDictMap a
forall a. BKey -> a -> BDictMap a -> BDictMap a
Cons BKey
k' a
v' (BDictMap a -> BDictMap a -> BDictMap a
forall a. BDictMap a -> BDictMap a -> BDictMap a
union BDictMap a
bd BDictMap a
xs')

-- | /O(n)./ Map a function over all values in the dictionary.
map :: (a -> b) -> BDictMap a -> BDictMap b
map :: forall a b. (a -> b) -> BDictMap a -> BDictMap b
map a -> b
f = BDictMap a -> BDictMap b
go
  where
    go :: BDictMap a -> BDictMap b
go BDictMap a
Nil = BDictMap b
forall a. BDictMap a
Nil
    go (Cons BKey
k a
v BDictMap a
xs) = BKey -> b -> BDictMap b -> BDictMap b
forall a. BKey -> a -> BDictMap a -> BDictMap a
Cons BKey
k (a -> b
f a
v) (BDictMap a -> BDictMap b
go BDictMap a
xs)
{-# INLINE map #-}

-- | /O(n)./ Map a function over all keys\/value pairs in the dictionary.
mapWithKey :: (BKey -> a -> b) -> BDictMap a -> BDictMap b
mapWithKey :: forall a b. (BKey -> a -> b) -> BDictMap a -> BDictMap b
mapWithKey BKey -> a -> b
f = BDictMap a -> BDictMap b
go
  where
    go :: BDictMap a -> BDictMap b
go BDictMap a
Nil = BDictMap b
forall a. BDictMap a
Nil
    go (Cons BKey
k a
v BDictMap a
xs) = BKey -> b -> BDictMap b -> BDictMap b
forall a. BKey -> a -> BDictMap a -> BDictMap a
Cons BKey
k (BKey -> a -> b
f BKey
k a
v) (BDictMap a -> BDictMap b
go BDictMap a
xs)
{-# INLINE mapWithKey #-}

-- | /O(n)/. Map each key\/value pair to a monoid and fold resulting
-- sequnce using 'mappend'.
--
foldMapWithKey :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m
foldMapWithKey :: forall m a. Monoid m => (BKey -> a -> m) -> BDictMap a -> m
foldMapWithKey BKey -> a -> m
f = BDictMap a -> m
go
  where
    go :: BDictMap a -> m
go  BDictMap a
Nil          = m
forall a. Monoid a => a
mempty
    go (Cons BKey
k a
v BDictMap a
xs) = BKey -> a -> m
f BKey
k a
v m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` BDictMap a -> m
go BDictMap a
xs
{-# INLINE foldMapWithKey #-}

{-# DEPRECATED bifoldMap "Use foldMapWithKey instead" #-}
-- | /O(n)/. Map each key\/value pair to a monoid and fold resulting
-- sequnce using 'mappend'.
--
bifoldMap :: Monoid m => (BKey -> a -> m) -> BDictMap a -> m
bifoldMap :: forall m a. Monoid m => (BKey -> a -> m) -> BDictMap a -> m
bifoldMap = (BKey -> a -> m) -> BDictMap a -> m
forall m a. Monoid m => (BKey -> a -> m) -> BDictMap a -> m
foldMapWithKey
{-# INLINE bifoldMap #-}

-- | /O(n)/. Build a dictionary from a list of key\/value pairs where
-- the keys are in ascending order.
--
fromAscList :: [(BKey, a)] -> BDictMap a
fromAscList :: forall a. [(BKey, a)] -> BDictMap a
fromAscList [] = BDictMap a
forall a. BDictMap a
Nil
fromAscList ((BKey
k, a
v) : [(BKey, a)]
xs) = BKey -> a -> BDictMap a -> BDictMap a
forall a. BKey -> a -> BDictMap a -> BDictMap a
Cons BKey
k a
v ([(BKey, a)] -> BDictMap a
forall a. [(BKey, a)] -> BDictMap a
fromAscList [(BKey, a)]
xs)

-- | /O(n)/. Convert the dictionary to a list of key\/value pairs
-- where the keys are in ascending order.
--
toAscList :: BDictMap a -> [(BKey, a)]
toAscList :: forall a. BDictMap a -> [(BKey, a)]
toAscList BDictMap a
Nil = []
toAscList (Cons BKey
k a
v BDictMap a
xs) = (BKey
k, a
v) (BKey, a) -> [(BKey, a)] -> [(BKey, a)]
forall a. a -> [a] -> [a]
: BDictMap a -> [(BKey, a)]
forall a. BDictMap a -> [(BKey, a)]
toAscList BDictMap a
xs