Как получить лучшие сообщения об ошибках с семействами типов? - PullRequest
Новая
       33

Как получить лучшие сообщения об ошибках с семействами типов?

4 голосов
/ 03 июля 2019

Я пытаюсь создать статически типизированную систему авторизации и получить следующий рабочий фрагмент кода: 

{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeFamilies #-}

module Try where

import Data.Singletons.TH

data FeatureFlag = Feature1 | Feature2 deriving (Eq, Show)
$(genSingletons [''FeatureFlag])

type family Feature (f :: FeatureFlag) (fs :: [FeatureFlag]) where
  Feature f '[] = 'False
  Feature f (f:fs) = 'True
  Feature f (q:fs) = Feature f fs  


lockedFeatureAction :: (MonadIO (m fs), Feature 'Feature1 fs ~ 'True) => m fs ()
lockedFeatureaction = undefined

checkFeatureFlagsAndRun :: forall (fs :: [FeatureFlag]) . (SingI fs) => Proxy fs -> AppM fs () -> IO ()
checkFeatureFlagsAndRun = undefined

И вот как это привыкает: 

ghci> checkFeatureFlagsAndRun (Proxy :: Proxy '[ 'Feature1]) lockedFeatureAction

Все хорошо, когда типы и звезды совпадают. Однако, если типы не совпадают, сообщение об ошибке классического Шерлока Холмса "whodunnit": 

ghci> checkFeatureFlagsAndRun (Proxy :: Proxy '[ 'Feature2]) lockedFeatureAction

<interactive>:462:32: error:
    • Couldn't match type ‘'False’ with ‘'True’
        arising from a use of ‘lockedFeatureAction’
    • In the second argument of ‘checkFeatureFlagsAndRun’, namely ‘lockedFeatureAction’
      In the expression: checkFeatureFlagsAndRun (Proxy :: Proxy '[ 'Feature2]) lockedFeatureAction
      In an equation for ‘it’: it = checkFeatureFlagsAndRun (Proxy :: Proxy '[ 'Feature2]) lockedFeatureAction

Я попытался найти и наткнулся на https://kcsongor.github.io/report-stuck-families/,, что говорит о TypeError Я пытался использовать это так, но это не сработало: 

type family Feature (f :: FeatureFlag) (fs :: [FeatureFlag]) where
  Feature f '[] = TypeError "Could not satisfy FeatureFlag conditions"
  Feature f (f:fs) = 'True
  Feature f (q:fs) = Feature f fs

--     • Expected kind ‘ghc-prim-0.5.2.0:GHC.Types.Symbol -> Bool’,
--         but ‘TypeError’ has kind ‘*’
--     • In the type ‘TypeError "Could not satisfy FeatureFlag conditions"’
--       In the type family declaration for ‘Feature’
--    |
-- 19 |   Feature f '[] = TypeError "Could not satisfy FeatureFlag conditions"
--    |                   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Как правильно использовать TypeError? В качестве альтернативы, есть ли другой способ получить лучшие сообщения об ошибках?

Ответы [ 2 ]

6 голосов
/ 03 июля 2019

Конечно, можно предоставить лучшее сообщение об ошибке времени компиляции, используя ошибки пользовательского типа. Я описал, как использовать их в своем блоге:

Однако в вашем случае вам нужно использовать некоторые дополнительные утилиты, потому что ваш подход не основан на классе типов. В частности, вам нужно использовать пакет type-errors.

Вот как выглядит пользовательское сообщение об ошибке: 

ghci> checkFeatureFlagsAndRun (Proxy :: Proxy '[ 'Feature1]) lockedFeatureAction
<works as expected>

ghci> :t checkFeatureFlagsAndRun (Proxy :: Proxy '[ 'Feature2]) lockedFeatureAction

    • Type-level list of features should contain feature: 'Feature1
      But it doesn't:

          '[ 'Feature2]

    • In the second argument of ‘checkFeatureFlagsAndRun’, namely
        ‘lockedFeatureAction’
      In the expression:
        checkFeatureFlagsAndRun
          (Proxy :: Proxy '[ 'Feature2]) lockedFeatureAction

Ниже приведен полный код: 

{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

module Feature where

import Control.Monad.IO.Class (MonadIO)
import Data.Kind (Constraint)
import Data.Proxy (Proxy)
import Data.Singletons.TH (SingI, genSingletons)
import Data.Type.Bool (If)
import Fcf (Stuck)
import GHC.TypeLits (ErrorMessage (..), TypeError)
import Type.Errors (DelayError, WhenStuck)


data FeatureFlag = Feature1 | Feature2 deriving (Eq, Show)
$(genSingletons [''FeatureFlag])

data AppM (fs :: [FeatureFlag]) a

type family HasFeature (f :: FeatureFlag) (fs :: [FeatureFlag]) :: Constraint where
    HasFeature f fs = WhenStuck (Elem f fs) (DelayError (NoFeature f fs))

type family Elem (x :: k) (xs :: [k]) :: Bool where
    Elem _ '[]       = Stuck
    Elem x (x ': xs) = 'True
    Elem x (y ': xs) = Elem x xs

type NoFeature (f :: FeatureFlag) (fs :: [FeatureFlag]) =
        'Text "Type-level list of features should contain feature: " ':<>: 'ShowType f
  ':$$: 'Text "But it doesn't:"
  ':$$: 'Text ""
  ':$$: 'Text "    " ':<>: 'ShowType fs
  ':$$: 'Text ""

lockedFeatureAction :: (MonadIO (m fs), HasFeature 'Feature1 fs) => m fs ()
lockedFeatureAction = undefined

checkFeatureFlagsAndRun :: forall (fs :: [FeatureFlag]) . (SingI fs) => Proxy fs -> AppM fs () -> IO ()
checkFeatureFlagsAndRun = undefined
0 голосов
/ 03 июля 2019

Хорошо, я нашел «компромиссное» решение, но я не совсем доволен им. Там имеет , чтобы быть лучше / встроенным, чтобы справиться с этим. 

data FeatureFlag = Feature1 | Feature2 | FeatureNotFound

type family Feature (f :: FeatureFlag) (fs :: [FeatureFlag]) where
  Feature f '[] = 'FeatureNotFound
  Feature f (f:fs) = f
  Feature f (q:fs) = Feature f fs

type NeedFeature (f :: FeatureFlag) (fs :: [FeatureFlag]) = (Feature f fs ~ f)

lockedFeatureAction :: (MonadIO (m fs), NeedFeature 'Feature1 fs) => m fs ()
lockedFeatureaction = undefined

Теперь, если типы не совпадают, я получаю сообщения об ошибках, которые выглядят следующим образом: 

ghci> checkFeatureFlagsAndRun (Proxy :: Proxy '[ 'Feature2]) lockedFeatureAction

    • Couldn't match type ‘'FeatureNotFound’
                     with ‘'FeatureBookingEngine’
        arising from a use of ‘lockedFeatureAction’
...