Creating a result piecewise from stateful computation, with good ergonomics - haskell

Question

I'd like to write a function
step :: State S O
where O is a record type:
data O = MkO{ out1 :: Int, out2 :: Maybe Int, out3 :: Maybe Bool }
The catch is that I'd like to assemble my O output piecewise. What I mean by that, is that at various places along the definition of step, I learn then and there that e.g. out2 should be Just 3, but I don't know in a non-convoluted way what out1 and out3 should be. Also, there is a natural default value for out1 that can be computed from the end state; but there still needs to be the possibility to override it in step.
And, most importantly, I want to "librarize" this, so that users can provide their own S and O types, and I give them the rest.
My current approach is to wrap everything in a WriterT (HKD O Last) using Higgledy's automated way of creating a type HKD O Last which is isomorphic to
data OLast = MkOLast{ out1' :: Last Int, out2' :: Last (Maybe Int), out3' :: Last (Maybe String) }
This comes with the obvious Monoid instance, so I can, at least morally, do the following:
step = do
MkOLast{..} <- execWriterT step'
s <- get
return O
{ out1 = fromMaybe (defaultOut1 s) $ getLast out1'
, out2 = getLast out2'
, out3 = fromMaybe False $ getLast out3'
}
step' = do
...
tell mempty{ out2' = pure $ Just 42 }
...
tell mempty{ out1' = pure 3 }
This is code I could live with.
The problem is that I can only do this morally. In practice, what I have to write is quite convoluted code because Higgledy's HKD O Last exposes record fields as lenses, so the real code ends up looking more like the following:
step = do
oLast <- execWriterT step'
s <- get
let def = defaultOut s
return $ runIdentity . construct $ bzipWith (\i -> maybe i Identity . getLast) (deconstruct def) oLast
step' = do
...
tell $ set (field #"out2") (pure $ Just 42) mempty
...
tell $ set (field #"out3") (pure 3) mempty
The first wart in step we can hide away behind a function:
update :: (Generic a, Construct Identity a, FunctorB (HKD a), ProductBC (HKD a)) => a -> HKD a Last -> a
update initial edits = runIdentity . construct $ bzipWith (\i -> maybe i Identity . getLast) (deconstruct initial) edits
so we can "librarize" that as
runStep
:: (Generic o, Construct Identity o, FunctorB (HKD o), ProductBC (HKD o))
=> (s -> o) -> WriterT (HKD o Last) (State s) () -> State s o
runStep mkDef step = do
let updates = execWriterT step s
def <- gets mkDef
return $ update def updates
But what worries me are the places where partial outputs are recorded. So far, the best I've been able to come up with is to use OverloadedLabels to provide #out2 as a possible syntax:
instance (HasField' field (HKD a f) (f b), Applicative f) => IsLabel field (b -> Endo (HKD a f)) where
fromLabel x = Endo $ field #field .~ pure x
output :: (Monoid (HKD o Last)) => Endo (HKD o Last) -> WriterT (HKD o Last) (State s) ()
output f = tell $ appEndo f mempty
this allows end-users to write step' as
step' = do
...
output $ #out2 (Just 42)
...
output $ #out3 3
but it's still a bit cumbersome; moreover, it uses quite a lot of heavy machinery behind the scenes. Especially given that my use case is such that all the library internals would need to be explained step-by-step.
So, what I am looking for are improvements in the following areas:
Simpler internal implementation
Nicer API for end-users
I'd be happy with a completely different approach from first principles as well, as long as it doesn't require the user to define their own OLast next to O...

Answer 1

The following is not a very satisfactory solution because it's still complex and the type errors are horrific, but it tries to achieve two things:
Any attempt to "complete" the construction of the record without having specified all mandatory fields results in a type error.
"there is a natural default value for out1 that can be computed from the end state; but there still needs to be the possibility to override it"
The solution does away with the State monad. Instead, there's an extensible record to which new fields are progressively added—therefore changing its type—until it is "complete".
We use the red-black-record, sop-core (these for HKD-like functionality) and transformers (for the Reader monad) packages.
Some necessary imports:
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
import Data.RBR (Record,unit,FromRecord(fromRecord),ToRecord,RecordCode,
Productlike,fromNP,toNP,ProductlikeSubset,projectSubset,
FromList,
Insertable,Insert,insert) -- from "red-black-record"
import Data.SOP (I(I),unI,NP,All,Top) -- from "sop-core"
import Data.SOP.NP (sequence_NP)
import Data.Function (fix)
import Control.Monad.Trans.Reader (Reader,runReader,reader)
import qualified GHC.Generics
The datatype-generic machinery:
specify :: forall k v t r. Insertable k v t
=> v -> Record (Reader r) t -> Record (Reader r) (Insert k v t)
specify v = insert #k #v #t (reader (const v))
close :: forall r subset subsetflat whole . _ => Record (Reader r) whole -> r
close = fixRecord #r #subsetflat . projectSubset #subset #whole #subsetflat
where
fixRecord
:: forall r flat. (FromRecord r, Productlike '[] (RecordCode r) flat, All Top flat)
=> Record (Reader r) (RecordCode r)
-> r
fixRecord = unI . fixHelper I
fixHelper
:: forall r flat f g. _
=> (NP f flat -> g (NP (Reader r) flat))
-> Record f (RecordCode r)
-> g r
fixHelper adapt r = do
let moveFunctionOutside np = runReader . sequence_NP $ np
record2record np = fromRecord . fromNP <$> moveFunctionOutside np
fix . record2record <$> adapt (toNP r)
specify adds a field to an extensible HKD-like record where each field is actually a function from the completed record to the type of the field in the completed record. It inserts the field as a constant function. It can also override existing default fields.
close takes an extensible record constructed with specify and "ties the knot", returning the completed non-HKD record.
Here's code that must be written for each concrete record:
data O = MkO { out1 :: Int, out2 :: Maybe Int, out3 :: Maybe Bool }
deriving (GHC.Generics.Generic, Show)
instance FromRecord O
instance ToRecord O
type ODefaults = FromList '[ '("out1",Int) ]
odefaults :: Record (Reader O) ODefaults
odefaults =
insert #"out1" (reader $ \r -> case out2 r of
Just i -> succ i
Nothing -> 0)
$ unit
In odefaults we specify overrideable default values for some fields, which are calculated by inspecting the "completed" record (this works because we later tie the knot with close.)
Putting it all to work:
example1 :: O
example1 =
close
. specify #"out3" (Just False)
. specify #"out2" (Just 0)
$ odefaults
example2override :: O
example2override =
close
. specify #"out1" (12 :: Int)
. specify #"out3" (Just False)
. specify #"out2" (Just 0)
$ odefaults
main :: IO ()
main =
do print $ example1
print $ example2override
-- result:
-- MkO {out1 = 1, out2 = Just 0, out3 = Just False}
-- MkO {out1 = 12, out2 = Just 0, out3 = Just False}

Answer 2

Here's what I am currently using for this: basically the same Barbies-based technique from my original question, but using barbies-th and lens to create properly named field lenses.
I am going to illustrate it with an example. Suppose I want to collect this result:
data CPUOut = CPUOut
{ inputNeeded :: Bool
, ...
}
Create Barbie for CPUOut using barbies-th, add _ prefix to field names, and use lens's makeLenses TH macro to generate field accessors:
declareBareB [d|
data CPUOut = CPUOut
{ _inputNeeded :: Bool
, ...
} |]
makeLenses ''CPUState
Write update s.t. it works on partial values that are wrapped in the Barbie newtype wrapper:
type Raw b = b Bare Identity
type Partial b = Barbie (b Covered) Last
update
:: (BareB b, ApplicativeB (b Covered))
=> Raw b -> Partial b -> Raw b
update initials edits =
bstrip $ bzipWith update1 (bcover initials) (getBarbie edits)
where
update1 :: Identity a -> Last a -> Identity a
update1 initial edit = maybe initial Identity (getLast edit)
The role of the Barbie wrapper is that Barbie b f has a Monoid instance if only all the fields of b f are monoids themselves. This is exactly the case for Partial CPUOut, so that is what we are going to be collecting in our WriterT:
type CPU = WriterT (Partial CPUOut) (State CPUState)
Write the generic output assignment combinator. This is what makes it nicer than the approach in the original question, because the Setter's are properly named field accessor lenses, not overloaded labels:
(.:=)
:: (Applicative f, MonadWriter (Barbie b f) m)
=> Setter' (b f) (f a) -> a -> m ()
fd .:= x = scribe (iso getBarbie Barbie . fd) (pure x)
Example use:
startInput :: CPU ()
startInput = do
inputNeeded .:= True
phase .= WaitInput