


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

-- {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}

-- |
-- Copyright :  (c) Andreas Reuleaux 2015
-- License   :  BSD2
-- Maintainer:  Andreas Reuleaux <rx@a-rx.info>
-- Stability :  experimental
-- Portability: non-portable
--
-- This module provides Pire's syntax,
-- ie. Pire's flavour of Pi-forall syntax: constructor names



module Pire.Syntax.ConstructorNames where


import qualified Data.Text as T

import qualified Data.Set as S


#ifdef MIN_VERSION_GLASGOW_HASKELL
#if MIN_VERSION_GLASGOW_HASKELL(7,10,3,0)
-- ghc >= 7.10.3
#else
-- older ghc versions, but MIN_VERSION_GLASGOW_HASKELL defined
#endif
#else
-- MIN_VERSION_GLASGOW_HASKELL not even defined yet (ghc <= 7.8.x)
import Data.Foldable
import Data.Traversable
import Control.Applicative
-- import Data.Monoid
#endif




-- import Data.Functor
-- import Control.Applicative

-- traversal for Sets (despite the missing Ord constraint)
-- http://stackoverflow.com/questions/13730439/mapm-for-data-set-in-haskell

import Control.Lens.Traversal
-- import Data.Set.Lens
-- import Control.Lens.Setter
-- import Control.Lens.Lens
-- import Control.Lens


-- import Data.Traversable (traverse)
import Data.Set (Set)
-- import qualified Data.Set as Set



-- forall f. Applicative f => (a -> f b) -> Set a -> f (Set b)

setTraversal :: (Ord b) => Traversal (Set a) (Set b) a b
setTraversal f = (fmap S.fromList) . traverse f . S.toList



-- data ConstructorNames a = ConstructorNames
--                           { _tconNames :: S.Set a
--                           , _dconNames :: S.Set a
--                             }
--                         deriving (Show, Eq, Read, Ord, Foldable)

-- makeLenses ''ConstructorNames




data ConstructorNames a = ConstructorNames {
  tconNames :: S.Set a
  , dconNames :: S.Set a
  }
                        deriving (Show, Eq, Read, Ord, Foldable)



poorMansTraverse :: (Applicative f, Ord b)
                    => (a -> f b) -> ConstructorNames a -> f (ConstructorNames b)

poorMansTraverse f (ConstructorNames tcons dcons) =
  ConstructorNames <$> (setTraversal f tcons) <*> (setTraversal f dcons)
  
  



-- | empty set of constructor names
emptyConstructorNames :: ConstructorNames T.Text
emptyConstructorNames = ConstructorNames S.empty S.empty


