content: {-# LANGUAGE DeriveAnyClass,DeriveGeneric #-}
  module Hospital where
  
  import ProjectM36.Client
  import ProjectM36.Atom
  import Data.Typeable
  import ProjectM36.Relation
  import Data.Binary
  import Control.DeepSeq
  import Data.Text
  import GHC.Generics
  import Data.Hashable
  import ProjectM36.Tuple
  
  data AgeType = PreciseAge Int |
                 ForgotToAsk |
                 RefusedToDisclose |
                 NotApplicable |
                 ApproximateAge Int Int
               deriving (Eq,Show,Read,Hashable,Binary,Typeable,NFData,Generic)
                        
  instance Atomable AgeType
  
  failFastMaybe :: (Show a) => Maybe a -> IO ()
  failFastMaybe (Just err) = error (show err)
  failFastMaybe Nothing = return ()
  
  failFastEither :: Show a => Either a b -> IO b
  failFastEither (Left err) = error (show err)
  failFastEither (Right val) = return val
  
  ageAtomType :: AtomType
  ageAtomType = atomTypeForProxy (Proxy :: Proxy AgeType)
                 
  runExample :: IO ()
  runExample = do
    let bob_relation_attrs = attributesFromList [Attribute "name" stringAtomType,
                                                 Attribute "age" ageAtomType]
        relvar_name = "hospital_patient"
        age_value_in = ApproximateAge 30 40 
        bob_relation_err = mkRelationFromList 
                       bob_relation_attrs 
                       [[Atom ("Bob"::Text), Atom age_value_in]]
  
    connerr <- connectProjectM36 (InProcessConnectionInfo NoPersistence)
    conn <- failFastEither connerr
    bob_relation <- failFastEither bob_relation_err
    merr <- executeDatabaseContextExpr conn (Assign relvar_name (ExistingRelation bob_relation))
    failFastMaybe merr
    result_err <- executeRelationalExpr conn (RelationVariable relvar_name)
    result <- failFastEither result_err
    case singletonTuple result of
      Nothing -> error "not a singleton relation!"
      Just tuple -> do
        (Atom age_value_out) <- failFastEither $ atomForAttributeName "age" tuple
        print age_value_in
        print age_value_out
        case cast age_value_out of
          Nothing -> error "wrong datatype"
          Just age_value_out' -> 
            print (age_value_in == age_value_out')
        
              
  