Question

我正在尝试在Haskell中创建一个类型安全的问答流程。我将QnA建模为有向图，类似于FSM。

图表中的每个节点都代表一个问题：

data Node s a s' = Node {
  question :: Question a,
  process :: s -> a -> s'
}

s是输入状态，a是问题的答案，s'是输出状态。节点取决于输入状态s，这意味着为了处理答案，我们必须处于特定状态之前。

Question a代表一个简单的问题/答案，产生a类型的答案。

类型安全我的意思是，例如，如果给定节点Node2 :: si -> a -> s2，如果si依赖于s1，则所有以Node2结尾的路径必须通过首先生成s1的节点。（如果s1 == si则Node2的所有前任必须生成s1。）

示例

QnA：在网上购物网站，我们需要询问用户的体型和喜欢的颜色。

e1：询问用户是否知道自己的身材。如果是，请转到e2，否则转到e3
e2：询问用户的尺寸，然后转到ef询问颜色。
e3 :(用户不知道其大小），询问用户的体重并转到e4。
e4 :(在e3之后）询问用户的身高并计算其大小并转到ef.
ef：询问用户最喜欢的颜色，并使用Final结果完成流程。

在我的模型中，Edge将Node互相连接：

data Edge s sf where
  Edge  :: EdgeId -> Node s a s' -> (s' -> a -> Edge s' sf) -> Edge s sf
  Final :: EdgeId -> Node s a s' -> (s' -> a -> sf) -> Edge s sf

sf是QnA的最终结果，即：(Bool, Size, Color)。

每个时刻的QnA状态可以用元组表示：(s, EdgeId)。这种状态是可序列化的，我们应该能够通过了解这种状态来继续QnA。

saveState :: (Show s) => (s, Edge s sf) -> String
saveState (s, Edge eid n _) = show (s, eid)

getEdge :: EdgeId -> Edge s sf
getEdge = undefined --TODO

respond :: s -> Edge s sf -> Input -> Either sf (s', Edge s' sf)
respond s (Edge ...) input = Right (s', Edge ...)
respond s (Final ...) input = Left s' -- Final state

-- state = serialized (s, EdgeId)
-- input = user's answer to the current question
main' :: String -> Input -> Either sf (s', Edge s' sf)
main' state input =
  let (s, eid) = read state :: ((), EdgeId) --TODO
      edge = getEdge eid
  in respond s input edge

完整代码：

{-# LANGUAGE GADTs, RankNTypes, TupleSections #-}

type Input = String
type Prompt = String
type Color = String
type Size = Int
type Weight = Int
type Height = Int

data Question a = Question {
  prompt :: Prompt,
  answer :: Input -> a
}

-- some questions 
doYouKnowYourSizeQ :: Question Bool
doYouKnowYourSizeQ = Question "Do you know your size?" read

whatIsYourSizeQ :: Question Size
whatIsYourSizeQ = Question "What is your size?" read

whatIsYourWeightQ :: Question Weight
whatIsYourWeightQ = Question "What is your weight?" read

whatIsYourHeightQ :: Question Height
whatIsYourHeightQ = Question "What is your height?" read

whatIsYourFavColorQ :: Question Color
whatIsYourFavColorQ = Question "What is your fav color?" id

-- Node and Edge

data Node s a s' = Node {
  question :: Question a,
  process :: s -> a -> s'
}

data Edge s sf where
  Edge  :: EdgeId -> Node s a s' -> (s' -> a -> Edge s' sf) -> Edge s sf
  Final :: EdgeId -> Node s a s' -> (s' -> a -> sf) -> Edge s sf

data EdgeId = E1 | E2 | E3 | E4 | Ef deriving (Read, Show)

-- nodes

n1 :: Node () Bool Bool
n1 = Node doYouKnowYourSizeQ (const id)

n2 :: Node Bool Size (Bool, Size)
n2 = Node whatIsYourSizeQ (,)

n3 :: Node Bool Weight (Bool, Weight)
n3 = Node whatIsYourWeightQ (,)

n4 :: Node (Bool, Weight) Height (Bool, Size)
n4 = Node whatIsYourHeightQ (\ (b, w) h -> (b, w * h))

n5 :: Node (Bool, Size) Color (Bool, Size, Color)
n5 = Node whatIsYourFavColorQ (\ (b, i) c -> (b, i, c))


-- type-safe edges

e1 = Edge E1 n1 (const $ \ b -> if b then e2 else e3)
e2 = Edge E2 n2 (const $ const ef)
e3 = Edge E3 n3 (const $ const e4)
e4 = Edge E4 n4 (const $ const ef)
ef = Final Ef n5 const


ask :: Edge s sf -> Prompt
ask (Edge _ n _) = prompt $ question n
ask (Final _ n _) = prompt $ question n

respond :: s -> Edge s sf -> Input -> Either sf (s', Edge s' sf)
respond s (Edge _ n f) i =
  let a  = (answer $ question n) i
      s' = process n s a
      n' = f s' a
  in Right undefined --TODO n'

respond s (Final _ n f) i =
  let a  = (answer $ question n) i
      s' = process n s a
  in Left undefined --TODO s'


-- User Interaction:

saveState :: (Show s) => (s, Edge s sf) -> String
saveState (s, Edge eid n _) = show (s, eid)

getEdge :: EdgeId -> Edge s sf
getEdge = undefined --TODO

-- state = serialized (s, EdgeId) (where getEdge :: EdgeId -> Edge s sf)
-- input = user's answer to the current question
main' :: String -> Input -> Either sf (s', Edge s' sf)
main' state input =
  let (s, eid) = undefined -- read state --TODO
      edge = getEdge eid
  in respond s edge input

保持边缘类型安全对我来说很重要。例如错误地将e2链接到e3的含义必须是类型错误：e2 = Edge E2 n2 (const $ const ef)很好e2 = Edge E2 n2 (const $ const e3)必须是错误。

我已用--TOOD表示我的问题：

根据我保持边缘类型安全的条件，Edge s sf必须有一个输入类型变量（s），那么我该如何创建getEdge :: EdgeId -> Edge s sf函数？
如何创建给定当前状态respond和当前边s的{{1}}函数，将返回最终状态（如果当前边缘为{{1} }}或下一个状态和下一个边Edge s sf？

我对Final和(s', Edge s' sf)的设计可能完全错误。我不必坚持下去。

Answer 1

为了有一个简单的例子来解释，我将向您展示一个解决方案，该解决方案不具有暂停，持久和恢复计算的自然支持。最后，我将向您介绍如何添加它的要点 - 希望您能够自己弄清楚它的细节。

这里是所谓的索引状态monad ：

newtype IStateT m i o a = IStateT { runIState :: i -> m (o, a) }

IStateT类似于常规状态monad变换器，除了允许隐式状态的类型在整个计算过程中改变。索引状态monad中的排序操作要求一个动作的输出状态与下一个动作的输入状态匹配。这种类似多米诺骨牌的排序是Atkey's parameterised monad（或indexed monad）的用途。

class IMonad m where
    ireturn :: a -> m i i a
    (>>>=) :: m i j a -> (a -> m j k b) -> m i k b

(>>>) :: IMonad m => m i j a -> m j k b -> m i k b
mx >>> my = mx >>>= \_ -> my

IMonad是类似monad的类，它描述了索引图形的路径。 (>>>=)的类型表示＆＃34;如果您的计算从i变为j，计算从j变为k，我可以加入他们，为您提供从i到k＆＃34;。

的计算

我们还需要将经典monad的计算提升为索引monad：

class IMonadTrans t where
    ilift :: Monad m => m a -> t m i i a

请注意，IStateT的代码与常规状态monad的代码相同 - 它只是更智能的类型。

iget :: Monad m => IStateT m s s s
iget = IStateT $ \s -> return (s, s)

iput :: Monad m => o -> IStateT m i o ()
iput x = IStateT $ \_ -> return (x, ())

imodify :: Monad m => (i -> o) -> IStateT m i o ()
imodify f = IStateT $ \s -> return (f s, ())

instance Monad m => IMonad (IStateT m) where
    ireturn x = IStateT (\s -> return (s, x))
    IStateT f >>>= g = IStateT $ \s -> do
                                    (s', x) <- f s
                                    let IStateT h = g x
                                    h s'
instance IMonadTrans IStateT where
    ilift m = IStateT $ \s -> m >>= \x -> return (s, x)

这个想法是像askSize和askWeight（下面）这样的monadic动作将将一些数据添加到隐式环境，从而增加其类型。因此，我将使用嵌套元组构建隐式环境，将它们视为类型级别的类型列表。嵌套元组比平面元组更灵活（虽然效率更低），因为它们允许您在列表的尾部进行抽象。这允许您构建任意大小的元组。

type StateMachine = IStateT IO

newtype Size = Size Int
newtype Height = Height Int
newtype Weight = Weight Int
newtype Colour = Colour String

-- askSize takes an environment of type as and adds a Size element
askSize :: StateMachine as (Size, as) ()
askSize = askNumber "What is your size?" Size

-- askHeight takes an environment of type as and adds a Height element
askHeight :: StateMachine as (Height, as) ()
askHeight = askNumber "What is your height?" Height

-- etc
askWeight :: StateMachine as (Weight, as) ()
askWeight = askNumber "What is your weight?" Weight

askColour :: StateMachine as (Colour, as) ()
askColour =
    -- poor man's do-notation. You could use RebindableSyntax
    ilift (putStrLn "What is your favourite colour?") >>>
    ilift readLn                                      >>>= \answer ->
    imodify (Colour answer,)

calculateSize :: Height -> Weight -> Size
calculateSize (Height h) (Weight w) = Size (h - w)  -- or whatever the calculation is

askNumber :: String -> (Int -> a) -> StateMachine as (a, as) ()
askNumber question mk =
    ilift (putStrLn question) >>>
    ilift readLn              >>>= \answer ->
    case reads answer of
        [(x, _)] -> imodify (mk x,)
        _ -> ilift (putStrLn "Please type a number") >>> askNumber question mk

askYN :: String -> StateMachine as as Bool
askYN question =
    ilift (putStrLn question) >>>
    ilift readLn              >>>= \answer ->
    case answer of
        "y" -> ireturn True
        "n" -> ireturn False
        _ -> ilift (putStrLn "Please type y or n") >>> askYN question

我的实现与您的规范略有不同。你说应该不可能询问用户的大小，然后询问他们的体重。我说它应该是可能的 - 结果只是赢得了你想要的类型（因为你已经向环境中添加了两个东西，而不是一个）。这在这里非常有用，其中askOrCalculateSize只是一个黑盒子，它为环境添加了Size（并没有别的）。有时通过直接询问尺寸来做到这一点;有时它首先要求高度和重量来计算它。就类型检查而言，这并不重要。

interaction :: StateMachine xs (Colour, (Size, xs)) ()
interaction =
    askYN "Do you know your size?" >>>= \answer ->
    askOrCalculateSize answer >>>
    askColour

    where askOrCalculateSize True = askSize
          askOrCalculateSize False =
            askWeight >>>
            askHeight >>>
            imodify (\(h, (w, xs)) -> ((calculateSize h w), xs))

还有一个问题：如何从持久状态恢复计算？您不会静态地知道输入环境的类型（虽然可以安全地假设输出始终为(Colour, Size)），因为它在整个计算过程中会有所不同，并且您不会知道，直到你加载持久化状态。

诀窍是使用一些GADT证据，你可以模式匹配学习类型是什么。 Stage表示您可以在此过程中完成的任务，并且该环境应按该环境应具有的类型编制索引。 Suspended将Stage与计算暂停时环境中的实际数据配对。

data Stage as where
    AskSize :: Stage as
    AskWeight :: Stage as
    AskHeight :: Stage (Weight, as)
    AskColour :: Stage (Size, as)

data Suspended where
    Suspended :: Stage as -> as -> Suspended

resume :: Suspended -> StateMachine as (Colour, (Size, as)) ()
resume (Suspended AskSize e) =
    iput e                                               >>>
    askSize                                              >>>
    askColour
resume (Suspended AskWeight e) =
    iput e                                               >>>
    askWeight                                            >>>
    askHeight                                            >>>
    imodify (\(h, (w, xs)) -> ((calculateSize h w), xs)) >>>
    askColour
resume (Suspended AskHeight e) =
    iput e                                               >>>
    askHeight                                            >>>
    imodify (\(h, (w, xs)) -> ((calculateSize h w), xs)) >>>
    askColour
resume (Suspended AskColour e) =
    iput e                                               >>>
    askColour

现在您可以为计算添加暂停点：

-- given persist :: Suspended -> IO ()
suspend :: Stage as -> StateMachine as as ()
suspend stage =
    iget                                  >>>= \env
    ilift (persist (Suspended stage env))

resume有效，但它非常丑陋并且有很多代码重复。这是因为一旦你将状态monad放在一起，你就不能再把它拆开来看看它。您无法在计算中的给定点跳入。这是原始设计的一大优势，其中您将状态机表示为可以查询的数据结构，以便找出如何恢复计算。这称为初始编码，而我的示例（将状态机表示为函数）是 final 编码。最终编码很简单，但初始编码很灵活。希望你能看到如何使索引monad设计的初始方法适应。

型号安全流量（状态机）

1 个答案: