{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DataKinds #-} module Main where import GHC.Generics import Control.Lens import Data.Generics.Product data Person = Person { name :: String, age :: Int, eye_color :: String } deriving (Show, Generic) data Person' = Person' { name' :: String, age' :: String, eye_color' :: String } deriving (Show, Generic, Eq) ageT :: Functor f => (Int -> f String) -> Person -> f Person' ageT f (Person name p_age eye_color) = fmap (\v -> Person' name v eye_color) (f p_age) printAndReturn :: String -> IO String printAndReturn v = do putStrLn v pure v intoIdentity :: String -> Identity String intoIdentity v = pure $ "{" ++ v ++ "}" printFocus :: (Show a, Functor m) => (a -> m a') -> Lens s s' a a' -> s -> m s' printFocus f lens struct = lens f struct doMain :: Monad m => (String -> m String) -> Person -> m Person' doMain f p = do p <- printFocus f (field @ "name") p p <- printFocus f (field @ "eye_color") p printFocus (f . show) ageT p doMainWorks :: Bool doMainWorks = (runIdentity $ doMain intoIdentity person) == Person' "{Bob}" "{12}" "{hazel}" person = Person "Bob" 12 "hazel" main :: IO () main = do doMain printAndReturn person putStrLn $ "works? " ++ (show doMainWorks)