module Utils.Lens ( module Utils.Lens ) where import Import.NoFoundation import Control.Lens as Utils.Lens hiding ((<.>)) import Control.Lens.Extras as Utils.Lens (is) import Utils.Lens.TH as Utils.Lens (makeLenses_, makeClassyFor_) import qualified Database.Esqueleto as E (Value(..),InnerJoin(..)) _unValue :: Lens' (E.Value a) a _unValue f (E.Value a) = E.Value <$> f a _PathPiece :: PathPiece v => Prism' Text v _PathPiece = prism' toPathPiece fromPathPiece maybePrism :: Prism' a b -> Prism' (Maybe a) (Maybe b) maybePrism p = prism' (fmap $ review p) (fmap $ preview p ) applying :: Applicative f => Lens' s a -> Lens' (f s) (f a) applying l = lens (fmap $ view l) (liftA2 . flip $ set l) _InnerJoinLeft :: Lens' (E.InnerJoin l r) l -- forall f. Functor f => (a -> f a) -> s -> f s _InnerJoinLeft f (E.InnerJoin l r) = (`E.InnerJoin` r) <$> f l _InnerJoinRight :: Lens' (E.InnerJoin l r) r _InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r -- makeLenses_ ''Entity makeClassyFor_ "HasEntity" "hasEntity" ''Entity -- class HasEntity c record | c -> record where -- hasEntity :: Lens' c (Entity record) -- makeLenses_ ''Course makeClassyFor_ "HasCourse" "hasCourse" ''Course -- class HasCourse c where -- hasCourse :: Lens' c Course instance (HasCourse a) => HasCourse (Entity a) where hasCourse = _entityVal . hasCourse makeClassyFor_ "HasUser" "hasUser" ''User -- > :info HasUser -- class HasUser c where {-# MINIMAL hasUser #-} -- hasUser :: Lens' c User -- _userDisplayName :: Lens' c Text -- _userSurname :: Lens' c Text -- _user... -- -- TODO: Is this instance needed? instance (HasUser a) => HasUser (Entity a) where hasUser = _entityVal . hasUser -- This is what we would want instead: -- instance (HasEntity a User) => HasUser a where -- hasUser = _entityVal makeLenses_ ''SheetCorrector makeLenses_ ''SubmissionGroup makeLenses_ ''SheetGrading makeLenses_ ''SheetType makePrisms ''AuthResult -- makeClassy_ ''Load