如何为类型系列的唱片制作镜头

时间:2017-01-04 05:35:50

标签: haskell lens type-families lenses

这是我得到的,没有编译的内容:

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}

import Data.Text as T
import Data.Int (Int64)
import Control.Lens

type family Incoming validationResult baseType
type instance Incoming Validated baseType = baseType
type instance Incoming ValidationErrors baseType = Either [T.Text] baseType

data Validated
data ValidationErrors

data Tag = Tag {unTag :: T.Text} deriving (Eq, Show)

data NewTag f = NewTag
  {
    ntClientId :: Incoming f Int64
  , ntTag :: Incoming f Tag
  }

$(makeLensesWith abbreviatedFields ''NewTag)

编译错误:

27   3 error           error:
 • Illegal type synonym family application in instance:
     Incoming f_a1Kvx Int64
 • In the instance declaration for
     ‘HasClientId (NewTag f_a1Kvx) (Incoming f_a1Kvx Int64)’ (intero)
27   3 error           error:
 • Illegal type synonym family application in instance:
     Incoming f_a1Kvx Tag
 • In the instance declaration for
     ‘HasTag (NewTag f_a1Kvx) (Incoming f_a1Kvx Tag)’ (intero)

1 个答案:

答案 0 :(得分:3)

这里的问题是makeLensesFor将尝试按如下方式生成实例:

instance HasClientId (NewTag f) (Incoming f Int64) where
  ....

但是,这是一个错误,因为您无法为类型系列应用程序的结果创建实例。为避免这种情况,我们可以为f的两个可能选项中的每一个手动编写实例:

-- generate lenses _foo for each record selector foo
-- (in this case, generates _ntClientId and _ntTag lenses)
makeLensesWith (lensRules & lensField .~ mappingNamer (\x -> ['_' : x])) ''NewTag

class HasClientId s a | s -> a where
  clientId :: Lens' s a

instance HasClientId (NewTag Validated) Int64 where
  clientId = _ntClientId

instance HasClientId (NewTag ValidationErrors) (Either [T.Text] Int64) where
  clientId f a = f (ntClientId a) <&> \ntClientId' -> a { ntClientId = ntClientId' }

class HasTag s a | s -> a where
  tag :: Lens' s a

instance HasTag (NewTag Validated) Tag where
  tag = _ntTag

instance HasTag (NewTag ValidationErrors) (Either [T.Text] Tag) where
  tag = _ntTag