{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}

module Nm.Map ( NmMap (..)
              , intersectionWith
              , isSubmapOf
              , (!)
              , elems
              , singleton
              , toList
              , fromList
              ) where

import           Control.Arrow  ((&&&))
import           Data.Bifunctor (first)
import qualified Data.IntMap    as IM
import qualified Data.Text      as T
import           Nm
import           U

infixl 9 !

data NmMap a = NmMap { forall a. NmMap a -> IntMap a
xx :: !(IM.IntMap a), forall a. NmMap a -> IntMap Text
context :: IM.IntMap T.Text }
             deriving (NmMap a -> NmMap a -> Bool
(NmMap a -> NmMap a -> Bool)
-> (NmMap a -> NmMap a -> Bool) -> Eq (NmMap a)
forall a. Eq a => NmMap a -> NmMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => NmMap a -> NmMap a -> Bool
== :: NmMap a -> NmMap a -> Bool
$c/= :: forall a. Eq a => NmMap a -> NmMap a -> Bool
/= :: NmMap a -> NmMap a -> Bool
Eq, (forall a b. (a -> b) -> NmMap a -> NmMap b)
-> (forall a b. a -> NmMap b -> NmMap a) -> Functor NmMap
forall a b. a -> NmMap b -> NmMap a
forall a b. (a -> b) -> NmMap a -> NmMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NmMap a -> NmMap b
fmap :: forall a b. (a -> b) -> NmMap a -> NmMap b
$c<$ :: forall a b. a -> NmMap b -> NmMap a
<$ :: forall a b. a -> NmMap b -> NmMap a
Functor, (forall m. Monoid m => NmMap m -> m)
-> (forall m a. Monoid m => (a -> m) -> NmMap a -> m)
-> (forall m a. Monoid m => (a -> m) -> NmMap a -> m)
-> (forall a b. (a -> b -> b) -> b -> NmMap a -> b)
-> (forall a b. (a -> b -> b) -> b -> NmMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> NmMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> NmMap a -> b)
-> (forall a. (a -> a -> a) -> NmMap a -> a)
-> (forall a. (a -> a -> a) -> NmMap a -> a)
-> (forall a. NmMap a -> [a])
-> (forall a. NmMap a -> Bool)
-> (forall a. NmMap a -> Int)
-> (forall a. Eq a => a -> NmMap a -> Bool)
-> (forall a. Ord a => NmMap a -> a)
-> (forall a. Ord a => NmMap a -> a)
-> (forall a. Num a => NmMap a -> a)
-> (forall a. Num a => NmMap a -> a)
-> Foldable NmMap
forall a. Eq a => a -> NmMap a -> Bool
forall a. Num a => NmMap a -> a
forall a. Ord a => NmMap a -> a
forall m. Monoid m => NmMap m -> m
forall a. NmMap a -> Bool
forall a. NmMap a -> Int
forall a. NmMap a -> [a]
forall a. (a -> a -> a) -> NmMap a -> a
forall m a. Monoid m => (a -> m) -> NmMap a -> m
forall b a. (b -> a -> b) -> b -> NmMap a -> b
forall a b. (a -> b -> b) -> b -> NmMap a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NmMap m -> m
fold :: forall m. Monoid m => NmMap m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NmMap a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NmMap a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NmMap a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NmMap a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NmMap a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NmMap a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NmMap a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NmMap a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NmMap a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NmMap a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NmMap a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NmMap a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NmMap a -> a
foldr1 :: forall a. (a -> a -> a) -> NmMap a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NmMap a -> a
foldl1 :: forall a. (a -> a -> a) -> NmMap a -> a
$ctoList :: forall a. NmMap a -> [a]
toList :: forall a. NmMap a -> [a]
$cnull :: forall a. NmMap a -> Bool
null :: forall a. NmMap a -> Bool
$clength :: forall a. NmMap a -> Int
length :: forall a. NmMap a -> Int
$celem :: forall a. Eq a => a -> NmMap a -> Bool
elem :: forall a. Eq a => a -> NmMap a -> Bool
$cmaximum :: forall a. Ord a => NmMap a -> a
maximum :: forall a. Ord a => NmMap a -> a
$cminimum :: forall a. Ord a => NmMap a -> a
minimum :: forall a. Ord a => NmMap a -> a
$csum :: forall a. Num a => NmMap a -> a
sum :: forall a. Num a => NmMap a -> a
$cproduct :: forall a. Num a => NmMap a -> a
product :: forall a. Num a => NmMap a -> a
Foldable, Functor NmMap
Foldable NmMap
(Functor NmMap, Foldable NmMap) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> NmMap a -> f (NmMap b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NmMap (f a) -> f (NmMap a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NmMap a -> m (NmMap b))
-> (forall (m :: * -> *) a. Monad m => NmMap (m a) -> m (NmMap a))
-> Traversable NmMap
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NmMap (m a) -> m (NmMap a)
forall (f :: * -> *) a. Applicative f => NmMap (f a) -> f (NmMap a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NmMap a -> m (NmMap b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NmMap a -> f (NmMap b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NmMap a -> f (NmMap b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NmMap a -> f (NmMap b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => NmMap (f a) -> f (NmMap a)
sequenceA :: forall (f :: * -> *) a. Applicative f => NmMap (f a) -> f (NmMap a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NmMap a -> m (NmMap b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NmMap a -> m (NmMap b)
$csequence :: forall (m :: * -> *) a. Monad m => NmMap (m a) -> m (NmMap a)
sequence :: forall (m :: * -> *) a. Monad m => NmMap (m a) -> m (NmMap a)
Traversable)

instance Semigroup (NmMap a) where
    <> :: NmMap a -> NmMap a -> NmMap a
(<>) (NmMap IntMap a
x IntMap Text
y) (NmMap IntMap a
x' IntMap Text
y') = IntMap a -> IntMap Text -> NmMap a
forall a. IntMap a -> IntMap Text -> NmMap a
NmMap (IntMap a
xIntMap a -> IntMap a -> IntMap a
forall a. Semigroup a => a -> a -> a
<>IntMap a
x') (IntMap Text
yIntMap Text -> IntMap Text -> IntMap Text
forall a. Semigroup a => a -> a -> a
<>IntMap Text
y')

singleton :: Nm a -> b -> NmMap b
singleton :: forall a b. Nm a -> b -> NmMap b
singleton (Nm Text
n (U Int
i) a
_) b
x = IntMap b -> IntMap Text -> NmMap b
forall a. IntMap a -> IntMap Text -> NmMap a
NmMap (Int -> b -> IntMap b
forall a. Int -> a -> IntMap a
IM.singleton Int
i b
x) (Int -> Text -> IntMap Text
forall a. Int -> a -> IntMap a
IM.singleton Int
i Text
n)

(!) :: NmMap a -> Nm b -> a
! :: forall a b. NmMap a -> Nm b -> a
(!) (NmMap IntMap a
x IntMap Text
_) (Nm Text
_ (U Int
i) b
_) = IntMap a
x IntMap a -> Int -> a
forall a. IntMap a -> Int -> a
IM.! Int
i

intersectionWith :: (a -> b -> c) -> NmMap a -> NmMap b -> NmMap c
intersectionWith :: forall a b c. (a -> b -> c) -> NmMap a -> NmMap b -> NmMap c
intersectionWith a -> b -> c
f (NmMap IntMap a
x0 IntMap Text
c0) (NmMap IntMap b
x1 IntMap Text
c1) = IntMap c -> IntMap Text -> NmMap c
forall a. IntMap a -> IntMap Text -> NmMap a
NmMap ((a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith a -> b -> c
f IntMap a
x0 IntMap b
x1) (IntMap Text -> IntMap Text -> IntMap Text
forall a b. IntMap a -> IntMap b -> IntMap a
IM.intersection IntMap Text
c0 IntMap Text
c1)

isSubmapOf :: NmMap a -> NmMap b -> Bool
isSubmapOf :: forall a b. NmMap a -> NmMap b -> Bool
isSubmapOf (NmMap IntMap a
x IntMap Text
_) (NmMap IntMap b
y IntMap Text
_) = (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
IM.isSubmapOfBy (\a
_ b
_ -> Bool
True) IntMap a
x IntMap b
y

elems :: NmMap a -> [a]
elems :: forall a. NmMap a -> [a]
elems (NmMap IntMap a
x IntMap Text
_) = IntMap a -> [a]
forall a. IntMap a -> [a]
IM.elems IntMap a
x

toList :: NmMap a -> [(Nm (), a)]
toList :: forall a. NmMap a -> [(Nm (), a)]
toList (NmMap IntMap a
x IntMap Text
ns) = ((Int, a) -> (Nm (), a)) -> [(Int, a)] -> [(Nm (), a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Nm ()) -> (Int, a) -> (Nm (), a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\Int
i -> Text -> U -> () -> Nm ()
forall a. Text -> U -> a -> Nm a
Nm (IntMap Text
ns IntMap Text -> Int -> Text
forall a. IntMap a -> Int -> a
IM.! Int
i) (Int -> U
U Int
i) ())) (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap a
x)

fromList :: [(Nm a, b)] -> NmMap b
fromList :: forall a b. [(Nm a, b)] -> NmMap b
fromList [(Nm a, b)]
xs = NmMap { xx :: IntMap b
xx = [(Int, b)] -> IntMap b
forall a. [(Int, a)] -> IntMap a
IM.fromList [ (Int
i,b
x) | (Nm Text
_ (U Int
i) a
_, b
x) <- [(Nm a, b)]
xs ], context :: IntMap Text
context = [(Int, Text)] -> IntMap Text
forall a. [(Int, a)] -> IntMap a
IM.fromList ((Nm a -> (Int, Text)) -> [Nm a] -> [(Int, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((U -> Int
unU(U -> Int) -> (Nm a -> U) -> Nm a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Nm a -> U
forall a. Nm a -> U
unique) (Nm a -> Int) -> (Nm a -> Text) -> Nm a -> (Int, Text)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Nm a -> Text
forall a. Nm a -> Text
name) ((Nm a, b) -> Nm a
forall a b. (a, b) -> a
fst((Nm a, b) -> Nm a) -> [(Nm a, b)] -> [Nm a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[(Nm a, b)]
xs)) }