我一直在使用免费的monad来构建DSL。作为语言的一部分,有一个input
命令,目的是反映类型级别的输入原语所期望的类型,以提高安全性。
例如,我希望能够编写以下程序。
concat :: Action '[String, String] ()
concat = do
(x :: String) <- input
(y :: String) <- input
output $ x ++ " " ++ y
与评估功能一起
eval :: Action params res -> HList params -> [String]
eval = ...
以下列方式运作..
> eval concat ("a" `HCons` "b" `HCons` HNil)
["a b"]
这是我到目前为止所拥有的。
data HList i where
HNil :: HList '[]
HCons :: h -> HList t -> HList (h ': t)
type family Append (a :: [k]) (b :: [k]) :: [k] where
Append ('[]) l = l
Append (e ': l) l' = e ': (Append l l')
data ActionF next where
Input :: (a -> next) -> ActionF next
Output :: String -> next -> ActionF next
instance Functor ActionF where
fmap f (Input c) = Input (fmap f c)
fmap f (Output s n) = Output s (f n)
data FreeIx f i a where
Return :: a -> FreeIx f '[] a
Free :: f (FreeIx f i a) -> FreeIx f i a
type Action i a = FreeIx ActionF i a
liftF :: Functor f => f a -> FreeIx f i a
liftF = Free . fmap Return
input :: forall a . Action '[a] a
input = liftF (Input id)
output :: String -> Action '[] ()
output s = liftF (Output s ())
bind :: Functor f => FreeIx f t a -> (a -> FreeIx f v b) -> FreeIx f (Append t v) b
bind (Return a) f = f a
bind (Free x) f = Free (fmap (flip bind f) x)
问题是liftF
没有输入检查。
liftF :: Functor f => Proxy i -> f a -> FreeIx f i a
liftF p = Free . fmap Return
这是正确的方法吗?
我认为一些灵感可能来自effect monad包。这导致了Return
和Free
的定义。
对于更多的背景故事:我已经在几个地方看到用户将以这种方式定义DSL,然后定义评估函数eval :: Action a -> [String] -> a
或类似的东西。这种方法的明显问题是所有参数必须具有相同的类型,并且没有静态保证将提供正确数量的参数。这是试图解决这个问题。
答案 0 :(得分:15)
我找到了解决这个问题的满意方案。这是对最终结果的预见:
addTwo = do
(x :: Int) <- input
(y :: Int) <- input
output $ show (x + y)
eval (1 ::: 2 ::: HNil) addTwo = ["3"]
完成此操作需要大量步骤。首先,我们需要观察ActionF
数据类型本身已编入索引。我们将使用免费的monoid列表来调整FreeIx
来构建索引monad。 Free
的{{1}}构造函数需要捕获其两个索引之一的有限性的见证用于证明。我们将使用system due to András Kovács for writing proofs about appending type level lists来证明关联性和正确的身份。我们将describe indexed monads in the same manner as Oleg Grenrus。我们将使用FreeIx
扩展名使用普通RebindbableSyntax
表示法为IxMonad
编写表达式。
除了您的示例已经要求的所有扩展以及上面提到的do
之外,我们还需要RebindbableSyntax
来重复使用类型系列定义。
UndecidableInstances
我们将使用:~:
GADT from Data.Type.Equality
来操纵类型相等。
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RebindableSyntax #-}
由于我们将重新绑定import Data.Type.Equality
import Data.Proxy
语法,因此我们会隐藏Monad
导入中的所有Monad
。 Prelude
扩展名用于RebindableSyntax
符号,无论函数do
,>>=
和>>
是否在范围内。
fail
我们还有一些新的通用库代码。我给了import Prelude hiding (Monad, (>>=), (>>), fail, return)
一个中缀构造函数HList
。
:::
我已重命名data HList i where
HNil :: HList '[]
(:::) :: h -> HList t -> HList (h ': t)
infixr 5 :::
类型系列Append
以镜像列表中的++
运算符。
++
讨论type family (++) (a :: [k]) (b :: [k]) :: [k] where
'[] ++ l = l
(e ': l) ++ l' = e ': l ++ l'
形式的约束很有用。这些不存在于GADT之外的forall i. Functor (f i)
内,可捕获the Dict
GADT in constraints等约束。出于我们的目的,仅使用额外忽略的参数定义Haskell
的版本就足够了。
Functor
class Functor1 (f :: k -> * -> *) where
fmap1 :: (a -> b) -> f i a -> f i b
ActionF
遗漏了某些内容,无法捕获有关方法要求的类型级别信息。我们将添加一个额外的索引类型Functor
来捕获它。 i
需要一种类型Input
,而'[a]
不需要任何类型Output
。我们将这个新类型参数称为仿函数的索引。
'[]
我们会为data ActionF i next where
Input :: (a -> next) -> ActionF '[a] next
Output :: String -> next -> ActionF '[] next
撰写Functor
和Functor1
个实例。
ActionF
我们将对instance Functor (ActionF i) where
fmap f (Input c) = Input (fmap f c)
fmap f (Output s n) = Output s (f n)
instance Functor1 ActionF where
fmap1 f = fmap f
进行两项更改。我们将改变索引的构造方式。 FreeIx
构造函数将引用底层仿函数的索引,并生成一个Free
,其索引是来自底层的索引的自由monoidal sum(FreeIx
)仿函数和包裹++
的索引。我们还要求FreeIx
抓住证人证明底层函子的索引是有限的。
Free
我们可以为data FreeIx f (i :: [k]) a where
Return :: a -> FreeIx f '[] a
Free :: (WitnessList i) => f i (FreeIx f j a) -> FreeIx f (i ++ j) a
定义Functor
和Functor1
个实例。
FreeIx
如果我们想将instance (Functor1 f) => Functor (FreeIx f i) where
fmap f (Return a) = Return (f a)
fmap f (Free x) = Free (fmap1 (fmap f) x)
instance (Functor1 f) => Functor1 (FreeIx f) where
fmap1 f = fmap f
与普通的无索引函子一起使用,我们可以将这些值提升为无约束的索引函子FreeIx
。这个答案不需要这样做。
IxIdentityT
我们需要证明有关附加类型级别列表的两个属性。为了写data IxIdentityT f i a = IxIdentityT {runIxIdentityT :: f a}
instance Functor f => Functor (IxIdentityT f i) where
fmap f = IxIdentityT . fmap f . runIxIdentityT
instance Functor f => Functor1 (IxIdentityT f) where
fmap1 f = fmap f
,我们需要证明正确的身份liftF
。我们将此证明xs ++ '[] ~ xs
称为附加权限身份。为了撰写appRightId
,我们需要证明关联性bind
,我们称之为xs ++ (yz ++ zs) ~ (xs ++ ys) ++ zs
。
证明是根据后继列表编写的,后者列表基本上是代理列表,每种类型appAssoc
一个。
type SList xs ~ HFMap Proxy (HList xs)
以下相关性证明以及撰写此证明的方法是
due to András Kovács。通过仅使用data SList (i :: [k]) where
SNil :: SList '[]
SSucc :: SList t -> SList (h ': t)
作为我们解构的SList
类型列表并将xs
用于其他类型列表,我们可以延迟(可能无限期地)需要Proxy
个WitnessList
个实例{1}}和ys
。
zs
appAssoc ::
SList xs -> Proxy ys -> Proxy zs ->
(xs ++ (ys ++ zs)) :~: ((xs ++ ys) ++ zs)
appAssoc SNil ys zs = Refl
appAssoc (SSucc xs) ys zs =
case appAssoc xs ys zs of Refl -> Refl
是Refl
的构造函数,只有在编译器拥有两种类型相等的证据时才能构造。 :~:
上的模式匹配将类型相等的证明引入当前范围。
我们可以用类似的方式证明正确的身份
Refl
为了使用这些证明,我们为有限类型列表类构建见证列表。
appRightId :: SList xs -> xs :~: (xs ++ '[])
appRightId SNil = Refl
appRightId (SSucc xs) = case appRightId xs of Refl -> Refl
配备class WitnessList (xs :: [k]) where
witness :: SList xs
instance WitnessList '[] where
witness = SNil
instance WitnessList xs => WitnessList (x ': xs) where
witness = SSucc witness
我们可以将基础仿函数的提升值定义为appRightId
。
FreeIx
显式liftF :: forall f i a . (WitnessList i, Functor1 f) => f i a -> FreeIx f i a
liftF = case appRightId (witness :: SList i) of Refl -> Free . fmap1 Return
适用于forall
。 ScopedTypeVariables
构造函数和WitnessList i
都需要证明索引的有限性Free
。 appRightId
的证明用于说服编译器构造的appRightId
与FreeIx f (i ++ '[]) a
的类型相同。 FreeIx f i a
来自'[]
,它包含在底层仿函数中。
我们的两个命令Return
和input
是按output
编写的。
liftF
要使用type Action i a = FreeIx ActionF i a
input :: Action '[a] a
input = liftF (Input id)
output :: String -> Action '[] ()
output s = liftF (Output s ())
,我们将RebindableSyntax
类定义为具有相同的函数名IxMonad
,(>>=)
和(>>)
作为{{1}但是不同的类型。这个类在Oleg Grenrus's answer中描述。
fail
为Monad
实施class Functor1 m => IxMonad (m :: k -> * -> *) where
type Unit :: k
type Plus (i :: k) (j :: k) :: k
return :: a -> m Unit a
(>>=) :: m i a -> (a -> m j b) -> m (Plus i j) b
(>>) :: m i a -> m j b -> m (Plus i j) b
a >> b = a >>= const b
fail :: String -> m i a
fail s = error s
需要相关性证明bind
。范围中唯一的FreeIx
实例appAssoc
是由解构的WitnessList
构造函数捕获的实例。同样,明确的WitnessList i
适用于Free
。
forall
ScopedTypeVariables
是bind :: forall f i j a b. (Functor1 f) => FreeIx f i a -> (a -> FreeIx f j b) -> FreeIx f (i ++ j) b
bind (Return a) f = f a
bind (Free (x :: f i1 (FreeIx f j1 a))) f =
case appAssoc (witness :: SList i1) (Proxy :: Proxy j1) (Proxy :: Proxy j)
of Refl -> Free (fmap1 (`bind` f) x)
bind
个实例中唯一有趣的部分。
IxMonad
所有困难的部分都已完成。我们可以用最直接的方式为FreeIx
编写一个简单的解释器。唯一需要的技巧是避免instance (Functor1 f) => IxMonad (FreeIx f) where
type Unit = '[]
type Plus i j = i ++ j
return = Return
(>>=) = bind
构造函数Action xs ()
上的模式匹配,直到知道类型列表HList
非空为止,因为我们已在:::
上匹配。
i
如果您对Input
eval :: HList i -> Action i () -> [String]
eval inputs action =
case action of
Return () -> []
Free (Input f) ->
case inputs of
(x ::: xs) -> eval xs (f x)
Free (Output s next) -> s : eval inputs next
它是
addTwo
答案 1 :(得分:11)
我有一个简单且通用的新解决方案。
到目前为止,在线程中我们使用了由monoid索引的monad,但是在这里我依赖于索引monad的另一个流行概念,即具有typestate转换的那个(Hoare逻辑风格):
return :: a -> m i i a
(>>=) :: m i j a -> (a -> m j k b) -> m i k b
我相信这两种方法是等价的(至少在理论上),因为我们通过使用内同态monoid索引来获得Hoare monad,并且我们也可以通过CPS编码在状态转换中的monoidal附加来反向。在实践中,Haskell的类型级和类级语言相当弱,因此在两个表示之间来回移动不是一种选择。
>>=
的上述类型存在问题:它意味着我们必须以自上而下的顺序计算类型状态,即。即它强制IxFree
的以下定义:
data IxFree f i j a where
Pure :: a -> IxFree f i i a
Free :: f i j (IxFree f j k a) -> IxFree f i k a
因此,如果我们有一个Free exp
表达式,那么我们首先从i
转换为j
,然后从exp
的构造函数转换为j
,然后从k
获取通过检查exp
的子表达式来input
。这意味着如果我们尝试在列表中累积-- compute transitions top-down
test = do
(x :: Int) <- input -- prepend Int to typestate
(y :: String) <- input -- prepend String to typestate
return () -- do nothing
类型,我们最终会得到一个反向列表:
eval
如果我们将类型附加到列表的末尾,则顺序是正确的。但是在Haskell中完成这项工作(尤其是使{-# LANGUAGE
RebindableSyntax, DataKinds,
GADTs, TypeFamilies, TypeOperators,
PolyKinds, StandaloneDeriving, DeriveFunctor #-}
import Prelude hiding (Monad(..))
class IxFunctor (f :: ix -> ix -> * -> *) where
imap :: (a -> b) -> f i j a -> f i j b
class IxFunctor m => IxMonad (m :: ix -> ix -> * -> *) where
return :: a -> m i i a
(>>=) :: m j k a -> (a -> m i j b) -> m i k b -- note the change of index orders
(>>) :: m j k a -> m i j b -> m i k b -- here too
a >> b = a >>= const b
fail :: String -> m i j a
fail = error
data IxFree f i j a where
Pure :: a -> IxFree f i i a
Free :: f j k (IxFree f i j a) -> IxFree f i k a -- compute bottom-up
instance IxFunctor f => Functor (IxFree f i j) where
fmap f (Pure a) = Pure (f a)
fmap f (Free fa) = Free (imap (fmap f) fa)
instance IxFunctor f => IxFunctor (IxFree f) where
imap = fmap
instance IxFunctor f => IxMonad (IxFree f) where
return = Pure
Pure a >>= f = f a
Free fa >>= f = Free (imap (>>= f) fa)
liftf :: IxFunctor f => f i j a -> IxFree f i j a
liftf = Free . imap Pure
工作)需要大量的校对,如果可能的话。
让我们自下而上计算类型状态。它使得我们根据语法树构建一些数据结构的各种计算更加自然,特别是它使我们的工作变得非常容易。
Action
现在实施data ActionF i j next where
Input :: (a -> next) -> ActionF i (a ': i) next
Output :: String -> next -> ActionF i i next
deriving instance Functor (ActionF i j)
instance IxFunctor ActionF where
imap = fmap
type family (++) xs ys where -- I use (++) here only for the type synonyms
'[] ++ ys = ys
(x ': xs) ++ ys = x ': (xs ++ ys)
type Action' xs rest = IxFree ActionF rest (xs ++ rest)
type Action xs a = forall rest. IxFree ActionF rest (xs ++ rest) a
input :: Action '[a] a
input = liftf (Input id)
output :: String -> Action '[] ()
output s = liftf (Output s ())
data HList i where
HNil :: HList '[]
(:::) :: h -> HList t -> HList (h ': t)
infixr 5 :::
eval :: Action' xs r a -> HList xs -> [String]
eval (Pure a) xs = []
eval (Free (Input k)) (x ::: xs) = eval (k x) xs
eval (Free (Output s nxt)) xs = s : eval nxt xs
addTwice :: Action [Int, Int] ()
addTwice = do
x <- input
y <- input
output (show $ x + y)
变得简单了。
Action' xs rest a
为了减少对用户的混淆,我引入了具有友好索引方案的类型同义词:xs
表示该操作从rest
读取,并且可能后跟包含Action
读取的操作。 data IxStateF i j next where
Put :: j -> next -> IxStateF j i next
Get :: (i -> next) -> IxStateF i i next
deriving instance Functor (IxStateF i j)
instance IxFunctor IxStateF where imap = fmap
put s = liftf (Put s ())
get = liftf (Get id)
type IxState i j = IxFree IxStateF j i
evalState :: IxState i o a -> i -> (a, o)
evalState (Pure a) i = (a, i)
evalState (Free (Get k)) i = evalState (k i) i
evalState (Free (Put s k)) i = evalState k s
test :: IxState Int String ()
test = do
n <- get
put (show $ n * 100)
是一个类型同义词,等同于线程问题中出现的同义词。
我们可以用这种方法实现各种DSL-s。反向打字顺序给它一点旋转,但我们可以做通常的索引monad所有相同。这是索引状态monad,例如:
VerifiedMonoid
现在,我相信这种方法比使用monoids进行索引更实际,因为Haskell没有类型类或一流类型级函数可以使monoid方法变得可口。如Idris
或Agda
这样的FreeIx
课程会更好,其中包括除了常用方法之外的正确性证明。这样我们就可以编写一个{{1}},它在选择索引monoid时是通用的,而不仅限于提升列表或其他内容。
答案 2 :(得分:5)
关于索引monad的简短说明:它们是由monoids索引的monad。对于比较默认monad:
class Monad m where
return :: a -> m a
bind :: m a -> (a -> m b) -> m b
-- or `bind` alternatives:
fmap :: (a -> b) -> m a -> m b
join :: m (m a) -> m a
monoid是一种配有mempty
- 标识元素和(<>) :: a -> a -> a
二元关联操作的类型。提升到类型级别,我们可以有Unit
类型和Plus
关联二进制类型操作。请注意,列表是值级别的免费monoid,HList
是类型级别。
现在我们可以定义索引的monoid类:
class IxMonad m where
type Unit
type Plus i j
return :: a -> m Unit a
bind :: m i a -> (a -> m j b) -> m (Plus i j) b
--
fmap :: (a -> b) -> m i a -> m i b
join :: m i (m j a) -> m (Plus i j) a
您可以为索引版本说明monad法律。您会注意到,对于要对齐的索引,它们必须遵守幺半群定律。
使用免费monad,你需要装备Functor
return
和join
个操作。稍微改变你的定义:
data FreeIx f i a where
Return :: a -> FreeIx f '[] a -- monoid laws imply we should have `[] as index here!
Free :: f (FreeIx f k a) -> FreeIx f k a
bind :: Functor f => FreeIx f i a -> (a -> FreeIx f j b) -> FreeIx f (Append i j) b
bind (Return a) f = f a
bind (Free x) f = Free (fmap (flip bind f) x)
我必须承认,我并非100%确定Free
构造函数索引的合理性,但它们似乎有效。如果我们将wrap :: f (m a) -> m a
类的函数MonadFree
与法律一起考虑:
wrap (fmap f x) ≡ wrap (fmap return x) >>= f
以及对Free
包
free
的评论
在实践中,您只需查看
Free f
f
个a
个(>>=)
层,其中f
执行替换并移植新的图层每个自由变量f
。
然后我们的想法是包装值不会影响索引。
但是,您希望将任何'[]
值提升到任意索引的monadic值。这是一个非常合理的要求。但唯一有效的定义强制提升价值Unit
- mempty
或liftF :: Functor f => f a -> FreeIx f '[] a
liftF = Free . fmap Return
索引:
Return
如果您尝试将:: a -> FreeIx f k a
定义更改为k
([]
,而不是bind
- 纯值可能有任意索引),那么data FreeIx m i a where
FreeIx :: m a -> FreeIx m k a
liftF :: Proxy i -> f a -> FreeIx f i a
liftF _ = FreeIx
returnIx :: Monad m => a -> FreeIx m i a
returnIx = FreeIx . return
bind :: Monad m => FreeIx m i a -> (a -> FreeIx m j b) -> FreeIx m (Append i j) b
bind (FreeIx x) f = FreeIx $ x >>= (\x' -> case f x' of
FreeIx y -> y)
定义不会进行类型检查。
我不确定您是否可以使免费索引monad仅使用小修正。一个想法是将任意monad提升为索引monad:
Functor
这种方法感觉有点像作弊,因为我们总是可以重新索引价值。
另一种方法是提醒 {{1}}它是一个索引编写器,或者使用索引编写器立即开始,如Cirdec's answer。
答案 3 :(得分:5)
如果您愿意牺牲隐式排序并使用显式访问者,则可以使用Action '[Int, Int]
实现ReaderT (HList '[Int, Int])
。如果您使用提供镜头的vinyl
等现有库,您可以编写如下内容:
-- Implemented with pseudo-vinyl
-- X and Y are Int fields, with accessors xField and yField
addTwo :: ReaderT (PlainRec '[X, Y]) Output ()
addTwo = do
x <- view (rGet xField)
y <- view (rGet yField)
lift . output $ show (x + y) -- output :: String -> Output ()
通过约束传播强制执行类型安全:rGet xField
引入了X
成为记录成员的要求。
对于没有类型级机械的简单说明,请比较:
addTwo :: ReaderT (Int, Int) IO ()
addTwo = do
x <- view _1
y <- view _2
lift . putStrLn $ show (x + y)
我们失去了排序属性,这是一个重大损失,特别是如果排序有意义,例如表示用户交互的顺序。
此外,我们现在 使用runReaderT
(〜eval
)。我们不能将用户输入与输出交错。
答案 4 :(得分:3)
编辑:我发布了更为一般的alternative answer。我离开 这个答案现在在这里,因为它可能是一个有用的例子 手工构建目标monad。
我的解决方案符合OP所要求的(尽管它涉及手动monad实例编写,因此当然还有改进的空间)。
effect-monad
包(提到的OP)已经包含处理来自HList
的读取的效果。它被称为ReadOnceReader
。但是,对于Writer
,我们还需要Output
效果,在我看来,图书馆并没有让我们将这两者结合起来。
我们仍然可以理解ReadOnceReader
并手动为所需语言编写AST。当然,AST应该是一个索引的monad。如果我们也可以通过索引的免费monad或操作monad来做到这一点,那将是很好的。到目前为止,我还没有获得过免费monad的成功。在查看运营单子后,我可能会更新我的答案。
预赛:
{-# LANGUAGE
RebindableSyntax, DataKinds, ScopedTypeVariables,
GADTs, TypeFamilies, TypeOperators,
PolyKinds, StandaloneDeriving, DeriveFunctor #-}
import Prelude hiding (Monad(..))
data HList (xs :: [*]) where
Nil :: HList '[]
(:>) :: x -> HList xs -> HList (x ': xs)
infixr 5 :>
type family (++) (xs :: [*]) (ys :: [*]) where
'[] ++ ys = ys
(x ': xs) ++ ys = x ': (xs ++ ys)
索引monad必须提供一种方法来组合(Plus
)索引和身份(Unit
)。简而言之,指数应该是幺半群。
class IxMonad (m :: k -> * -> *) where
type Unit m :: k
type Plus m (i :: k) (j :: k) :: k
return :: a -> m (Unit m) a
(>>=) :: m i a -> (a -> m j b) -> m (Plus m i j) b
fail :: m i a
这里感兴趣的是Input
的类型:我们将输入类型添加到下一次计算的结果索引中:
data Action i a where
Return :: a -> Action '[] a
Input :: (x -> Action xs a) -> Action (x ': xs) a
Output :: String -> Action i a -> Action i a
deriving instance Functor (Action i)
IxMonad
实例和智能构造函数是完全标准的,eval
函数也是直接实现的。
instance IxMonad Action where
type Unit Action = '[]
type Plus Action i j = i ++ j
return = Return
Return a >>= f = f a
Input k >>= f = Input ((>>= f) . k)
Output s nxt >>= f = Output s (nxt >>= f)
fail = undefined
input :: Action '[a] a
input = Input Return
output :: String -> Action '[] ()
output s = Output s (Return ())
eval :: Action xs a -> HList xs -> [String]
eval (Return a) xs = []
eval (Input k) (x :> xs) = eval (k x) xs
eval (Output s nxt) xs = s : eval nxt xs
现在一切都按预期工作:
concat' :: Action '[String, String] ()
concat' = do
(x :: String) <- input
(y :: String) <- input
output $ x ++ " " ++ y
main = print $ eval concat' ("a" :> "b" :> Nil)
-- prints ["a b"]
答案 5 :(得分:1)
几年前我在github上有一个索引的免费monad的工作实现:
https://github.com/ekmett/indexed/blob/master/src/Indexed/Monad/Free.hs
它使用Conor McBride在Kleisli Arrows of Outrageous Fortune中提出的索引monad的形式,并且可以适应以本文所述的方式提供Bob Atkey风格的2索引免费monad。