Блог

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

 > genericFilter (1,[Yez, No])
Just (1,[No])
  

Но есть особый случай, когда весь список отбрасывается
если Yez является первым элементом в списке.

 genericFilter (1,[[Yez, No]])
Just (1,[])
>genericFilter [Yez, No, No]
Nothing
  

После отладки я заметил, что проблема в :*: .
Для первого аргумента :*: непосредственно используется экземпляр FilterZ (SomeZ)
минуя FilterZ MetaConst и Filter (K1 []), mean while для списка rest
FilterZ MetaConst и Filter (K1 []) используются, а FilterZ (SomeZ) — нет!

 {-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}


module Main where

import Data.Proxy
import GHC.Generics
import GHC.TypeLits
import Data.List
data SomeZ = No | Yez deriving (Show, Eq, Generic)

class FilterZ a where
  gfilter :: a x -> Maybe (a x)

instance FilterZ (U1) where
  gfilter U1 = Just U1

instance FilterZ (V1) where -- void
  gfilter _ = Nothing

instance  FilterZ (K1 _1 ()) where
   gfilter (K1 ()) = Just $ K1 ()

instance  FilterZ (K1 _1 SomeZ) where
   gfilter (K1 No) = Just $ K1  No
   gfilter (K1 Yez) = Nothing -- Just $ K1 Yez -- Nothing


instance (FilterZ (Rep a), Show a, Generic a) => FilterZ (K1 _1 [a]) where
   gfilter (K1 []) = Just $ K1 []
   gfilter (K1 (h:r)) = case gfilter (from h) of
                          Nothing -> gfilter (K1 r)
                          Just h' -> case gfilter (K1 r) of
                                       Nothing -> Just $ K1 [(to h') :: a] -- Nothing
                                       Just (K1 r') -> Just $ K1 ((to h') : r')

instance FilterZ (K1 _1 Int) where
   gfilter (K1 n) = Just $ K1 n

instance FilterZ (K1 _1 Integer) where
   gfilter (K1 n) = Just $ K1 n


instance (FilterZ a, FilterZ b) => FilterZ (a : : b) where
  gfilter (L1 x) = case gfilter x of
                     Nothing -> Nothing
                     Just x' -> Just $ L1 x'

  gfilter (R1 x) = case gfilter x of
                     Nothing -> Nothing
                     Just x' -> Just $ R1 x'

instance (FilterZ a, FilterZ b) => FilterZ (a :*: b) where
  gfilter (a :*: b) =
    case gfilter a of
      Nothing -> Nothing
      Just a' -> case gfilter b of
                   Nothing -> Nothing
                   Just b' -> Just $ a' :*: b'

instance FilterZ c => FilterZ (M1 a ('MetaData dname mname pname isnewtype) c) where
   gfilter (M1 x) = case gfilter x of
                      Nothing -> Nothing
                      Just x' -> Just $ M1 x'

instance (KnownSymbol dcn, FilterZ c) => FilterZ (M1 a ('MetaCons dcn p f) c) where
   gfilter (M1 x) = case find (=='z') name of
                      Just _  -> Nothing
                      Nothing -> case gfilter x of
                                   Nothing -> Nothing
                                   Just x' -> Just $ M1 x'
     where
       name = symbolVal (undefined :: Proxy dcn)

instance FilterZ c => FilterZ (M1 a ('MetaSel fsel packness stricnesss lazines) c) where
   gfilter (M1 x) = case gfilter x of
                      Nothing -> Nothing
                      Just x' -> Just $ M1 x'

genericFilter :: (Generic a, FilterZ (Rep a)) => a -> Maybe a
genericFilter a = fmap to $ gfilter (from a)

  

Функция from работает только на верхнем уровне. Итак, если вы применяете from к списку, вы получаете его общее представление, которое является либо единицей, либо произведением его заголовка и хвоста:

 *Gen> from [Yez, No]
M1 {unM1 = R1 (M1 {unM1 = M1 {unM1 = K1 {unK1 = Yez}} :*: M1 {unM1 = K1 {unK1 = [No]}}})}

  

Обратите внимание, что заголовок отделен, но [No] больше не разлагается. Итак, если ваш список не на верхнем уровне, он никогда не разлагается подобным образом под from :

 *Gen> from (1, [Yez, No])
M1 {unM1 = M1 {unM1 = M1 {unM1 = K1 {unK1 = 1}} :*: M1 {unM1 = K1 {unK1 = [Yez,No]}}}}
  

Обратите внимание, что список [Yez, No] сохраняется нетронутым.

В первом случае genericFilter проходит через M1 и достигает :*: . Первым компонентом продукта является Yez , поэтому по FilterZ (K1 _1 SomeZ) экземпляру он сопоставлен с Nothing . И (FilterZ a, FilterZ b) => FilterZ (a :*: b) экземпляр говорит, что конечный результат должен быть Nothing .

Во втором случае снова genericFilter проходит через M1 и достигает :*: . На этот раз первый компонент представляет собой единицу, которая сопоставляется с unit, а второй компонент имеет тип, [SomeZ] который фильтруется (FilterZ (Rep a), Show a, Generic a) => FilterZ (K1 _1 [a]) экземпляром.