Haskell:存在类型和IO

时间:2014-09-08 16:00:28

标签: haskell existential-type

  

Cross-posted at Code Review SE

在我尝试掌握Haskell中的存在类型时,我决定实现一个基于整数的固定长度矢量数据类型。我正在使用ghc 7.8.3。

具体来说,我想写一个程序,询问用户可能的新值附加到固定长度的向量,然后显示结果向量。

首先我写了这个程序的第一个版本:

{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types                #-}

import System.IO (hFlush, stdout)

data Z
data S n

data Vect n where
    ZV :: Vect Z
    CV :: Int -> Vect n -> Vect (S n)

data AnyVect = forall n. AnyVect (Vect n)

instance Show (Vect n) where
    show ZV = "Nil"
    show (CV x v) = show x ++ " : " ++ show v

vecAppend :: Int -> Vect n -> Vect (S n)
vecAppend x ZV = CV x ZV
vecAppend x v = CV x v

appendElem :: AnyVect -> IO AnyVect
appendElem (AnyVect v) = do
    putStr "> "
    hFlush stdout
    x <- readLn

    return $ if x == 0 then AnyVect v else AnyVect $ vecAppend x v

main = do
    AnyVect v <- appendElem $ AnyVect ZV
    putStrLn $ show v

按预期工作。然后我决定摆脱不必要的AnyVect:

{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types                #-}

import System.IO (hFlush, stdout)

data Z
data S n

data Vect n where
    ZV :: Vect Z
    CV :: Int -> Vect n -> Vect (S n)

instance Show (Vect n) where
    show ZV = "Nil"
    show (CV x v) = show x ++ " : " ++ show v

vecAppend :: Int -> Vect n -> Vect (S n)
vecAppend x ZV = CV x ZV
vecAppend x v = CV x v

appendElem :: Vect n -> (forall n. Vect n -> a) -> IO a
appendElem v f = do
    putStr "> "
    hFlush stdout
    x <- readLn

    return $ if x == 0 then f v else f $ vecAppend x v

main = do
    appendElem ZV show >>= putStrLn

也可以,即使我不太喜欢main的写法。

有没有其他更简单/更清晰的方式来编写它?

1 个答案:

答案 0 :(得分:1)

如果您不想在GHC 7.8中使用新的TypeLits,您仍然可以使用DataKinds改进代码并进行典型的重构以将IO和纯粹分开代码。

{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}

import System.IO (hFlush, stdout)

data Nat = Z | S Nat -- using DataKinds to promote Z and S to type level

-- don't restrict ourselves to only Vec of Int, we can be more general
data Vec (n :: Nat) a where
    Nil  :: Vec Z a
    Cons :: a -> Vec n a -> Vec (S n) a

instance Show a => Show (Vec n a) where
    show Nil = "Nil"
    show (Cons a v) = show a ++ " : " ++ show v

-- vecAppend in the OP, append is usually reserved for functions that
-- look like `Vec n a -> Vec m a -> Vec (n + m) a`
cons :: a -> Vec n a -> Vec (S n) a
cons = Cons

-- refactor the IO related code into a separate function
prompt :: IO Int
prompt = do
    putStr "> "
    hFlush stdout
    readLn

-- the "if 0 then ... else ..." could also be refactored into a separate 
-- function that takes a initial Vec as input
main = do
    x <- prompt
    if x == 0
    then print (Nil :: Vec Z Int)
    else print (cons x Nil)