git.iko.soy/project-m36
on master help sign in
fix examples broken by refactoring
415eb12AgentM
examples/SimpleClient.hs+1−1
compare with master
unifiedsplit
@@ -12,7 +12,7 @@ main = do
12 Left err -> putStrLn (show err)
12 Left err -> putStrLn (show err)
13 Right conn -> do
13 Right conn -> do
14 --3. create a session on the "master" branch
14 --3. create a session on the "master" branch
15− eSessionId <- createSessionAtHead "master" conn
15+ eSessionId <- createSessionAtHead conn "master"
16 case eSessionId of
16 case eSessionId of
17 Left err -> putStrLn (show err)
17 Left err -> putStrLn (show err)
18 Right sessionId -> do
18 Right sessionId -> do
examples/hair.hs+3−6
@@ -23,17 +23,14 @@ main = do
23 conn <- eCheck $ connectProjectM36 connInfo
23 conn <- eCheck $ connectProjectM36 connInfo
24
24
25 --create a database session at the default branch of the fresh database
25 --create a database session at the default branch of the fresh database
26− sessionId <- eCheck $ createSessionAtHead "master" conn
26+ sessionId <- eCheck $ createSessionAtHead conn "master"
27
27
28− let mCheck v = v >>= \x -> case x of
29− Just err -> error (show err)
30− Nothing -> pure ()
31 --create the data type in the database context
28 --create the data type in the database context
32− mCheck $ executeDatabaseContextExpr sessionId conn (toDatabaseContextExpr (undefined :: Hair))
29+ eCheck $ executeDatabaseContextExpr sessionId conn (toDatabaseContextExpr (undefined :: Hair))
33
30
34 --create a relation with the new Hair AtomType
31 --create a relation with the new Hair AtomType
35 let blond = NakedAtomExpr (toAtom Blond)
32 let blond = NakedAtomExpr (toAtom Blond)
36− mCheck $ executeDatabaseContextExpr sessionId conn (Assign "people" (MakeRelationFromExprs Nothing [
33+ eCheck $ executeDatabaseContextExpr sessionId conn (Assign "people" (MakeRelationFromExprs Nothing [
37 TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))
34 TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))
38
35
39 let restrictionPredicate = AttributeEqualityPredicate "hair" blond
36 let restrictionPredicate = AttributeEqualityPredicate "hair" blond
examples/out_of_the_tarpit.hs+6−6
@@ -3,7 +3,7 @@
3import ProjectM36.Client
3import ProjectM36.Client
4import ProjectM36.DataTypes.Primitive
4import ProjectM36.DataTypes.Primitive
5import qualified Data.Map as M
5import qualified Data.Map as M
6−import Data.Maybe
6+import Data.Either
7import Control.Monad
7import Control.Monad
8import GHC.Generics
8import GHC.Generics
9import Data.Binary
9import Data.Binary
@@ -57,7 +57,7 @@ main = do
57 let conn = check eConn
57 let conn = check eConn
58
58
59 --create a database session at the default branch of the fresh database
59 --create a database session at the default branch of the fresh database
60− eSessionId <- createSessionAtHead "master" conn
60+ eSessionId <- createSessionAtHead conn "master"
61 let sessionId = check eSessionId
61 let sessionId = check eSessionId
62
62
63 createSchema sessionId conn
63 createSchema sessionId conn
@@ -141,10 +141,10 @@ createSchema sessionId conn = do
141 createScriptedAtomFunction "datesToSpeedBand" [dayTypeConstructor, dayTypeConstructor] (ADTypeConstructor "SpeedBand" []) speedBandScript
141 createScriptedAtomFunction "datesToSpeedBand" [dayTypeConstructor, dayTypeConstructor] (ADTypeConstructor "SpeedBand" []) speedBandScript
142 ]
142 ]
143 --gather up and execute all database updates
143 --gather up and execute all database updates
144− mErrs <- mapM (executeDatabaseContextExpr sessionId conn) (new_adts ++ rvDefs ++ incDepKeys ++ incDepForeignKeys)
144+ eErrs <- mapM (executeDatabaseContextExpr sessionId conn) (new_adts ++ rvDefs ++ incDepKeys ++ incDepForeignKeys)
145− let errs = catMaybes mErrs
145+ let errs = lefts eErrs
146 when (length errs > 0) (error (show errs))
146 when (length errs > 0) (error (show errs))
147
147
148− mErrs' <- mapM (executeDatabaseContextIOExpr sessionId conn) atomFuncs
148+ eErrs' <- mapM (executeDatabaseContextIOExpr sessionId conn) atomFuncs
149− let errs' = catMaybes mErrs'
149+ let errs' = lefts eErrs'
150 when (length errs' > 0) (error (show errs'))
150 when (length errs' > 0) (error (show errs'))