content: {-# LANGUAGE CPP #-}
  import System.Exit
  import Test.HUnit
  #ifdef PM36_HASKELL_SCRIPTING
  import TutorialD.Interpreter.TestBase
  import ProjectM36.Client
  import ProjectM36.Relation
  import qualified Data.Text as T
  #endif
  
  main :: IO ()
  main = do
    tcounts <- runTestTT (TestList [
  #ifdef PM36_HASKELL_SCRIPTING
      testBasicDBCFunction,
      testErrorDBCFunction,
      testExceptionDBCFunction,
      testDBCFunctionWithAtomArguments
  #endif                                  
                                    ])
    if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
  
  #ifdef PM36_HASKELL_SCRIPTING
  testBasicDBCFunction :: Test
  testBasicDBCFunction = TestCase $ do  
    (sess, conn) <- dateExamplesConnection emptyNotificationCallback
    let addfunc = "adddatabasecontextfunction \"addTrue2\" DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext  \"\"\"(\\[] ctx -> executeDatabaseContextExpr (Assign \"true2\" (ExistingRelation relationTrue)) ctx) :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""
    executeTutorialD sess conn addfunc
    executeTutorialD sess conn "execute addTrue2()"
    {-
    let true2Expr = RelationVariable "true2" ()
    result <- executeRelationalExpr sess conn true2Expr
    assertEqual "simple atom function equality" (Right relationTrue) result-}
  
  testErrorDBCFunction :: Test
  testErrorDBCFunction = TestCase $ do
    (sess, conn) <- dateExamplesConnection emptyNotificationCallback  
    let addfunc = "adddatabasecontextfunction \"retErr\" DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext \"\"\"(\\[] ctx -> Left (DatabaseContextFunctionUserError \"err\")) :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""
    executeTutorialD sess conn addfunc
    expectTutorialDErr sess conn (T.isPrefixOf "DatabaseContextFunctionUserError (DatabaseContextFunctionUserError \"err\")") "execute retErr()"
    
  testExceptionDBCFunction :: Test
  testExceptionDBCFunction = TestCase $ do
    -- throw an error, make sure it is caught- it might not be caught, for example, if the function is not forced
    (sess, conn) <- dateExamplesConnection emptyNotificationCallback
    let addfunc = "adddatabasecontextfunction \"bomb\" DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext \"\"\"(\\[] _ -> error \"boom\") :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""
    executeTutorialD sess conn addfunc
    expectTutorialDErr sess conn ("UnhandledExceptionError" `T.isPrefixOf`) "execute bomb()"
    
  
  testDBCFunctionWithAtomArguments :: Test
  testDBCFunctionWithAtomArguments = TestCase $ do
    --test function with creation of a relvar with some arguments
    (sess, conn) <- dateExamplesConnection emptyNotificationCallback
    let addfunc = "adddatabasecontextfunction \"multiArgFunc\" Integer -> Text -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext \"\"\"(\\(age:name:_) ctx -> executeDatabaseContextExpr (Assign \"person\" (MakeRelationFromExprs Nothing [TupleExpr (fromList [(\"name\", NakedAtomExpr name), (\"age\", NakedAtomExpr age)])])) ctx) :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""
    executeTutorialD sess conn addfunc
    executeTutorialD sess conn "execute multiArgFunc(30,\"Steve\")"
    result <- executeRelationalExpr sess conn (RelationVariable "person" ())
    let expectedPerson = mkRelationFromList (attributesFromList [Attribute "name" TextAtomType,
                                                                 Attribute "age" IntegerAtomType]) [
          [TextAtom "Steve", IntegerAtom 30]]
    assertEqual "person relation" expectedPerson result
    expectTutorialDErr sess conn (T.isPrefixOf "AtomTypeMismatchError") "execute multiArgFunc(\"fail\", \"fail\")"
  
  #endif
  