绑结一国单子(Tying the Knot with a State monad)

我正在对涉及绑一个大结Haskell的项目：我解析图，其中每个节点是在一些偏移到文件的序列化表示，并可以通过其偏移参考另一个节点。 所以，我需要从偏移量的地图构建，同时解析节点，我可以反馈到自己在do rec块。

我有这方面的工作，并且胜负的，合理的抽象为StateT -esque单子转换：

{-# LANGUAGE DoRec, GeneralizedNewtypeDeriving #-}

import qualified Control.Monad.State as S

data Knot s = Knot { past :: s, future :: s }

newtype RecStateT s m a = RecStateT (S.StateT (Knot s) m a) deriving
  ( Alternative
  , Applicative
  , Functor
  , Monad
  , MonadCont
  , MonadError e
  , MonadFix
  , MonadIO
  , MonadPlus
  , MonadReader r
  , MonadTrans
  , MonadWriter w )

runRecStateT :: RecStateT s m a -> Knot s -> m (a, Knot s)
runRecStateT (RecStateT st) = S.runStateT st

tie :: MonadFix m => RecStateT s m a -> s -> m (a, s)
tie m s = do
  rec (a, Knot s' _) <- runRecStateT m (Knot s s')
  return (a, s')

get :: Monad m => RecStateT s m (Knot s)
get = RecStateT S.get

put :: Monad m => s -> RecStateT s m ()
put s = RecStateT $ S.modify $ \ ~(Knot _ s') -> Knot s s'

该tie功能就是魔法发生：调用runRecStateT生产值和状态，这是我给它作为自己的未来。 需要注意的是get允许你从过去和未来的状态读取，但put只允许你修改“存在”。

问题1：这是否看起来实现通常的这种打结模式一个体面的方式？ 或者更好的是，已经有人实施这个通用的解决方案，我通过Hackage窥探时忽略了？ 我打我的头靠在Cont单子了一段时间，因为它看起来可能更优雅（见类似的帖子从丹·伯顿），但我只是不能工作了。

完全主观的问题2：我不是我调用的代码最终看起来方式完全兴奋：

do
  Knot past future <- get
  let {- ... -} = past
      {- ... -} = future
      node = {- ... -}
  put $ {- ... -}
  return node

实现细节此处省略，很明显，是，我必须得到重要的一点past和future状态，模式匹配他们让内部结合 （或明确地使先前的模式懒惰）提取不管我在乎，然后建立自己的节点，更新我的状态，最后返回节点。 似乎是不必要的啰嗦了，我不喜欢特别它是多么容易不小心使提取的格局past和future状态严格。 那么，有谁能够想到一个更好的界面？

Answer 1:

我已经被玩弄的东西，我想我已经拿出东西......有趣。 我把它称为“先知”的单子，并提供（除单子操作）两个基本操作：

see  :: Monoid s => Seer s s
send :: Monoid s => s -> Seer s ()

和运行操作：

runSeer :: Monoid s => Seer s a -> a

这个单子的工作方式是， see允许先见看到的一切 ，并send允许先见到“发送”信息给所有其他先知让他们看到。 每当有先见执行see操作，所以能看到所有已发送的信息，以及将要发送的所有信息。 换句话说，一个给定的运行中， see总是会产生相同的结果，无论身在何处，或当你调用它。 说它是另一种方式see是你如何得到一个工作参照“捆绑”结。

这其实是非常相似，只是使用fix ，但所有的子部分的递增和隐式添加，而不是明确。 显然，先知将无法正常在一个悖论的存在工作，需要有足够的懒惰。 例如， see >>= send可能导致的信息爆炸，捕捉你在一个时间循环。

哑例如：

import Control.Seer
import qualified Data.Map as M
import Data.Map (Map, (!))

bar :: Seer (Map Int Char) String
bar = do
  m <- see
  send (M.singleton 1 $ succ (m ! 2))
  send (M.singleton 2 'c')
  return [m ! 1, m ! 2]

正如我所说，我只是一直在玩弄身边，所以我不知道如果这是比任何你有什么更好的，或者如果它的任何好处可言！ 但它的漂亮，和相关的，如果你的“心结”状态是一种Monoid ，那么它也许会是对你有用。 公平的警告：我建Seer用Tardis 。

https://github.com/DanBurton/tardis/blob/master/Control/Seer.hs

Answer 2:

我在题为写了一篇关于这个话题大会：递归循环编程做 ，我说明了构建使用打结汇编两种方法。 像你的问题，汇编程序必须能够解决在文件后面可能出现的标签的地址。

Answer 3:

关于实施，我想使它成为一个读者单子（对未来）的组成和国家单子（过去/现在）。 其原因是，你（在设置你的未来只有一次tie ），然后不要改变它。

{-# LANGUAGE DoRec, GeneralizedNewtypeDeriving #-}

import Control.Monad.State
import Control.Monad.Reader
import Control.Applicative

newtype RecStateT s m a = RecStateT (StateT s (ReaderT s m) a) deriving
  ( Alternative
  , Applicative
  , Functor
  , Monad
  , MonadPlus
  )

tie :: MonadFix m => RecStateT s m a -> s -> m (a, s)
tie (RecStateT m) s = do
  rec (a, s') <- flip runReaderT s' $ flip runStateT s m
  return (a, s')

getPast :: Monad m => RecStateT s m s
getPast = RecStateT get

getFuture :: Monad m => RecStateT s m s
getFuture = RecStateT ask

putPresent :: Monad m => s -> RecStateT s m ()
putPresent = RecStateT . put

关于你的第二个问题，它会帮助了解您的数据流（即有你的代码的小例子）。 这是不正确的，严格的模式总是导致循环。 这是真的，你要小心，以免产生非生产循环，但确切的限制取决于你正在构建什么和如何。

Answer 4:

我的单子使用量那种不堪重负。 我可能不明白过去/将来的事情，但我猜你只是想表达懒+不动点结合。 （纠正我，如果我错了）的RWS为R = W Monad的使用是一种有趣的，但你并不需要的State和loop ，当你可以做同样的fmap 。 有一个在使用单子，如果他们不使事情更容易毫无意义。 （只有极少数单子代表时间顺序，反正。）

我一般解决绑结：

1. 我解析一切的节点列表，
2. 该列表转换为Data.Vector为O（1）访问盒装（=懒惰）值，
3. 这一结果结合使用名称let或fix或mfix功能，
4. 并获得名为向量分析器内。 （ 见 1）

---

这example在解决方案博客 ，你写某事。 像这样：

data Node = Node {
  value :: Int,
  next  :: Node
} deriving Show
…
tie = …
parse = …
data ParserState = …
…
example :: Node
example =
  let (_, _, m) = tie parse $ ParserState 0 [(0, 1), (1, 2), (2, 0)]
  in (m Map.! 0)

我会这样写：

{-# LANGUAGE ViewPatterns, NamedFieldPuns #-}
import Data.Vector as Vector

example :: Node
example =
   let node :: Int -> Node
       node = (Vector.!) $ Vector.fromList $
                   [ Node{value,next}
                   | (value,node->next) <- [(0, 1), (1, 2), (2, 0)]
                   ]
   in (node 0)

或者更短：

{-# LANGUAGE ViewPatterns, NamedFieldPuns #-}
import Data.Vector as Vector

example :: Node
example = (\node->(Vector.fromList[ Node{value,next}
                                  | (value,node->next) <- [(0, 1), (1, 2), (2, 0)]
                                  ] Vector.!)) `fix` 0

Answer 5:

我最近有一个类似的问题，但我选择了不同的方法。 递归数据结构可以被表示为在一个数据类型仿函数类型固定点。 加载数据然后可以分成两个部分：

• 将数据加载到，只有某种标识符的引用的其他节点的结构。 在这个例子中它是Loader Int (NodeF Int) ，它构造地图类型的值的NodeF Int Int 。
• 通过用实际数据替换标识符创建一个递归数据结构结同心。 在该示例中所得到的数据结构具有类型Fix (NodeF Int) ，并且它们被后来转化为Node Int为了方便。

它缺乏一个适当的错误处理等，但思路应该是从清晰。

-- Public Domain

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust)

-- Fixed point operator on types and catamohism/anamorphism methods
-- for constructing/deconstructing them:

newtype Fix f = Fix { unfix :: f (Fix f) }

catam :: Functor f => (f a -> a) -> (Fix f -> a)
catam f = f . fmap (catam f) . unfix

anam :: Functor f => (a -> f a) -> (a -> Fix f)
anam f = Fix . fmap (anam f) . f

anam' :: Functor f => (a -> f a) -> (f a -> Fix f)
anam' f = Fix . fmap (anam f)

-- The loader itself

-- A representation of a loader. Type parameter 'k' represents the keys by
-- which the nodes are represented. Type parameter 'v' represents a functor
-- data type representing the values.
data Loader k v = Loader (Map k (v k))

-- | Creates an empty loader.
empty :: Loader k v
empty = Loader $ Map.empty

-- | Adds a new node into a loader.
update :: (Ord k) => k -> v k -> Loader k v -> Loader k v
update k v = update' k (const v)

-- | Modifies a node in a loader.
update' :: (Ord k) => k -> (Maybe (v k) -> (v k)) -> Loader k v -> Loader k v
update' k f (Loader m) = Loader $ Map.insertWith (const (f . Just)) k (f Nothing) $ m

-- | Does the actual knot-tying. Creates a new data structure
-- where the references to nodes are replaced by the actual data.
tie :: (Ord k, Functor v) => Loader k v -> Map k (Fix v)
tie (Loader m) = Map.map (anam' $ \k -> fromJust (Map.lookup k m)) m


-- -----------------------------------------------------------------
-- Usage example:

data NodeF n t = NodeF n [t]
instance Functor (NodeF n) where
    fmap f (NodeF n xs) = NodeF n (map f xs)

-- A data structure isomorphic to Fix (NodeF n), but easier to work with.
data Node n = Node n [Node n]
  deriving Show
-- The isomorphism that does the conversion.
nodeunfix :: Fix (NodeF n) -> Node n
nodeunfix = catam (\(NodeF n ts) -> Node n ts)

main :: IO ()
main = do
    -- Each node description consist of an integer ID and a list of other nodes
    -- it references.
    let lss = 
            [ (1, [4])
            , (2, [1])
            , (3, [2, 1])
            , (4, [3, 2, 1])
            , (5, [5])
            ]
    print lss
    -- Fill a new loader with the data:
    let
        loader = foldr f empty lss
        f (label, dependsOn) = update label (NodeF label dependsOn)
    -- Tie the knot:
    let tied' = tie loader
    -- And convert Fix (NodeF n) into Node n:
    let tied = Map.map nodeunfix tied'

    -- For each node print the label of the first node it references
    -- and the count of all referenced nodes.
    print $ Map.map (\(Node n ls@((Node n1 _) : _)) -> (n1, length ls)) tied

文章来源: Tying the Knot with a State monad