从状态计算中分段创建结果，并具有良好的人体工程学特性

Question

我想写一个函数

step :: State S O

其中O是记录类型：

data O = MkO{ out1 :: Int, out2 :: Maybe Int, out3 :: Maybe Bool }

收获是，我想分段组装O输出。我的意思是，在step定义的不同地方，我会在那里学习，例如out2应该是Just 3，但我不知所措地认为out1和out3应该是什么。同样，out1有一个自然的默认值，可以从结束状态计算得出；但仍然需要在step中覆盖它。

而且，最重要的是，我想对此进行“自由化”，以便用户可以提供自己的S和O类型，其余的由我提供。

我当前的方法是使用WriterT (HKD O Last)的自动创建类型Higgledy的同构形式将所有内容包装在HKD O Last中>]

data OLast = MkOLast{ out1' :: Last Int, out2' :: Last (Maybe Int), out3' :: Last (Maybe String) }
这带有明显的Monoid实例，因此至少在道德上我可以执行以下操作：

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 }
这是我可以使用的代码。

问题是我只能这样做[[道德

。在practice中，我必须编写相当复杂的代码，因为Higgledy的HKD O Last将记录字段公开为镜头，因此实际代码最终看起来更像以下内容：

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

step中的第一个疣，我们可以隐藏在函数后面：

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

所以我们可以将它“解放”为>
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

但是让我担心的是记录部分输出的地方。到目前为止，我能想到的最好的方法是使用OverloadedLabels作为可能的语法提供#out2：
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

这允许最终用户将step'写为
step' = do
    ...
    output $ #out2 (Just 42)
    ...
    output $ #out3 3 

但是仍然有点麻烦；而且，它在幕后使用了大量的重型机械。特别是考虑到我的用例使得所有库的内部结构都需要逐步说明。
所以，我正在寻找以下方面的改进：

• 内部简单实现
• Nicer API
（针对最终用户）>我也对第一种原理的[[完全不同的方法感到满意，只要它不需要用户在OLast旁边定义自己的O ...
• 我想写一个函数步骤::在SO为O的情况下记录状态：数据O = MkO {out1 :: Int，out2 :: Maybe Int，out3 :: Maybe Bool}我要抓住的是d想组装我的O输出...

以下内容不是很令人满意的解决方案，因为它仍然很复杂并且类型错误令人恐惧，但是它试图实现两件事：

任何在未指定所有必填字段的情况下“完成”记录构造的尝试都会导致类型错误。

“ out1有一个自然的默认值，可以从结束状态计算得出；但是仍然有可能覆盖它”

解决方案取消了State单子。而是有一条可扩展的记录，在该记录中逐渐添加了新字段（因此更改了它的类型），直到“完成”为止。

我们使用red-black-record，sop-core（用于类似HKD的功能）和transformers（用于Reader monad）程序包。

一些必要的进口：

{-# 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

数据类型通用机器：

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将一个字段添加到可扩展的类似HKD的记录中，其中每个字段实际上是从已完成记录到已完成记录中字段类型的函数。它将字段插入为常量函数。它还可以覆盖现有的默认字段。

[close接受由specify构成的可扩展记录并“打结”，返回完整的非HKD记录。
这里是每个具体记录必须编写的代码：

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

在odefaults中，我们为某些字段指定了可覆盖的默认值，这些默认值是通过检查“完成的”记录来计算的（这很有效，因为我们稍后将结与close绑定在一起。）]

全部投入使用：
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 1