git.iko.soy/denis
on master help sign in
Resolved #1
da4afd7iko
denis/src/Data/Post.hs+8−4
compare with master
unifiedsplit
@@ -84,13 +84,17 @@ postToRow :: Post -> PostRow
84postToRow (PostData pId aId _) = PostRow pId aId
84postToRow (PostData pId aId _) = PostRow pId aId
85
85
86postToElementRows :: PostData p -> [ElementRow (PostData p)]
86postToElementRows :: PostData p -> [ElementRow (PostData p)]
87−postToElementRows (PostData pId _ pb) = elementsToRows pId pb
87+postToElementRows (PostData pId uId pb) = elementsToRows pId uId pb
88
88
89−rowsToPost :: M.Map Int64 [ElementRow PostQuote] -> M.Map Int64 PostQuoteRow -> PostRow -> [ElementRow (PostData p)] -> Maybe (PostData p)
89+rowsToPost :: M.Map Int64 [ElementRow PostQuote] -> M.Map Int64 PostQuoteRow -> [ElementRow (PostData p)] -> Maybe (PostData p)
90+rowsToPost erqs pqrs [] = Nothing
91+rowsToPost erqs pqrs elementRows = let
92+ pId = rowElementId . head $ elementRows
93+ uId = rowElementAuthorId . head $ elementRows
90−rowsToPost erqs pqrs (PostRow pId aId) elementRows = PostData pId aId <$> rowsToElements erqs pqrs elementRows
94+ in PostData pId uId <$> rowsToElements erqs pqrs elementRows
91
95
92fromDraft :: PostId -> ElementRow Draft -> ElementRow Post
96fromDraft :: PostId -> ElementRow Draft -> ElementRow Post
93−fromDraft pId (ElementRow _ b c d e f g) = ElementRow pId b c d e f g
97+fromDraft pId (ElementRow _ uId b c d e f g) = ElementRow pId uId b c d e f g
94
98
95-- tupleFirst :: (a -> b) -> a -> (b, a)
99-- tupleFirst :: (a -> b) -> a -> (b, a)
96-- tupleFirst f a = (f a, a)
100-- tupleFirst f a = (f a, a)
denis/src/Data/PostElement.hs+7−6
@@ -48,6 +48,7 @@ data PostElement a = Markdown Text
48
48
49data ElementRow a = ElementRow {
49data ElementRow a = ElementRow {
50 rowElementId :: Int64, -- the source id
50 rowElementId :: Int64, -- the source id
51+ rowElementAuthorId :: Int64,
51 rowElementOrd :: Int64,
52 rowElementOrd :: Int64,
52 rowElementMarkdown :: Maybe Text,
53 rowElementMarkdown :: Maybe Text,
53 rowElementLatex :: Maybe Text,
54 rowElementLatex :: Maybe Text,
@@ -82,16 +83,16 @@ rowsToElements :: M.Map Int64 [ElementRow PostQuote] -> M.Map Int64 PostQuoteRow
82rowsToElements erqs pqrs = traverse elementRowToElement . sortBy (compare `on` rowElementOrd)
83rowsToElements erqs pqrs = traverse elementRowToElement . sortBy (compare `on` rowElementOrd)
83 where
84 where
84 elementRowToElement :: ElementRow a -> Maybe (PostElement a)
85 elementRowToElement :: ElementRow a -> Maybe (PostElement a)
85− elementRowToElement (ElementRow _ _ (Just m) Nothing Nothing Nothing Nothing) = Just $ Markdown m
86+ elementRowToElement (ElementRow _ _ _ (Just m) Nothing Nothing Nothing Nothing) = Just $ Markdown m
86− elementRowToElement (ElementRow _ _ Nothing (Just l) Nothing Nothing Nothing) = Just $ Latex l
87+ elementRowToElement (ElementRow _ _ _ Nothing (Just l) Nothing Nothing Nothing) = Just $ Latex l
87− elementRowToElement (ElementRow _ _ Nothing Nothing (Just i) Nothing Nothing) = Just $ Image i
88+ elementRowToElement (ElementRow _ _ _ Nothing Nothing (Just i) Nothing Nothing) = Just $ Image i
88 -- elementRowToElement (ElementRow _ _ Nothing Nothing Nothing (Just q) Nothing) =
89 -- elementRowToElement (ElementRow _ _ Nothing Nothing Nothing (Just q) Nothing) =
89 -- fmap Quote $ M.lookup q pqrs >>= rowsToQuote erqs pqrs
90 -- fmap Quote $ M.lookup q pqrs >>= rowsToQuote erqs pqrs
90− elementRowToElement (ElementRow _ _ Nothing Nothing Nothing Nothing (Just a)) = Just $ Attachment a
91+ elementRowToElement (ElementRow _ _ _ Nothing Nothing Nothing Nothing (Just a)) = Just $ Attachment a
91 elementRowToElement _ = Nothing
92 elementRowToElement _ = Nothing
92
93
93−elementsToRows :: Int64 -> [PostElement p] -> [ElementRow p]
94+elementsToRows :: Int64 -> Int64 -> [PostElement p] -> [ElementRow p]
94−elementsToRows pId pb = map (uncurry finish) $ flip zip pb $ ElementRow pId <$> [0..]
95+elementsToRows pId uId pb = map (uncurry finish) $ flip zip pb $ ElementRow pId uId <$> [0..]
95 where finish :: (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Int64 -> Maybe Text -> ElementRow p) -> PostElement p -> ElementRow p
96 where finish :: (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Int64 -> Maybe Text -> ElementRow p) -> PostElement p -> ElementRow p
96 finish f pe = case pe of
97 finish f pe = case pe of
97 Markdown m -> f (Just m) Nothing Nothing Nothing Nothing
98 Markdown m -> f (Just m) Nothing Nothing Nothing Nothing
denis/src/Data/Query.hs+18−18
@@ -69,9 +69,8 @@ getDraftElementsQ = selectStar $ from (table #draftElements) & where_ (#rowEleme
69
69
70getPost :: PostId -> StaticPQ (Maybe Post)
70getPost :: PostId -> StaticPQ (Maybe Post)
71getPost pId = do
71getPost pId = do
72− postRow <- runQueryParams getPostRowQ (Only pId) >>= getRow 0
73 postRowElements <- runQueryParams getPostElementsQ (Only pId) >>= getRows
72 postRowElements <- runQueryParams getPostElementsQ (Only pId) >>= getRows
74− return $ rowsToPost M.empty M.empty postRow postRowElements
73+ return $ rowsToPost M.empty M.empty postRowElements
75
74
76getLastPostRowsQ :: Word64 -> Query Schema '[] (RowPG (Only PostId))
75getLastPostRowsQ :: Word64 -> Query Schema '[] (RowPG (Only PostId))
77getLastPostRowsQ n = select (#postRowId `as` #fromOnly) $
76getLastPostRowsQ n = select (#postRowId `as` #fromOnly) $
@@ -103,28 +102,30 @@ createPostRowQ = insertRow #posts
103createDraftElementRowsQ :: Manipulation Schema (TuplePG (ElementRow Draft)) '[]
102createDraftElementRowsQ :: Manipulation Schema (TuplePG (ElementRow Draft)) '[]
104createDraftElementRowsQ = insertRow_ #draftElements
103createDraftElementRowsQ = insertRow_ #draftElements
105 (Set (param @1) `as` #rowElementId :*
104 (Set (param @1) `as` #rowElementId :*
105+ Set (param @2) `as` #rowElementAuthorId :*
106− Set (param @2) `as` #rowElementOrd :*
106+ Set (param @3) `as` #rowElementOrd :*
107− Set (param @3) `as` #rowElementMarkdown :*
107+ Set (param @4) `as` #rowElementMarkdown :*
108− Set (param @4) `as` #rowElementLatex :*
108+ Set (param @5) `as` #rowElementLatex :*
109− Set (param @5) `as` #rowElementImage :*
109+ Set (param @6) `as` #rowElementImage :*
110− Set (param @6) `as` #rowElementQuote :*
110+ Set (param @7) `as` #rowElementQuote :*
111− Set (param @7) `as` #rowElementAttachment)
111+ Set (param @8) `as` #rowElementAttachment)
112
112
113createPostElementRowsQ :: Manipulation Schema (TuplePG (ElementRow Post)) '[]
113createPostElementRowsQ :: Manipulation Schema (TuplePG (ElementRow Post)) '[]
114createPostElementRowsQ = insertRow_ #postElements
114createPostElementRowsQ = insertRow_ #postElements
115 (Set (param @1) `as` #rowElementId :*
115 (Set (param @1) `as` #rowElementId :*
116+ Set (param @2) `as` #rowElementAuthorId :*
116− Set (param @2) `as` #rowElementOrd :*
117+ Set (param @3) `as` #rowElementOrd :*
117− Set (param @3) `as` #rowElementMarkdown :*
118+ Set (param @4) `as` #rowElementMarkdown :*
118− Set (param @4) `as` #rowElementLatex :*
119+ Set (param @5) `as` #rowElementLatex :*
119− Set (param @5) `as` #rowElementImage :*
120+ Set (param @6) `as` #rowElementImage :*
120− Set (param @6) `as` #rowElementQuote :*
121+ Set (param @7) `as` #rowElementQuote :*
121− Set (param @7) `as` #rowElementAttachment)
122+ Set (param @8) `as` #rowElementAttachment)
122
123
123createDraft :: UserId -> [PostElement Draft] -> StaticPQ Draft
124createDraft :: UserId -> [PostElement Draft] -> StaticPQ Draft
124createDraft uId els = transactionally_ $ do
125createDraft uId els = transactionally_ $ do
125 dId' <- manipulateParams createDraftRowQ (Only uId)
126 dId' <- manipulateParams createDraftRowQ (Only uId)
126 dId <- lift $ fromOnly <$> getRow 0 dId'
127 dId <- lift $ fromOnly <$> getRow 0 dId'
127− traversePrepared_ createDraftElementRowsQ $ elementsToRows dId els
128+ traversePrepared_ createDraftElementRowsQ $ elementsToRows dId uId els
128 return $ mkDraft dId uId els
129 return $ mkDraft dId uId els
129
130
130getDraftsForUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG (Only DraftId))
131getDraftsForUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG (Only DraftId))
@@ -147,9 +148,8 @@ getPostsForUser lim uId = do
147
148
148getDraft :: DraftId -> StaticPQ (Maybe Draft)
149getDraft :: DraftId -> StaticPQ (Maybe Draft)
149getDraft dId = do
150getDraft dId = do
150− draftRow <- runQueryParams getDraftRowQ (Only dId) >>= getRow 0
151 draftRowElements <- runQueryParams getDraftElementsQ (Only dId) >>= getRows
151 draftRowElements <- runQueryParams getDraftElementsQ (Only dId) >>= getRows
152− return $ rowsToPost M.empty M.empty draftRow draftRowElements
152+ return $ rowsToPost M.empty M.empty draftRowElements
153
153
154getDrafts :: UserId -> StaticPQ [Draft]
154getDrafts :: UserId -> StaticPQ [Draft]
155getDrafts uId = do
155getDrafts uId = do
@@ -175,7 +175,7 @@ updateDraft uId dId els = transactionally_ $ do
175 lift $ S.throwError S.err404
175 lift $ S.throwError S.err404
176 else do
176 else do
177 _ <- manipulateParams deleteElementsForIdQ (Only dId)
177 _ <- manipulateParams deleteElementsForIdQ (Only dId)
178− traversePrepared_ createDraftElementRowsQ $ elementsToRows dId els
178+ traversePrepared_ createDraftElementRowsQ $ elementsToRows dId uId els
179
179
180getDraftElementRowsQ :: Query Schema (TuplePG (Only DraftId)) (RowPG (ElementRow Draft))
180getDraftElementRowsQ :: Query Schema (TuplePG (Only DraftId)) (RowPG (ElementRow Draft))
181getDraftElementRowsQ = selectStar $
181getDraftElementRowsQ = selectStar $
denis/src/Data/Schema.hs+12
@@ -47,12 +47,14 @@ type Schema =
47 "postElements" ::: 'Table (
47 "postElements" ::: 'Table (
48 '[
48 '[
49 "fk_post_quote_self_id" ::: 'ForeignKey '["rowElementId"] "posts" '["postRowId"],
49 "fk_post_quote_self_id" ::: 'ForeignKey '["rowElementId"] "posts" '["postRowId"],
50+ "fk_post_element_user_id" ::: 'ForeignKey '["rowElementAuthorId"] "users" '["userId"],
50 "fk_post_quote_id" ::: 'ForeignKey '["rowElementQuote"] "quotes" '["quoteRowId"]
51 "fk_post_quote_id" ::: 'ForeignKey '["rowElementQuote"] "quotes" '["quoteRowId"]
51 -- ,
52 -- ,
52 -- "unique_post_quote" ::: 'Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"]
53 -- "unique_post_quote" ::: 'Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"]
53 ] :=>
54 ] :=>
54 '[
55 '[
55 "rowElementId" ::: 'NoDef :=> 'NotNull 'PGint8,
56 "rowElementId" ::: 'NoDef :=> 'NotNull 'PGint8,
57+ "rowElementAuthorId" ::: 'NoDef :=> 'NotNull 'PGint8,
56 "rowElementOrd" ::: 'NoDef :=> 'NotNull 'PGint8,
58 "rowElementOrd" ::: 'NoDef :=> 'NotNull 'PGint8,
57 "rowElementMarkdown" ::: 'NoDef :=> 'Null 'PGtext,
59 "rowElementMarkdown" ::: 'NoDef :=> 'Null 'PGtext,
58 "rowElementLatex" ::: 'NoDef :=> 'Null 'PGtext,
60 "rowElementLatex" ::: 'NoDef :=> 'Null 'PGtext,
@@ -63,12 +65,14 @@ type Schema =
63 "quoteElements" ::: 'Table (
65 "quoteElements" ::: 'Table (
64 '[
66 '[
65 "fk_quotes_quote_self_id" ::: 'ForeignKey '["rowElementId"] "quotes" '["quoteRowId"],
67 "fk_quotes_quote_self_id" ::: 'ForeignKey '["rowElementId"] "quotes" '["quoteRowId"],
68+ "fk_quote_element_user_id" ::: 'ForeignKey '["rowElementAuthorId"] "users" '["userId"],
66 "fk_quote_quote_id" ::: 'ForeignKey '["rowElementQuote"] "quotes" '["quoteRowId"]
69 "fk_quote_quote_id" ::: 'ForeignKey '["rowElementQuote"] "quotes" '["quoteRowId"]
67 -- ,
70 -- ,
68 -- "unique_quote_quote" ::: 'Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"]
71 -- "unique_quote_quote" ::: 'Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"]
69 ] :=>
72 ] :=>
70 '[
73 '[
71 "rowElementId" ::: 'NoDef :=> 'NotNull 'PGint8,
74 "rowElementId" ::: 'NoDef :=> 'NotNull 'PGint8,
75+ "rowElementAuthorId" ::: 'NoDef :=> 'NotNull 'PGint8,
72 "rowElementOrd" ::: 'NoDef :=> 'NotNull 'PGint8,
76 "rowElementOrd" ::: 'NoDef :=> 'NotNull 'PGint8,
73 "rowElementMarkdown" ::: 'NoDef :=> 'Null 'PGtext,
77 "rowElementMarkdown" ::: 'NoDef :=> 'Null 'PGtext,
74 "rowElementLatex" ::: 'NoDef :=> 'Null 'PGtext,
78 "rowElementLatex" ::: 'NoDef :=> 'Null 'PGtext,
@@ -79,12 +83,14 @@ type Schema =
79 "draftElements" ::: 'Table (
83 "draftElements" ::: 'Table (
80 '[
84 '[
81 "fk_draft_quote_self_id" ::: 'ForeignKey '["rowElementId"] "drafts" '["postRowId"],
85 "fk_draft_quote_self_id" ::: 'ForeignKey '["rowElementId"] "drafts" '["postRowId"],
86+ "fk_draft_element_user_id" ::: 'ForeignKey '["rowElementAuthorId"] "users" '["userId"],
82 "fk_draft_quote_id" ::: 'ForeignKey '["rowElementQuote"] "quotes" '["quoteRowId"]
87 "fk_draft_quote_id" ::: 'ForeignKey '["rowElementQuote"] "quotes" '["quoteRowId"]
83 -- ,
88 -- ,
84 -- "unique_post_quote" ::: 'Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"]
89 -- "unique_post_quote" ::: 'Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"]
85 ] :=>
90 ] :=>
86 '[
91 '[
87 "rowElementId" ::: 'NoDef :=> 'NotNull 'PGint8,
92 "rowElementId" ::: 'NoDef :=> 'NotNull 'PGint8,
93+ "rowElementAuthorId" ::: 'NoDef :=> 'NotNull 'PGint8,
88 "rowElementOrd" ::: 'NoDef :=> 'NotNull 'PGint8,
94 "rowElementOrd" ::: 'NoDef :=> 'NotNull 'PGint8,
89 "rowElementMarkdown" ::: 'NoDef :=> 'Null 'PGtext,
95 "rowElementMarkdown" ::: 'NoDef :=> 'Null 'PGtext,
90 "rowElementLatex" ::: 'NoDef :=> 'Null 'PGtext,
96 "rowElementLatex" ::: 'NoDef :=> 'Null 'PGtext,
@@ -123,6 +129,7 @@ createTables = createTable #users (
123 foreignKey #postRowAuthorId #users #userId OnDeleteCascade OnUpdateCascade `as` #fk_draft_author_id
129 foreignKey #postRowAuthorId #users #userId OnDeleteCascade OnUpdateCascade `as` #fk_draft_author_id
124 ) >>> createTable #postElements (
130 ) >>> createTable #postElements (
125 notNullable int8 `as` #rowElementId :*
131 notNullable int8 `as` #rowElementId :*
132+ notNullable int8 `as` #rowElementAuthorId :*
126 notNullable int8 `as` #rowElementOrd :*
133 notNullable int8 `as` #rowElementOrd :*
127 nullable text `as` #rowElementMarkdown :*
134 nullable text `as` #rowElementMarkdown :*
128 nullable text `as` #rowElementLatex :*
135 nullable text `as` #rowElementLatex :*
@@ -131,9 +138,11 @@ createTables = createTable #users (
131 nullable text `as` #rowElementAttachment
138 nullable text `as` #rowElementAttachment
132 ) (
139 ) (
133 foreignKey #rowElementId #posts #postRowId OnDeleteCascade OnUpdateCascade `as` #fk_post_quote_self_id :*
140 foreignKey #rowElementId #posts #postRowId OnDeleteCascade OnUpdateCascade `as` #fk_post_quote_self_id :*
141+ foreignKey #rowElementAuthorId #users #userId OnDeleteCascade OnUpdateCascade `as` #fk_post_element_user_id :*
134 foreignKey #rowElementQuote #quotes #quoteRowId OnDeleteCascade OnUpdateCascade `as` #fk_post_quote_id
142 foreignKey #rowElementQuote #quotes #quoteRowId OnDeleteCascade OnUpdateCascade `as` #fk_post_quote_id
135 ) >>> createTable #quoteElements (
143 ) >>> createTable #quoteElements (
136 notNullable int8 `as` #rowElementId :*
144 notNullable int8 `as` #rowElementId :*
145+ notNullable int8 `as` #rowElementAuthorId :*
137 notNullable int8 `as` #rowElementOrd :*
146 notNullable int8 `as` #rowElementOrd :*
138 nullable text `as` #rowElementMarkdown :*
147 nullable text `as` #rowElementMarkdown :*
139 nullable text `as` #rowElementLatex :*
148 nullable text `as` #rowElementLatex :*
@@ -142,9 +151,11 @@ createTables = createTable #users (
142 nullable text `as` #rowElementAttachment
151 nullable text `as` #rowElementAttachment
143 ) (
152 ) (
144 foreignKey #rowElementId #quotes #quoteRowId OnDeleteCascade OnUpdateCascade `as` #fk_quotes_quote_self_id :*
153 foreignKey #rowElementId #quotes #quoteRowId OnDeleteCascade OnUpdateCascade `as` #fk_quotes_quote_self_id :*
154+ foreignKey #rowElementAuthorId #users #userId OnDeleteCascade OnUpdateCascade `as` #fk_quote_element_user_id :*
145 foreignKey #rowElementQuote #quotes #quoteRowId OnDeleteCascade OnUpdateCascade `as` #fk_quote_quote_id
155 foreignKey #rowElementQuote #quotes #quoteRowId OnDeleteCascade OnUpdateCascade `as` #fk_quote_quote_id
146 ) >>> createTable #draftElements (
156 ) >>> createTable #draftElements (
147 notNullable int8 `as` #rowElementId :*
157 notNullable int8 `as` #rowElementId :*
158+ notNullable int8 `as` #rowElementAuthorId :*
148 notNullable int8 `as` #rowElementOrd :*
159 notNullable int8 `as` #rowElementOrd :*
149 nullable text `as` #rowElementMarkdown :*
160 nullable text `as` #rowElementMarkdown :*
150 nullable text `as` #rowElementLatex :*
161 nullable text `as` #rowElementLatex :*
@@ -153,6 +164,7 @@ createTables = createTable #users (
153 nullable text `as` #rowElementAttachment
164 nullable text `as` #rowElementAttachment
154 ) (
165 ) (
155 foreignKey #rowElementId #drafts #postRowId OnDeleteCascade OnUpdateCascade `as` #fk_draft_quote_self_id :*
166 foreignKey #rowElementId #drafts #postRowId OnDeleteCascade OnUpdateCascade `as` #fk_draft_quote_self_id :*
167+ foreignKey #rowElementAuthorId #users #userId OnDeleteCascade OnUpdateCascade `as` #fk_draft_element_user_id :*
156 foreignKey #rowElementQuote #quotes #quoteRowId OnDeleteCascade OnUpdateCascade `as` #fk_draft_quote_id
168 foreignKey #rowElementQuote #quotes #quoteRowId OnDeleteCascade OnUpdateCascade `as` #fk_draft_quote_id
157 )
169 )
158-- quoteUniquenessCheck :: TableConstraintExpression Schema _ (Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"])
170-- quoteUniquenessCheck :: TableConstraintExpression Schema _ (Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"])