@@ -13,12 +13,14 @@
1313module Data.Query (
1414 Schema,
1515 createTables,
16− getPost,
16+ getPosts,
1717 getUser,
18+ getUsers,
1819 getLastPosts,
1920 getPostsForUser,
2021 Limit,
21− publishPost
22+ publishPost,
23+ PostResponse(..)
2224) where
2325
2426import Squeal.PostgreSQL
@@ -29,9 +31,23 @@ import Data.Function (on)
2931import Data.Connection
3032import Data.PostElement
3133import qualified Servant as S
34+import Control.Monad
3235import Control.Monad.Morph
3336import Data.Word (Word64)
3437import qualified Data.List as L
38+import qualified Data.Map.Strict as M
39+import qualified Data.Set as Set
40+import Data.Int (Int64)
41+import Data.ByteString.Char8 (pack)
42+import GHC.Generics (Generic)
43+import Data.Aeson
44+import Servant.Docs
45+import Data.Proxy
46+
47+-- MARK: Documentation
48+
49+instance ToSample PostResponse where
50+ toSamples _ = samples $ PostResponse <$> (map snd $ toSamples Proxy) <*> [M.fromList $ map (tupleFirst userId . snd) (toSamples Proxy)]
3551
3652
3753-- MARK: Generalized Post Queries
@@ -86,8 +102,20 @@ getPostQ oTe te = select (
86102getUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG User)
87103getUserQ = selectStar $ from (table #users) & where_ (#userId .== param @1)
88104
89−getPostByIdQ :: Query Schema (TuplePG (Only PostId)) (RowPG PostRowResponse)
90−getPostByIdQ = getPostQ id $ where_ $ #postRowId .== param @1
105+getUsersQ :: [UserId] -> Maybe (Query Schema '[] (RowPG User))
106+getUsersQ uIds = case idsToColumn uIds of
107+ Just idQ -> Just $ selectDotStar #users $ from (subquery (idQ `As` #ids) &
108+ innerJoin (table #users)
109+ (#ids ! #id .== #users ! #userId))
110+ Nothing -> Nothing
111+
112+getPostsByIdQ :: [PostId] -> Maybe (Query Schema '[] (RowPG PostRowResponse))
113+getPostsByIdQ pIds = case idsToColumn pIds of
114+ Just idQ -> Just $ selectDotStar #posts $ from (subquery (idQ `As` #ids) &
115+ innerJoin (subquery $ getPostQ id id `As` #posts)
116+ (#ids ! #id .== #posts ! #postRowId))
117+ Nothing -> Nothing
118+
91119
92120type Limit = Word64
93121
@@ -118,26 +146,43 @@ createPostElementRowsQ = insertRow_ #postElements
118146 Set (param @6) `as` #rowElementQuote :*
119147 Set (param @7) `as` #rowElementAttachment)
120148
149+
150+-- MARK: FrontEnd Data Structures
151+
152+data PostResponse = PostResponse {
153+ posts :: [Post],
154+ users :: M.Map UserId User
155+} deriving (Generic)
156+
157+instance ToJSON PostResponse
158+
159+
121160-- MARK: FrontEnd functions
122161
123−getPostsForUser :: Word64 -> UserId -> StaticPQ (Maybe [Post])
162+getPostsForUser :: Word64 -> UserId -> StaticPQ (Maybe PostResponse)
124163getPostsForUser lim uId = do
125164 postRows <- runQueryParams (getLastNPostsForUserQ lim) (Only uId) >>= getRows
126− return . foldMaybe . map rowsToPost . L.groupBy ((==) `on` postRowId) $ postRows
165+ rowsToPosts postRows `liftMaybe` wrapIntoPostResponse
127166
128−getPost :: PostId -> StaticPQ (Maybe Post)
129−getPost pId = do
130− postRow <- runQueryParams getPostByIdQ (Only pId) >>= getRows
131− return $ rowsToPost postRow
167+getPosts :: [PostId] -> StaticPQ (Maybe PostResponse)
168+getPosts pId =
169+ case getPostsByIdQ pId of
170+ Just psQ -> do
171+ postRows <- runQuery psQ >>= getRows
172+ rowsToPosts postRows `liftMaybe` wrapIntoPostResponse
173+ Nothing -> return Nothing
132174
133−getLastPosts :: Word64 -> StaticPQ (Maybe [Post])
175+getLastPosts :: Word64 -> StaticPQ (Maybe PostResponse)
134176getLastPosts n = do
135177 postRows <- runQuery (getLastNPostsQ n) >>= getRows
136− return . foldMaybe . map rowsToPost . L.groupBy ((==) `on` postRowId) $ postRows
137−
178+ rowsToPosts postRows `liftMaybe` wrapIntoPostResponse
179+
138180getUser :: UserId -> StaticPQ User
139181getUser uId = runQueryParams getUserQ (Only uId) >>= getRow 0
140−
182+
183+getUsers :: [UserId] -> StaticPQ (Maybe [User])
184+getUsers ids = getUsersQ ids `liftMaybe` (fmap Just . (runQuery >=> getRows))
185+
141186publishPost :: UserId -> [PostElement Post] -> StaticPQ PostId
142187publishPost uId els = transactionally_ $ do
143188 pId' <- manipulateParams createPostRowQ (Only uId) >>= firstRow
@@ -147,9 +192,38 @@ publishPost uId els = transactionally_ $ do
147192 return pId
148193 _ -> lift $ S.throwError S.err404
149194
195+
150196-- MARK: Utils
151197
152198foldMaybe :: [Maybe a] -> Maybe [a]
153199foldMaybe [] = Just []
154200foldMaybe (Nothing : _) = Nothing
155−foldMaybe (Just x : xs) = (x :) <$> foldMaybe xs
201+foldMaybe (Just x : xs) = (x :) <$> foldMaybe xs
202+
203+userIdsFromPostResponse :: [Post] -> [UserId]
204+userIdsFromPostResponse = Set.toList . Set.fromList . map postAuthorId
205+
206+rowsToPosts :: [PostRowResponse] -> Maybe [Post]
207+rowsToPosts = foldMaybe . map rowsToPost . L.groupBy ((==) `on` postRowId)
208+
209+tupleFirst :: (a -> b) -> a -> (b, a)
210+tupleFirst f a = (f a, a)
211+
212+mapFirstBy :: (a -> b) -> [a] -> [(b, a)]
213+mapFirstBy f = map $ tupleFirst f
214+
215+idsToColumn :: [Int64] -> Maybe (Query schema params '["id" ::: 'NotNull 'PGint8])
216+idsToColumn [] = Nothing
217+idsToColumn (i:ii) = Just $ values (unsafeIntToExpr i `as` #id) $ map ((`as` #id) . unsafeIntToExpr) ii
218+
219+unsafeIntToExpr :: Int64 -> Expression schema from grouping params ty
220+unsafeIntToExpr = UnsafeExpression . pack . show
221+
222+wrapIntoPostResponse :: [Post] -> StaticPQ (Maybe PostResponse)
223+wrapIntoPostResponse ps = do
224+ pUsers <- getUsers $ userIdsFromPostResponse ps
225+ return $ PostResponse ps . M.fromList . mapFirstBy userId <$> pUsers
226+
227+liftMaybe :: Applicative f => Maybe a -> (a -> f (Maybe b)) -> f (Maybe b)
228+liftMaybe Nothing _ = pure Nothing
229+liftMaybe (Just a) f = f a