@@ -0,0 +1,67 @@
1+{-# LANGUAGE DeriveGeneric, DeriveAnyClass, OverloadedStrings #-}
2+--this example shows how to implement a non-generics-defined Tupleable instance which is required in scenarios where Haskell-side types are not supported server-side or where one wishes to represent a nested relation
3+import ProjectM36.Client
4+import ProjectM36.Tuple
5+import ProjectM36.Tupleable
6+import ProjectM36.Relation
7+import ProjectM36.Atom
8+import ProjectM36.Attribute as A
9+import qualified Data.Set as S
10+import qualified Data.Map as M
11+import Data.Text (Text)
12+import GHC.Generics
13+import Data.Proxy
14+
15+--in this contrived example, we wish to represent one relation with a nested relation of comments
16+data Blog = Blog {
17+ title :: Text,
18+ comments :: S.Set Comment
19+ } deriving (Show)
20+
21+data Comment = Comment {
22+ authorName :: Text,
23+ comment :: Text
24+ } deriving (Eq, Show, Generic, Ord)
25+
26+instance Tupleable Comment
27+
28+instance Tupleable Blog where
29+ toTuple blogentry =
30+ mkRelationTupleFromMap (M.fromList [("title", TextAtom (title blogentry)),
31+ ("comments", RelationAtom relFromComments)])
32+ where
33+ commentTuples = map toTuple (S.toList (comments blogentry))
34+ relFromComments = case mkRelationFromTuples (toAttributes (Proxy :: Proxy Comment)) commentTuples of
35+ Left err -> error (show err)
36+ Right rel -> rel
37+
38+ fromTuple tupIn = do
39+ titleAtom <- atomForAttributeName "title" tupIn
40+ commentsAtom <- atomForAttributeName "comments" tupIn
41+ commentsRel <- relationForAtom commentsAtom
42+ comments' <- mapM fromTuple (tuplesList commentsRel)
43+ pure Blog {
44+ title = atomToText titleAtom,
45+ comments = S.fromList comments'}
46+
47+ toAttributes _ = A.attributesFromList [Attribute "title" TextAtomType,
48+ Attribute "comments" $ RelationAtomType (toAttributes (Proxy :: Proxy Comment))]
49+
50+main :: IO ()
51+main = do
52+ let exampleBlog = Blog { title = "Cat Pics",
53+ comments = S.fromList [Comment {authorName = "Steve",
54+ comment = "great"},
55+ Comment {authorName = "Bob",
56+ comment = "enough"}
57+ ]}
58+ print (toTuple exampleBlog)
59+ print (fromTuple (toTuple exampleBlog) :: Either RelationalError Blog)
60+
61+
62+
63+
64+
65+
66+
67+