packages feed

ampersand-3.0.3: src/Database/Design/Ampersand/Basics/Unique.hs

{-# LANGUAGE DeriveDataTypeable #-}
module Database.Design.Ampersand.Basics.Unique 
  (Unique(..),Named(..))
where
import Data.Typeable
import Data.List
import Data.Char
import Database.Design.Ampersand.Basics.Version

fatal :: Int -> String -> a
fatal = fatalMsg "Unique"

-- | anything could have some label, can't it?
class Named a where
  name :: a->String

-- | In the context of the haskell code, things can be Unique. 
class (Typeable e, Eq e) => Unique e where 
  -- | a representation of a unique thing
  self :: e -> UniqueObj e
  self a = UniqueObj { theThing = a
                     , theShow  = showUnique
                     }
  -- | representation of a Unique thing into a string.  
  uniqueShow :: Bool ->  --  Should the type show too? 
              e    ->  --  the thing to show
              String
  uniqueShow includeType x = typePrefix ++ (showUnique . theThing . self) x
    where
      typePrefix = if includeType then show $ typeOf x else ""
  -- | A function to show a unique instance. It is the responsability
  --   of the instance definition to make sure that for every a, b of 
  --   an individual type:
  --        a == b  <==> showUnique a == showUnique b
  showUnique :: e -> String
  {-# MINIMAL showUnique #-}
  

-- | this is the implementation of the abstract data type. It mustn't be exported
data UniqueObj a = 
       UniqueObj { theThing :: a
                 , theShow  :: (a -> String)
                 } deriving (Typeable)

instance Unique a => Unique [a] where
   showUnique [] = fatal 74 $ "empty list is not unique"
   showUnique xs = "["++intercalate ", " (map showUnique xs)++"]"

instance Unique Bool where
 showUnique = map toLower . show