content: {-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TemplateHaskell, TypeFamilies #-}
  module Clckwrks.ProfileData.Types
       ( DisplayName(..)
       , ProfileData(..)
       , Role(..)
       , defaultProfileDataFor
       , emptyProfileData
       , Username(..)
       ) where
  
  import Data.Data     (Data, Typeable)
  import Data.IxSet    (Indexable(..), ixSet, ixFun)
  import Data.IxSet.Ix (Ix)
  import Data.Map      (Map, empty)
  import Data.SafeCopy (Migrate(..), base, deriveSafeCopy, extension)
  import Data.Set      (Set, empty, singleton)
  import Data.Text     (Text, empty)
  import Data.Typeable (Typeable)
  import Data.UserId   (UserId(..))
  import GHC.Generics  (Generic)
  
  data Role_001
      = Administrator_001
      | Visitor_001
        deriving (Eq, Ord, Read, Show, Data, Typeable, Enum, Bounded, Generic)
  $(deriveSafeCopy 1 'base ''Role_001)
  
  data Role
      = Administrator
      | Visitor
      | Moderator
      | Editor
        deriving (Eq, Ord, Read, Show, Data, Typeable, Enum, Bounded, Generic)
  $(deriveSafeCopy 2 'extension ''Role)
  
  instance Migrate Role where
      type MigrateFrom Role = Role_001
      migrate Administrator_001 = Administrator
      migrate Visitor_001       = Visitor
  
  newtype Username = Username { unUsername :: Text }
      deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
  
  newtype DisplayName = DisplayName { unDisplayName :: Text }
      deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
  $(deriveSafeCopy 1 'base ''DisplayName)
  
  data ProfileData_1 = ProfileData_1
      { dataFor_1    :: UserId
      , username_1   :: Text       -- ^ now comes from happstack-authenticate
      , email_1      :: Maybe Text -- ^ now comes from happstack-authenticate
      , roles_1      :: Set Role
      , attributes_1 :: Map Text Text
      }
      deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
  
  $(deriveSafeCopy 1 'base ''ProfileData_1)
  
  data ProfileData_2 = ProfileData_2
      { dataFor_2    :: UserId
      , roles_2      :: Set Role
      , attributes_2 :: Map Text Text
      }
      deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
  
  $(deriveSafeCopy 2 'extension ''ProfileData_2)
  
  instance Migrate ProfileData_2 where
    type MigrateFrom ProfileData_2 = ProfileData_1
    migrate (ProfileData_1 df _ _ rs attrs) = ProfileData_2 df rs attrs
  
  data ProfileData = ProfileData
      { dataFor     :: UserId
      , displayName :: Maybe DisplayName
      , roles       :: Set Role
      , attributes  :: Map Text Text
      }
      deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
  
  $(deriveSafeCopy 3 'extension ''ProfileData)
  
  instance Migrate ProfileData where
    type MigrateFrom ProfileData = ProfileData_2
    migrate (ProfileData_2 df rs attrs) = ProfileData df Nothing rs attrs
  
  emptyProfileData :: ProfileData
  emptyProfileData = ProfileData
     { dataFor     = UserId 0
     , displayName = Nothing
     , roles       = Data.Set.empty
     , attributes  = Data.Map.empty
     }
  
  defaultProfileDataFor :: UserId -> ProfileData
  defaultProfileDataFor uid =
    emptyProfileData { dataFor = uid
                     , roles   = singleton Visitor
                     }
  
  instance Indexable ProfileData where
      empty = ixSet [ ixFunS dataFor
                    ]
          where
            ixFunS :: (Ord b, Typeable b) => (a -> b) -> Ix a
            ixFunS f = ixFun $ \a -> [f a]
  