如何通过镜头覆盖默认值，只有当传入值不是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

你可以使自己的组合子：

(~?) :: 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" 

Answer 2

如何只用fromMaybe，而不是创建的Default一个实例？

编辑：既然你似乎想用Default用于其他目的：

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

这似乎是你所追求的。

Answer 3

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

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 4

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

import Control.Applicative 
import Data.Semigroup 

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

我要去实现一个Semigroup实例Foo又带动<|>逐点在记录字段。因此，操作x <> y覆盖y的字段，其中匹配的非Nothing字段的值为x。 （您也可以使用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。但是现在，您可以表达像“此Foo已将其所有字段填入”的不变量，而不会复制Foo本身。

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

的Semigroup情况下，只依靠的Alternative上Maybe的情况下，保持不变，

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: https://stackoverflow.com/q/44187945/7951906 
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 

可能对您所需要的东西过度矫枉过正，但它仍然非常整齐。