{-# OPTIONS -fallow-overlapping-instances -fglasgow-exts -fallow-undecidable-instances -fallow-incoherent-instances #-}

{-# language TypeApplications #-}

module Autolib.FiniteMap

( module Autolib.Data.Map
, module Autolib.FiniteMap
)

where

import Autolib.Reader
import Autolib.ToDoc
import Autolib.Set

import Autolib.Data.Map
import Autolib.Xml

import Data.Typeable
import Data.Hashable

{-

instance ( Typeable a, Typeable b ) => Typeable (FiniteMap a b) where
    typeOf (_ :: FiniteMap a b) = 
        mkTyConApp
               (mkTyCon "Autolib.Data.Map.FiniteMap") 
               [ typeOf (undefined :: a), typeOf (undefined :: b) ]

-}


instance (ToDoc a, ToDoc b) => ToDoc (FiniteMap a b) where
  toDocPrec :: Int -> FiniteMap a b -> Doc
toDocPrec Int
p FiniteMap a b
fm = 
    Bool -> Doc -> Doc
docParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fcp) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"listToFM" Doc -> Doc -> Doc
</> Int -> [(a, b)] -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
fcp (FiniteMap a b -> [(a, b)]
forall {k} {a}. Map k a -> [(k, a)]
fmToList FiniteMap a b
fm)

instance (Nice a, Nice b) => Nice (FiniteMap a b) where
  nicePrec :: Int -> FiniteMap a b -> Doc
nicePrec Int
p FiniteMap a b
fm = 
    Bool -> Doc -> Doc
docParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fcp) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"listToFM" Doc -> Doc -> Doc
</> Int -> [(a, b)] -> Doc
forall a. Nice a => Int -> a -> Doc
nicePrec Int
fcp (FiniteMap a b -> [(a, b)]
forall {k} {a}. Map k a -> [(k, a)]
fmToList FiniteMap a b
fm)


instance ( Ord a, Reader a, Reader b ) => Reader ( FiniteMap a b ) where
    atomic_readerPrec :: Int -> Parser (FiniteMap a b)
atomic_readerPrec Int
p = Int -> Parser (FiniteMap a b)
forall a b.
(Ord a, Reader a, Reader b) =>
Int -> Parser (FiniteMap a b)
default_readerPrec Int
p
    reader :: Parser (FiniteMap a b)
reader = Int -> Parser (FiniteMap a b)
forall a. Reader a => Int -> Parser a
atomic_readerPrec Int
0

default_readerPrec ::  ( Ord a, Reader a, Reader b ) 
               => Int -> Parser ( FiniteMap a b )
default_readerPrec :: forall a b.
(Ord a, Reader a, Reader b) =>
Int -> Parser (FiniteMap a b)
default_readerPrec Int
p = do
        Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ( Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9 )
        String -> ParsecT String () Identity ()
my_reserved String
"listToFM"
        xys <-  Parser [(a, b)]
forall a. Reader a => Parser a
reader
        return $ listToFM xys

-------------------------------------------------------------------------

instance (Ord a ) => Container (FiniteMap a b) [(a, b)] where
    label :: FiniteMap a b -> String
label FiniteMap a b
_ = String
"FiniteMap"
    pack :: FiniteMap a b -> [(a, b)]
pack = FiniteMap a b -> [(a, b)]
forall {k} {a}. Map k a -> [(k, a)]
fmToList
    unpack :: [(a, b)] -> FiniteMap a b
unpack = [(a, b)] -> FiniteMap a b
forall {k} {a}. Ord k => [(k, a)] -> Map k a
listToFM


mergeFM :: (Ord a, Ord b) => 
        FiniteMap a (Set b) -> FiniteMap a (Set b) -> FiniteMap a (Set b)
mergeFM :: forall a b.
(Ord a, Ord b) =>
FiniteMap a (Set b) -> FiniteMap a (Set b) -> FiniteMap a (Set b)
mergeFM FiniteMap a (Set b)
l FiniteMap a (Set b)
r = (Set b -> Set b -> Set b)
-> FiniteMap a (Set b)
-> FiniteMap a (Set b)
-> FiniteMap a (Set b)
forall {k} {a}.
Ord k =>
(a -> a -> a) -> Map k a -> Map k a -> Map k a
plusFM_C Set b -> Set b -> Set b
forall {a}. Ord a => Set a -> Set a -> Set a
union FiniteMap a (Set b)
l FiniteMap a (Set b)
r

{-# INLINE lookupset #-}
lookupset :: Ord a => FiniteMap a (Set b) -> a -> Set b
lookupset :: forall a b. Ord a => FiniteMap a (Set b) -> a -> Set b
lookupset FiniteMap a (Set b)
fm a
x = case FiniteMap a (Set b) -> a -> Maybe (Set b)
forall k a. Ord k => FiniteMap k a -> k -> Maybe a
lookupFM FiniteMap a (Set b)
fm a
x of
    Just Set b
m -> Set b
m; Maybe (Set b)
Nothing -> Set b
forall {a}. Set a
emptySet