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

-- TEST HADDOCK
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

makeLenses_ ''User
-- makeClassyFor_ "HasUser" "hasUser" ''User
-- > :info HasUser
-- class HasUser c where
--   hasUser :: Lens' c User -- MINIMAL
--   _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