git.fiddlerwoaroof.com
app/Main.hs
31080cf3
 {-# 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)