时间戳

首页 > 解决方案 > 从有状态的计算中分段创建结果，具有良好的人体工程学

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

问题描述

我想写一个函数

step :: State S O

O记录类型在哪里：

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

问题是我想O分段组装我的输出。我的意思是，在定义的各个地方step，我当时和那里都知道 eg out2should be 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 }

这是我可以忍受的代码。

问题是我只能在道德上这样做。在实践中，我必须写的是相当复杂的代码，因为 HiggledyHKD 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

但是还是有点麻烦；此外，它在幕后使用了相当多的重型机械。特别是考虑到我的用例需要逐步解释所有库内部结构。

因此，我正在寻找以下方面的改进：

标签： haskellapi-designgeneric-programminghigher-kinded-types

解决方案

以下不是一个非常令人满意的解决方案，因为它仍然很复杂并且类型错误非常可怕，但它试图实现两件事：

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

  • “可以从最终状态计算出一个自然的默认值out1；但仍然需要有可能覆盖它”

解决方案取消了Statemonad。相反，有一个可扩展的记录，新字段会逐渐添加到该记录中——因此会更改其类型——直到它“完整”。

我们使用red-black-record、sop-core（这些用于类似 HKD 的功能）和transformers（用于Readermonad）包。

一些必要的进口：

{-# 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并“打结”，返回完整的非港币记录。

以下是必须为每个具体记录编写的代码：

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}

推荐阅读