blh.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
-- trait Identity[A] { def run: A }
import Data.Functor.Identity

data Person =
  Person
    Int -- age
    String -- name
  deriving (Eq, Show)

data Person2 =
  Person2 
    Person
    String -- address
  deriving (Eq, Show)

modifyAge' :: Functor f => (Int -> (f Int)) -> Person -> (f Person)
modifyAge' f (Person a s) = fmap (\a' -> Person a' s) (f a)

type Optic p f a b = (p a (f a)) -> p b (f b)

class HasAge a where
  age :: forall f. Functor f => Optic (->) f Int a

class HasPerson a where
  person :: forall f. Functor f => Optic (->) f Person a

class Choice (p :: * -> * -> *) where -- ?

class AsPerson a where
  _Person :: forall p f. (Choice p, Applicative f) => Optic p f Person a

class AsPerson2 a where
  _Person2 :: forall p f. (Choice p, Applicative f) => Optic p f Person2 a

instance AsPerson Person where
  _Person = id

instance AsPerson2 Person3 where
  _Person2 = undefined
  -- (Choice p, Applicative f) => (p Person (f Person)) -> p Person3 (f Person3)

instance HasPerson Person where
  person = id

instance HasAge Person where
  age f (Person a s) = fmap (\a' -> Person a' s) (f a)

  -- (Int -> (f Int)) -> a -> (f a)

modifyAge :: (Int -> Int) -> Person -> Person
modifyAge f p = runIdentity (modifyAge' (\n -> Identity (f n)) p)

modifyAge2 :: HasAge a => (Int -> Int) -> a -> a
modifyAge2 f p = runIdentity (age (\n -> Identity (f n)) p)

setAge :: Int -> Person -> Person
setAge = modifyAge . const

data Const a b = Const a

getAge :: Person -> Int
getAge = undefined -- use Const and modifyAge'






{-
birthday :: Person -> Person
birthday = modifyAge (+1)
-}

{-
modifyAge2 :: (Int -> Int) -> Person2 -> Person2
modifyAge2 f (Person2 p a) = Person2 (modifyAge f p) a
-}
-- HasAge x => (Int -> Int) -> x -> x


data Person3 =
  Person3
    (Maybe Person2) -- manager
  deriving (Eq, Show)