代码之家 › 专栏 › 技术社区 › mithrandi

在类型级别列表上进行映射

type-level-computation haskell

mithrandi · 技术社区 · 5 年前

我有一个像这样的typeclass设置:

class (KnownSymbol base, KnownSymbol quote) => FooPair base quote where
  pairVal :: Text

instance FooPair "USD" "ZAR" where
  pairVal = "USDZAR"

instance FooPair "EUR" "ZAR" where
  pairVal = "EURZAR"

现在,我也希望能够处理货币对的类型级别列表。我提出了以下方法,在列表上使用原始recession:

type Pair base quote = '(base, quote)

class Pairs ps where
  pairVals :: [Text]

instance Pairs '[] where
  pairVals = []

instance (FooPair base quote, Pairs ps) => Pairs (Pair base quote ': ps) where
  pairVals = (pairVal @base @quote : pairVals @ps)

现在我可以这样做:

Î»> pairVals @'[Pair "USD" "ZAR", Pair "EUR" "ZAR"]
["USDZAR", "EURZAR"]

然而,这感觉就像做了很多工作 map 用于值级别列表。是否有一个类型级别的等价物或其他方式来缩短它?

0 回复 | 直到 5 年前

K. A. Buhr 5 年前

定义起来可能更清晰一些 pairVal 和 pairVals 在类型级别使用类型族,然后分别考虑将结果降级回值级别。这个 singletons 这个包让这很容易。

直到他们添加 EnableEveryExtension 对于GHC,您需要启用其中一些,并添加一些导入:

{-# LANGUAGE
    AllowAmbiguousTypes
  , DataKinds
  , GADTs
  , OverloadedStrings
  , ScopedTypeVariables
  , TemplateHaskell
  , TypeApplications
  , TypeFamilies
  , UndecidableInstances
#-}

module Currency where

import Data.Singletons
import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Text (Text)

然后,您可以定义的类型级别版本 pairVal 和 pairVals 使用模板Haskell和 promote :

promote
  [d|

    pairVal :: Symbol -> Symbol -> Symbol
    pairVal "USD" "ZAR" = "USDZAR"
    pairVal "EUR" "ZAR" = "EURZAR"

    pairVals :: [(Symbol, Symbol)] -> [Symbol]
    pairVals = map (uncurry pairVal)

   |]

这已经使类型级别可用 PairVals 函数,所以在GHCi中,我们可以做:

Î»> :set -XDataKinds
Î»> :kind! PairVals '[ '("USD","ZAR"), '("EUR","ZAR") ]
PairVals '[ '("USD","ZAR"), '("EUR","ZAR") ] :: [Symbol]
= '["USDZAR", "EURZAR"]

如果你想从这些函数中获得值级结果,就像你的原始函数一样 pairVal 和 pairVals 函数,您可以使用 demote 功能由 单身汉 基础设施。例如,以下方法效果良好:

Î»> :set -XTypeApplications
Î»> demote @(PairVal "USD" "ZAR")
"USDZAR"
Î»> demote @(PairVals '[ '("USD","ZAR"), '("EUR","ZAR") ])
["USDZAR","EURZAR"]

如果你愿意,你可以编写专门版本的 降级 像这样:

pairVal' :: forall a b p. (p ~ PairVal a b, SingI p) => Text
pairVal' = demote @p

pairVals' :: forall lst ps. (ps ~ PairVals lst, SingI ps) => [Text]
pairVals' = demote @ps

请注意,这些不是提升的函数,因此它们超出了 促进 电话。然后,按照你原来的方式工作 pairVal 和 pairVals 功能:

Î»> pairVal' @"USD" @"ZAR"
"USDZAR"
Î»> pairVals' @ '[ '("USD","ZAR"), '("EUR","ZAR") ]
["USDZAR","EURZAR"]

完整代码:

{-# LANGUAGE
    AllowAmbiguousTypes
  , DataKinds
  , GADTs
  , OverloadedStrings
  , ScopedTypeVariables
  , TemplateHaskell
  , TypeApplications
  , TypeFamilies
  , UndecidableInstances
#-}

module Currency where

import Data.Singletons
import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Text (Text)

promote
  [d|

    pairVal :: Symbol -> Symbol -> Symbol
    pairVal "USD" "ZAR" = "USDZAR"
    pairVal "EUR" "ZAR" = "EURZAR"

    pairVals :: [(Symbol, Symbol)] -> [Symbol]
    pairVals = map (uncurry pairVal)

   |]

pairVal' :: forall a b p. (p ~ PairVal a b, SingI p) => Text
pairVal' = demote @p

pairVals' :: forall lst ps. (ps ~ PairVals lst, SingI ps) => [Text]
pairVals' = demote @ps

main :: IO ()
main = do
  print $ pairVal' @"USD" @"ZAR"
  print $ pairVals' @ '[ '("USD","ZAR"), '("EUR","ZAR") ]