DecorateROFsWeirdTrick.hs

{-# LANGUAGE BlockArguments, DeriveGeneric #-}
module Main where

import Data.Function ((&))
import System.IO
import Data.List.NonEmpty (NonEmpty ((:|)))
import GHC.Generics
-- from "dep-t-advice"
import Control.Monad.Dep.SimpleAdvice (AspectT(..), advising, advise, adviseRecord, Top)
import Control.Monad.Dep.SimpleAdvice.Basic (printArgs)

data Env m = Env {
        foo :: m ()
    ,   bar :: Int -> m Int
    ,   baz :: Int -> Bool -> m Char
    } deriving Generic

env :: Env IO
env = Env {
        foo = pure ()
    ,   bar = \_ -> pure 5 
    ,   baz = \_ _ -> pure 'c'
    }

env' :: Env IO
env' = env & advising \envA -> envA { baz = advise (printArgs stdout "prefix: ") (baz envA) }

-- env_ :: Env IO
-- env_ = env & advising _
-- * Found hole: _ :: Env (AspectT IO) -> Env (AspectT IO)

-- env_' :: Env IO
-- env_' = env & advising \envA -> envA { baz = _ (baz envA) }
--    * Found hole:
--         _ :: (Int -> Bool -> AspectT IO Char)
--              -> Int -> Bool -> AspectT IO Char

env'' :: Env IO
env'' = env & advising (adviseRecord @_ @Top \_ -> printArgs stdout "prefix: ")

env''' :: Env IO
env''' = env & advising (adviseRecord @_ @Top \((tr,fieldName) :| _) -> printArgs stdout (show tr ++ " " ++ fieldName))

main :: IO ()
main = do
    _ <- baz env' 5 False
    _ <- baz env'' 6 False
    _ <- baz env''' 7 True
    pure ()