Реализовать стиль Applicative с помощью Generics

Question

контекст

Если у нас есть

data Foo = Foo { x :: Maybe Int, y :: Maybe Text }

мы уже можем создать аппликативный стиль в аппликативном контексте (здесь IO) как

myfoo :: IO Foo
myfoo = Foo <$> getEnvInt "someX" <*> getEnvText "someY"

проблема

Что если кто-то предпочитает строить с явным выписыванием имен полей записи? Такие как:

myfoo = Foo { x = getEnvInt "someX", y = getEnvText "someY" }

Это не проверка типов. Одним из решений является

{-# LANGUAGE RecordWildCards #-}
myfoo = do
    x <- getEnvInt "someX"
    y <- getEnvText "someY"
    return $ Foo {..}

Что не плохо. Но мне интересно (на данный момент только ради себя) может ли работать следующее:

data FooC f = FooC { x :: f Int, y :: f Text }
type Foo = FooC Maybe

myfoo :: IO Foo
myfoo = genericsMagic $ FooC
    { x = someEnvInt "someX"
    , y = someEnvText "someY"
    }

Я считаю, что это может быть сделано с голым GHC.Generics сопоставление с образцом, но это не обеспечило бы безопасность типов, поэтому я искал более сильный подход. Я столкнулся generics-sop, который преобразует запись в гетерогенный список, и поставляется с, казалось бы, удобным hsequence операция.

Точка, где я застрял

generics-sop сохраняет тип Applicative в отдельном параметре type его гетерогенного списка, и это всегда I (Личность) при использовании сгенерированного преобразования. Поэтому мне нужно отобразить список и удалить I от элементов, которые будут эффективно перемещать заявитель под I к указанному параметру типа (было бы Comp IO Maybe), чтобы я мог использовать hsequenceи, наконец, добавить обратно Is, так что я могу вернуться к записи.

Но я не знаю, как написать сигнатуру типа для I функция удаления / сложения, которая сообщает, что типы соответствующих элементов списка постоянно меняются, теряя / получая внешний тип. Это вообще возможно?

Answer 1

Проблема с Generics в том, что ваш FooC тип имеет вид (* -> *) -> * и, насколько я знаю, невозможно автоматически получить GHC.Generics экземпляр для такого типа. Если вы открыты для решения, использующего Template Haskell, относительно легко написать код TH, необходимый для автоматической обработки любого типа записи.

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}

module AppCon where

import Control.Applicative
import Control.Compose ((:.), unO)
import Language.Haskell.TH

class AppCon t where
  appCon :: Applicative f => t (f :. g) -> f (t g)

deriveAppCon :: Name -> Q [Dec]
deriveAppCon name = do
  (TyConI (DataD _ _ _ _ [RecC con fields] _)) <- reify name

  let names = [mkName (nameBase n) | (n,_,_) <- fields]
      apps = go [|pure $(conE con)|] [[|unO $(varE n)|] | n <- names] where
        go l [] = l
        go l (r:rs) = go [|$l <*> $r|] rs

  [d|instance AppCon $(conT name) where
      appCon ($(conP con (map varP names))) = $apps
    |]

Я использую оператор композиции типа из TypeCompose пакет для определения класса типов, который может "развернуть" один аппликативный слой из типа записи. Т.е. если у вас есть FooC (IO :. Maybe) Вы можете превратить его в IO (FooC Maybe),

deriveAppCon позволяет автоматически получить экземпляр для любого базового типа записи.

{-# LANGUAGE TemplateHaskell #-}

import Control.Compose ((:.)(..))

import AppCon

data FooC f = FooC { x :: f Int, y :: f Text }
type Foo = FooC Maybe

deriveAppCon ''FooC

myfoo :: IO Foo
myfoo = appCon $ FooC
    { x = O $ someEnvInt "someX"
    , y = O $ someEnvText "someY"
    }

O конструктор из TypeCompose используется для переноса результата функции IO (Maybe a) в композит ((IO .: Maybe) a),

Answer 2

Но я не знаю, как написать сигнатуру типа для функции удаления / добавления I, которая сообщает, что типы соответствующих элементов hlist последовательно меняются при потере / получении внешнего типа. Это вообще возможно?

Я тоже не знаю, как это сделать. Возможный обходной путь (за счет некоторого стандартного шаблона) заключается в использовании синонимов шаблонов записей для непосредственного построения представления суммы продуктов, при этом все еще имея возможность использовать именованные поля:

{-# language DeriveGeneric #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language PatternSynonyms #-}

import Data.Text
import qualified GHC.Generics as GHC
import Generics.SOP
import Text.Read

data Foo = Foo { x :: Int, y :: Text } deriving (Show, GHC.Generic)

instance Generic Foo

pattern Foo' :: t Int -> t Text -> SOP t (Code Foo)
pattern Foo' {x', y'} = SOP (Z (x' :* y' :* Nil))

readFooMaybe :: SOP (IO :.: Maybe) (Code Foo)
readFooMaybe = Foo'
             {
                x' = Comp (fmap readMaybe getLine)
             ,  y' = Comp (fmap readMaybe getLine)
             }

Тестирование на ghci:

ghci> hsequence' readFooMaybe >>= print
12
"foo"
SOP (Z (Just 12 :* (Just "foo" :* Nil)))