This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Utils/Lens.hs

46 lines
1.1 KiB
Haskell

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_)
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
makeLenses_ ''Course
makeLenses_ ''SheetCorrector
makeLenses_ ''SubmissionGroup
makeLenses_ ''SheetGrading
makeLenses_ ''SheetType
makePrisms ''AuthResult
-- makeClassy_ ''Load