module Utils.Lens ( module Utils.Lens ) where

import ClassyPrelude.Yesod
import Model
import Control.Lens as Utils.Lens hiding ((<.>), universe, snoc)
import Control.Lens.Extras as Utils.Lens (is)
import Utils.Lens.TH as Utils.Lens (makeLenses_, makeClassyFor_)
import Data.Set.Lens as Utils.Lens

import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))

import qualified Database.Esqueleto as E (Value(..),InnerJoin(..))


_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

_nullable :: MonoFoldable mono => Prism' mono (NonNull mono)
_nullable = prism' toNullable fromNullable


-----------------------------------
-- Lens Definitions for our Types


-- makeLenses_ ''Course
makeClassyFor_ "HasCourse" "hasCourse" ''Course
-- class HasCourse c where
--   hasCourse :: Lens' c Course


-- 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...
--


makeLenses_ ''Entity
-- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW:
-- makeClassyFor_ "HasEntity" "hasEntity" ''Entity
-- class HasEntity c record | c -> record where
--   hasEntity :: Lens' c (Entity record)
--
-- Manual definition, explicitely leaving out the unwanted Functional Dependency, since we want Instances differing on the result-type
class HasEntity c record where
  hasEntity :: Lens' c (Entity record)

-- Typed convenience to avoid type signatures, due to the missing FunctionalDepenency that we do not want.
hasEntityUser :: (HasEntity a User) => Lens' a (Entity User)
hasEntityUser = hasEntity

-- This is what we would want, but is an UndecidableInstance since the type is not reduced:
-- instance (HasEntity a User) => HasUser a where
--   hasUser = hasEntityUser
--
-- Possible, but rather useless:
-- instance (HasUser a) => HasUser (Entity a) where
--   hasUser = _entityVal . hasUser


makeLenses_ ''SheetCorrector

makeLenses_ ''Load

makeLenses_ ''SubmissionGroup

makeLenses_ ''SheetGrading

makeLenses_ ''SheetType

makePrisms ''SheetGroup

makePrisms ''AuthResult

makePrisms ''FormResult

makeLenses_ ''StudyFeatures

makeLenses_ ''StudyDegree

makeLenses_ ''StudyTerms

makeLenses_ ''StudyTermCandidate

makeLenses_ ''FieldView

makePrisms ''HandlerContents

makePrisms ''ErrorResponse

makeLenses_ ''UploadMode

makeLenses_ ''SubmissionMode

makePrisms ''E.Value

makeLenses_ ''OccurenceSchedule

makePrisms ''OccurenceSchedule

makeLenses_ ''OccurenceException

makePrisms ''OccurenceException

makeLenses_ ''Occurences

makeLenses_ ''PredDNF


-- makeClassy_ ''Load

--------------------------
-- Fields for `UniWorX` --
--------------------------

class HasInstanceID s a | s -> a where
  instanceID :: Lens' s a
  
class HasJSONWebKeySet s a | s -> a where
  jsonWebKeySet :: Lens' s a