如何通過鏡頭覆蓋默認值，只有當傳入值不是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 

可能對您所需要的東西過度矯枉過正，但它仍然非常整齊。