fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Build problem determined: crashes Haddock. Added similar Class manually.

Browse Source
This commit is contained in:
SJost 2019-02-21 16:47:42 +01:00
parent bb552c472f
commit 89e6b17107
3 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Handler/Course.hs
View File

@ -636,13 +636,12 @@ instance HasUser UserTableData where
-- hasUser = _entityVal -- hasUser = _entityVal
hasUser = _dbrOutput . _1 . _entityVal hasUser = _dbrOutput . _1 . _entityVal
-- TEST HADDOCK instance HasEntity UserTableData User where
-- instance HasEntity UserTableData User where hasEntity = _dbrOutput . _1
-- hasEntity = _dbrOutput . _1
-- -- there can be only one -- FunctionalDependency violation -- there can be only one due to FunctionalDependency violation if we use MakeClassy on Entity
-- instance HasEntity UserTableData CourseParticipant where instance HasEntity UserTableData CourseParticipant where
-- hasEntity = _dbrOutput . _2 hasEntity = _dbrOutput . _2
courseIs :: CourseId -> UserTableWhere courseIs :: CourseId -> UserTableWhere
courseIs cid ((_user `E.InnerJoin` participant) `E.LeftOuterJoin` _note) = participant E.^. CourseParticipantCourse E.==. E.val cid courseIs cid ((_user `E.InnerJoin` participant) `E.LeftOuterJoin` _note) = participant E.^. CourseParticipantCourse E.==. E.val cid

13
src/Handler/Utils/Table/Cells.hs
View File

@ -37,11 +37,14 @@ userCell displayName surname = cell $ nameWidget displayName surname
cellHasUser :: (IsDBTable m a, HasUser c) => c -> DBCell m a cellHasUser :: (IsDBTable m a, HasUser c) => c -> DBCell m a
cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname) cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)
-- cellHasUserLink :: (IsDBTable m a, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m a cellHasUserLink :: (IsDBTable m a, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m a
-- cellHasUserLink toLink user = cellHasUserLink toLink user =
-- let uid = user ^. _entityKey let userEntity :: Entity User -- needed without the functional dependency
-- nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _entityVal . _userSurname) userEntity = user ^. hasEntity
-- in anchorCellM (toLink <$> encrypt uid) nWdgt uid = userEntity ^. _entityKey
nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^. _entityVal . _userSurname)
in anchorCellM (toLink <$> encrypt uid) nWdgt
cellHasMatrikelnummer :: (IsDBTable m a, HasUser c) => c -> DBCell m a cellHasMatrikelnummer :: (IsDBTable m a, HasUser c) => c -> DBCell m a
cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer

9
src/Utils/Lens.hs
View File

@ -27,12 +27,17 @@ _InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r
makeLenses_ ''Entity makeLenses_ ''Entity
-- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW:
-- makeClassyFor_ "HasEntity" "hasEntity" ''Entity -- makeClassyFor_ "HasEntity" "hasEntity" ''Entity
-- class HasEntity c record | c -> record where -- class HasEntity c record | c -> record where
-- hasEntity :: Lens' c (Entity record) -- hasEntity :: Lens' c (Entity record)
--
-- Manual attempt, leaving out the unwanted functional dependency
class HasEntity c record where
hasEntity :: Lens' c (Entity record)
makeLenses_ ''Course -- makeLenses_ ''Course
-- makeClassyFor_ "HasCourse" "hasCourse" ''Course makeClassyFor_ "HasCourse" "hasCourse" ''Course
-- class HasCourse c where -- class HasCourse c where
-- hasCourse :: Lens' c Course -- hasCourse :: Lens' c Course