仅当传入值不是 Nothing 时，如何通过镜头覆盖默认值

Question

我基本上只是在用户特定值不是 Nothing 的情况下尝试覆盖记录中的一堆默认值。是否可以通过镜头来实现？

import qualified Data.Default as DD

instance DD.Def Nouns where
  def  = Nouns
    {
      -- default values for each field come here
    }

lookupHStore :: HStoreList -> Text -> Maybe Text

mkNounsFromHStoreList :: HStoreList -> Nouns
mkNounsFromHStoreList h = (DD.def Nouns)
  & depSingular .~ (lookupHStore h "dep_label_singular")
  -- ERROR: Won't compile because Text and (Maybe Text) don't match

Answer 1

如何只使用 fromMaybe 而不是创建 Default 的实例？

编辑：因为您似乎也想将 Default 用于其他目的：

λ > import Data.Default
λ > import Data.Maybe
λ > :t fromMaybe def
fromMaybe def :: Default a => Maybe a -> a

这似乎就是你想要的。

Answer 2

好的，我找到了可能的解决方案，但我仍在寻找更好的解决方案！

mkNounsFromHStoreList :: HStoreList -> Nouns
mkNounsFromHStoreList h = (DD.def Nouns)
  & depSingular %~ (overrideIfJust (lookupHStore h "dep_label_singular"))
  -- and more fields come here...
  where
    overrideIfJust val x = maybe x id val

Answer 3

这似乎是 Alternative. Maybe's Alternative instance 实现 左偏选择 的工作 - 它的 <|> 选择第一个非 Nothing 值。

import Control.Applicative
import Data.Semigroup

data Foo = Foo {
    bar :: Maybe Int,
    baz :: Maybe String
}

我要实现一个 Semigroup instance for Foo which lifts <|> point-wise over the record fields. So the operation x <> y overrides the fields of y with the matching non-Nothing fields of x. (You can also use the First monoid，它做同样的事情。）

instance Semigroup Foo where
    f1 <> f2 = Foo {
        bar = bar f1 <|> bar f2,
        baz = baz f1 <|> baz f2
    }

ghci> let defaultFoo = Foo { bar = Just 2, baz = Just "default" }
ghci> let overrides = Foo { bar = Just 8, baz = Nothing }
ghci> overrides <> defaultFoo
Foo {bar = Just 8, baz = Just "default"}

请注意，您不需要镜头，尽管它们可能会帮助您使 (<>) 的实施更简洁。

当用户给你一个部分填写的 Foo 时，你可以通过附加默认 Foo.

来填写其余字段

fillInDefaults :: Foo -> Foo
fillInDefaults = (<> defaultFoo)

您可以用它做的一件有趣的事情是将 Maybe 从 Foo 的定义中分解出来。

{-# LANGUAGE RankNTypes #-}

import Control.Applicative
import Data.Semigroup
import Data.Functor.Identity

data Foo f = Foo {
    bar :: f Int,
    baz :: f String
}

我上面原来写的Foo现在相当于Foo Maybe。但是现在您可以表达像 "this Foo has all of its fields filled in" 这样的不变量，而无需复制 Foo 本身。

type PartialFoo = Foo Maybe  -- the old Foo
type TotalFoo = Foo Identity  -- a Foo with no missing values

Semigroup实例，只依赖Maybe的Alternative实例，保持不变，

instance Alternative f => Semigroup (Foo f) where
    f1 <> f2 = Foo {
        bar = bar f1 <|> bar f2,
        baz = baz f1 <|> baz f2
    }

但您现在可以将 defaultFoo 概括为任意 Applicative。

defaultFoo :: Applicative f => Foo f
defaultFoo = Foo { bar = pure 2, baz = pure "default" }

现在，用一点点 Traversable 启发的绝对废话，

-- "higher order functors": functors from the category of endofunctors to the category of types
class HFunctor t where
    hmap :: (forall x. f x -> g x) -> t f -> t g

-- "higher order traversables",
-- about which I have written a follow up question: 
class HFunctor t => HTraversable t where
    htraverse :: Applicative g => (forall x. f x -> g x) -> t f -> g (t Identity)
    htraverse eta = hsequence . hmap eta
    hsequence :: Applicative f => t f -> f (t Identity)
    hsequence = htraverse id

instance HFunctor Foo where
    hmap eta (Foo bar baz) = Foo (eta bar) (eta baz)
instance HTraversable Foo where
    htraverse eta (Foo bar baz) = liftA2 Foo (Identity <$> eta bar) (Identity <$> eta baz)

可以调整

fillInDefaults 来表示结果 Foo 不丢失任何值的不变量。

fillInDefaults :: Alternative f => Foo f -> f TotalFoo
fillInDefaults = hsequence . (<> defaultFoo)

-- fromJust (unsafely) asserts that there aren't
-- any `Nothing`s in the output of `fillInDefaults`
fillInDefaults' :: PartialFoo -> TotalFoo
fillInDefaults' = fromJust . fillInDefaults

可能对您的需要有点矫枉过正，但它仍然非常整洁。

Answer 4

您可以制作自己的组合器：

(~?) :: ASetter' s a -> Maybe a -> s -> s
s ~? Just a  = s .~ a
s ~? Nothing = id

你可以像.~:

一样使用

mkNounsFromHStoreList :: HStoreList -> Nouns
mkNounsFromHStoreList h =
  DD.def
    & myNoun1 ~? lookupHStore h "potato"
    & myNoun2 ~? lookupHStore h "cheese"

仅当传入值不是 Nothing 时，如何通过镜头覆盖默认值

How to override a default value, via lenses, only if incoming value is not Nothing

haskell

haskell-lens