具有不同字段的记录建模相同的逻辑类型

Question

在我的 Haskell 程序中，我需要以各种方式从 API 服务加载记录。有一个loadSmall :: IO Small 操作仅加载可用字段中的一些字段。 loadBig :: IO Big 操作会加载更多字段。未来可能需要更多“级别”的加载。

为简单起见，我们假设Big 将始终包含Small 所做的一切。

我希望函数能够以统一的方式访问该类型的这两个“版本”。我已经阅读了lenses，并认为我可能会尝试在这里使用它们，但如果有更简单的方法，我根本不会使用lens。

这是我想出的：

{-# LANGUAGE TemplateHaskell #-}
import Control.Lens

class HasSmall a where
    name :: Lens' a Text

class HasSmall a => HasBig a where
    email :: Lens' a Text

data Big = Big
    { _bigName :: Text
    , _bigEmail :: Text
    -- ...possibly many more fields
    }
    deriving Show

makeLenses ''Big

instance HasSmall Big where
    name = bigName

instance HasBig Big where
    email = bigEmail

data Small = Small
    { _smallName :: Text
    -- ...probably at least a few fields more
    }
    deriving Show

makeLenses ''Small

instance HasSmall Small where
    name = smallName

-- Function that uses name
useName :: HasSmall a => a -> Text
useName s = "Hello " <> (s ^. name)

这看起来确实像很多样板，因为现在每个新字段都必须写在至少三个地方。

有没有更有效的方法来做到这一点？

Answer 1

如果Big 应该包含Small 中也包含的所有内容，则将Small 设为Big 的字段可能是可行的：

{-# LANGUAGE RankNTypes #-}
module Main where

class HasSmall a where
    accessSmall :: (Small -> b) -> (a -> b)

data Small = Small
    { name :: String
    , address :: String
    -- ...probably at least a few fields more
    }
    deriving Show

instance HasSmall Small where
    accessSmall = id

data Big = Big
    { small :: Small
    , email :: String
    -- ...possibly many more fields
    }
    deriving Show

instance HasSmall Big where
    accessSmall f = f . small

exampleSmall :: Small
exampleSmall = Small { name = "small name", address = "small address"}

exampleBig :: Big
exampleBig = Big { small = exampleSmall, email = "big email"}

printNameAndAddress :: HasSmall a => a -> IO ()
printNameAndAddress a = do
    putStrLn $ accessSmall name a
    putStrLn $ accessSmall address a

main :: IO ()
main = do
    printNameAndAddress exampleBig
    printNameAndAddress exampleSmall

这种方法不需要镜头，但也可以通过更改 HasSmall 类轻松修改以使用镜头：

class HasSmall a where
    accessSmall :: Lens' Small b -> Lens' a b

instance HasSmall Small where
    accessSmall = id

instance HasSmall Big where
    accessSmall = (.) small

Answer 2

就Control.Lens.TH而言，最接近您想要的工具是makeClassy：

data Small = Small
    { _name :: Text
    -- ...probably at least a few fields more
    }
    deriving Show

makeClassy ''Small

data Big = Big
    { _bigSmall :: Small
    , _bigEmail :: Text
    -- ...possibly many more fields
    }
    deriving Show

makeClassy ''Big  -- As far as this demo goes, not really necessary.

instance HasSmall Big where
    small = bigSmall

这种方法要求您在Big 中有一个Small 字段，以便可以通过生成的HasSmall 类路由对Small 中的字段的访问：

GHCi> :info HasSmall
class HasSmall c where
  small :: Lens' c Small
  name :: Lens' c Text
  {-# MINIMAL small #-}
    -- Defined at Test.hs:16:1
instance HasSmall Small -- Defined at Test.hs:16:1
instance HasSmall Big -- Defined at Test.hs:27:10
GHCi> :set -XTypeApplications
GHCi> :t name @Big
name @Big :: Functor f => (Text -> f Text) -> Big -> f Big

另一种方法是通过makeFields 对字段进行抽象：

data Small = Small
    { _smallName :: Text
    -- ...probably at least a few fields more
    }
    deriving Show

makeFields ''Small

data Big = Big
    { _bigName :: Text
    , _bigEmail :: Text
    -- ...possibly many more fields
    }
    deriving Show

makeFields ''Big

GHCi> :info HasName
class HasName s a | s -> a where
  name :: Lens' s a
  {-# MINIMAL name #-}
    -- Defined at Test2.hs:16:1
instance HasName Small Text -- Defined at Test2.hs:16:1
instance HasName Big Text -- Defined at Test2.hs:25:1
GHCi> :t name @Big
name @Big :: Functor f => (Text -> f Text) -> Big -> f Big

makeFields 在这个用例中的一个潜在缺点是，正如您所注意到的，机器完全开放了可以为字段指定哪些类型。 （相比之下，makeClassy 示例中Small 的定义间接指定任何name 镜头将具有Text 类型的目标。）