content: {-# LANGUAGE GADTs, DeriveAnyClass, DeriveGeneric, OverloadedStrings, DeriveLift
      , QuasiQuotes, TemplateHaskell, DeriveDataTypeable #-}
  {-|
    Module      : Text.ANTLR.Set
    Description : Entrypoint for swapping out different underlying set representations
    Copyright   : (c) Karl Cronburg, 2018
    License     : BSD3
    Maintainer  : karl@cs.tufts.edu
    Stability   : experimental
    Portability : POSIX
  
  -}
  module Text.ANTLR.Set
    ( Set, null, size, member, notMember
    , empty, singleton, insert, delete, union, unions
    , difference, intersection, filter, map, foldr, foldl', fold
    , toList, fromList, (\\), findMin, maybeMin
    , Hashable(..), Generic(..)
    ) where
  import Text.ANTLR.Pretty
  
  import GHC.Generics (Generic, Rep)
  import Data.Hashable (Hashable(..))
  import Language.Haskell.TH.Syntax (Lift(..))
  
  import qualified Data.Functor         as F
  import qualified Control.Applicative  as A
  import qualified Data.Foldable        as Foldable
  
  import Data.Map ( Map(..) )
  import qualified Data.Map as M
  
  import qualified Data.HashSet as S
  import Data.HashSet as S
    ( HashSet(..), member, toList, union
    , null, empty, map, size, singleton, insert
    , delete, unions, difference, intersection, foldl'
    , fromList
    )
  
  import Prelude hiding (null, filter, map, foldr, foldl)
  
  -- | Use a hash-based set (hashable keys) for our internal set representation
  --   during parsing.
  type Set = S.HashSet
  
  -- | Is @e@ not a member of the set @s@.
  notMember e s = not $ member e s
  
  -- | Set fold
  fold = S.foldr
  
  -- | Set fold
  foldr = S.foldr
  
  -- | Find the minimum value of an orderable set.
  findMin :: (Ord a, Hashable a) => Set a -> a
  findMin = minimum . toList
  
  --maybeMin :: (Ord a, Hashable a) => Set a -> Maybe a
  -- | Get minimum of a set without erroring out on empty set.
  maybeMin as
    | S.size as == 0  = Nothing
    | otherwise       = Just $ findMin as
  
  infixl 9 \\
  
  -- | Set difference
  (\\) :: (Hashable a, Eq a) => Set a -> Set a -> Set a
  m1 \\ m2 = difference m1 m2
  
  instance (Hashable a, Eq a, Lift a) => Lift (S.HashSet a) where
    lift set = [| fromList $(lift $ toList set) |]
  
  instance (Hashable k, Hashable v) => Hashable (Map k v) where
    hashWithSalt salt mp = salt `hashWithSalt` M.toList mp
  
  instance (Prettify a, Hashable a, Eq a) => Prettify (S.HashSet a) where
    prettify s = do
      pStr "Set: "; incrIndent 5
      pListLines $ toList s
      incrIndent (-5)
      pLine ""
  
  --filter :: (Hashable a, Eq a) => (a -> Bool) -> Set a -> Set a
  -- | Set filter
  filter f s = S.filter f s
  
  --instance (Hashable a, Eq a) => Hashable (S.HashSet a) where
  --  hashWithSalt salt set = salt `hashWithSalt` S.toList (run set)
  
  
  {-
  
  --import Data.Set.Monad (Set(..), member, toList, union, notMember)
  --import qualified Data.Set.Monad as Set
  
  import Prelude hiding (null, filter, map, foldr, foldl)
  import qualified Data.List            as L
  --import qualified Data.Set             as S
  import qualified Data.Functor         as F
  import qualified Control.Applicative  as A
  import qualified Data.Foldable        as Foldable
  
  import Data.Monoid
  import Data.Foldable (Foldable)
  import Control.Arrow
  import Control.Monad
  import Control.DeepSeq
  
  import Data.Hashable (Hashable(..))
  import GHC.Generics (Generic, Rep)
  import Control.DeepSeq (NFData(..))
  import Language.Haskell.TH.Syntax (Lift(..))
  import Data.Data (Data(..))
  
  import Data.Map ( Map(..) )
  import qualified Data.Map as M
  
  import Text.ANTLR.Pretty
  
  instance (Hashable k, Hashable v) => Hashable (Map k v) where
    hashWithSalt salt mp = salt `hashWithSalt` M.toList mp
  
  instance (Hashable a, Eq a) => Hashable (Set a) where
    hashWithSalt salt set = salt `hashWithSalt` S.toList (run set)
  
  instance (Hashable a, Ord a) => Ord (Set a) where
    s1 <= s2 = S.toList (run s1) <= S.toList (run s2)
  
  data Set a where
    Prim   :: (Hashable a, Eq a) => S.HashSet a -> Set a
    Return :: a -> Set a
    Bind   :: Set a -> (a -> Set b) -> Set b
    Zero   :: Set a
    Plus   :: Set a -> Set a -> Set a
  
  instance (Data a) => Data (Set a)
  
  instance (Hashable a, Eq a, Lift a) => Lift (Set a) where
    lift set = [| fromList $(lift $ toList set) |]
  
  run :: (Hashable a, Eq a) => Set a -> S.HashSet a
  run (Prim s)                        = s
  run (Return a)                      = S.singleton a
  run (Zero)                          = S.empty
  run (Plus ma mb)                    = run ma `S.union` run mb
  run (Bind (Prim s) f)               = S.foldl' S.union S.empty (S.map (run . f) s)
  run (Bind (Return a) f)             = run (f a)
  run (Bind Zero _)                   = S.empty
  run (Bind (Plus (Prim s) ma) f)     = run (Bind (Prim (s `S.union` run ma)) f)
  run (Bind (Plus ma (Prim s)) f)     = run (Bind (Prim (run ma `S.union` s)) f)
  run (Bind (Plus (Return a) ma) f)   = run (Plus (f a) (Bind ma f))
  run (Bind (Plus ma (Return a)) f)   = run (Plus (Bind ma f) (f a))
  run (Bind (Plus Zero ma) f)         = run (Bind ma f)
  run (Bind (Plus ma Zero) f)         = run (Bind ma f)
  run (Bind (Plus (Plus ma mb) mc) f) = run (Bind (Plus ma (Plus mb mc)) f)
  run (Bind (Plus ma mb) f)           = run (Plus (Bind ma f) (Bind mb f))
  run (Bind (Bind ma f) g)            = run (Bind ma (\a -> Bind (f a) g))
  
  instance F.Functor Set where
    fmap = liftM
  
  instance A.Applicative Set where
    pure  = return
    (<*>) = ap
  
  instance A.Alternative Set where
    empty = Zero
    (<|>) = Plus
  
  instance Monad Set where
    return = Return
    (>>=)  = Bind
  
  instance MonadPlus Set where
    mzero = Zero
    mplus = Plus
  
  instance (Hashable a, Eq a) => Monoid (Set a) where
    mempty  = empty
    mappend = union
    mconcat = unions
  
  instance Foldable Set where
      foldr f def m = 
          case m of
              Prim s -> S.foldr f def s
              Return a -> f a def
              Zero -> def
              Plus ma mb -> Foldable.foldr f (Foldable.foldr f def ma) mb
              Bind s g -> Foldable.foldr f' def s
                  where f' x b = Foldable.foldr f b (g x)
  
  instance (Hashable a, Eq a) => Eq (Set a) where
    s1 == s2 = run s1 == run s2
  
  --instance (Hashable a, Eq a, Ord a) => Ord (Set a) where
  --  compare s1 s2 = compare (run s1) (run s2)
  
  instance (Show a, Hashable a, Eq a) => Show (Set a) where
    show = show . run
  
  instance (Prettify a, Hashable a, Eq a) => Prettify (Set a) where
    prettify s = do
      pStr "Set: "; incrIndent 5
      pListLines $ toList s
      incrIndent (-5)
      pLine ""
  
  instance (Read a, Hashable a, Eq a) => Read (Set a) where
    readsPrec i s = L.map (first Prim) (readsPrec i s)
  
  instance (NFData a, Hashable a, Eq a) => NFData (Set a) where
    rnf = rnf . run
  
  infixl 9 \\
  
  (\\) :: (Hashable a, Eq a) => Set a -> Set a -> Set a
  m1 \\ m2 = difference m1 m2
  
  null :: (Hashable a, Eq a) => Set a -> Bool
  null = S.null . run
  
  size :: (Hashable a, Eq a) => Set a -> Int
  size = S.size . run
  
  member :: (Hashable a, Eq a) => a -> Set a -> Bool
  member a s = S.member a (run s)
  
  notMember :: (Hashable a, Eq a) => a -> Set a -> Bool
  notMember a t = not (member a t)
  
  empty :: (Hashable a, Eq a) => Set a
  empty = Prim S.empty
  
  singleton :: (Hashable a, Eq a) => a -> Set a
  singleton a = Prim (S.singleton a)
  
  insert :: (Hashable a, Eq a) => a -> Set a -> Set a
  insert a s = Prim (S.insert a (run s))
  
  delete :: (Hashable a, Eq a) => a -> Set a -> Set a
  delete a s = Prim (S.delete a (run s))
  
  union :: (Hashable a, Eq a) => Set a -> Set a -> Set a
  union s1 s2 = Prim (run s1 `S.union` run s2)
  
  unions :: (Hashable a, Eq a) => [Set a] -> Set a
  unions ss = Prim (S.unions (L.map run ss))
  
  difference :: (Hashable a, Eq a) => Set a -> Set a -> Set a
  difference s1 s2 = Prim (S.difference (run s1) (run s2))
  
  intersection :: (Hashable a, Eq a) => Set a -> Set a -> Set a
  intersection s1 s2 = Prim (S.intersection (run s1) (run s2))
  
  filter :: (Hashable a, Eq a) => (a -> Bool) -> Set a -> Set a
  filter f s = Prim (S.filter f (run s))
  
  map :: (Hashable a, Eq a, Hashable b, Eq b) => (a -> b) -> Set a -> Set b
  map f s = Prim (S.map f (run s))
  
  foldr :: (Hashable a, Eq a) => (a -> b -> b) -> b -> Set a -> b
  foldr f z s = S.foldr f z (run s)
  
  fold :: (Hashable a, Eq a) => (a -> b -> b) -> b -> Set a -> b
  fold f z s = S.foldr f z (run s)
  
  foldl' :: (Hashable a, Eq a) => (b -> a -> b) -> b -> Set a -> b
  foldl' f z s = S.foldl' f z (run s)
  
  toList :: (Hashable a, Eq a) => Set a -> [a]
  toList = S.toList . run
  
  fromList :: (Hashable a, Eq a) => [a] -> Set a
  fromList as = Prim (S.fromList as)
  
  findMin :: (Ord a, Hashable a) => Set a -> a
  findMin = minimum . toList
  
  maybeMin :: (Ord a, Hashable a) => Set a -> Maybe a
  maybeMin as
    | size as == 0 = Nothing
    | otherwise    = Just $ findMin as
  
  -}
  
  