Записи с разными полями, моделирующие один и тот же логический тип - PullRequest
Новая
       63

Записи с разными полями, моделирующие один и тот же логический тип

3 голосов
/ 12 февраля 2020

В моей программе Haskell мне нужно загрузить запись из службы API различными способами. Есть действие loadSmall :: IO Small, которое загружает только некоторые из доступных полей. Действие loadBig :: IO Big загружает больше полей. Возможно, в будущем потребуется больше «уровней» загрузки.

Для простоты давайте предположим, что Big всегда будет содержать все, что делает Small.

Я бы хотел функции, чтобы иметь возможность получить доступ к этим двум «версиям» типа единообразным способом. Я прочитал о линзах и подумал, что мог бы попытаться использовать их здесь, но я совсем не привержен использованию линз, если есть более простой способ сделать это.

Это вот что я придумала: 

{-# 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)

Это похоже на множество шаблонов, поскольку каждое новое поле должно быть написано как минимум в трех местах.

Есть ли здесь более эффективный способ выполнения sh этого?

Ответы [ 2 ]

4 голосов
/ 12 февраля 2020

Если 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
2 голосов
/ 12 февраля 2020

Что касается 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

Этот подход требует, чтобы в поле Small было Big, так что доступ к полям в Small можно направить через сгенерированный класс HasSmall: 

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 в этом случае использования состоит в том, что, как вы заметили, механизм оставляет его полностью открытым, какие типы могут быть переданы полям. (Напротив, определение Small в примере makeClassy косвенно указывает, что любые объективы name будут иметь цели типа Text.)

...