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

问题

I'm basically trying to override a bunch of default values in a record only if the user-specific values are NOT Nothing. Is it possible to do it via lenses?

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

回答1:

You could make your own combinator:

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

Which you can use just like .~:

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

回答2:

This seems like a job for Alternative. Maybe's Alternative instance implements left-biased choice - its <|> chooses the first non-Nothing value.

import Control.Applicative
import Data.Semigroup

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

I'm going to implement a 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, it does the same thing.)

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"}

Note that you don't need lenses for this, although they might be able to help you make the implementation of (<>) a little terser.

When the user gives you a partially-filled-in Foo, you can fill in the rest of the fields by appending your default Foo.

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

One fun thing you can do with this is factor the Maybe out of Foo's definition.

{-# LANGUAGE RankNTypes #-}

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

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

The Foo I originally wrote above is now equivalent to Foo Maybe. But now you can express invariants like "this Foo has all of its fields filled in" without duplicating Foo itself.

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

The Semigroup instance, which only relied on Maybe's instance of Alternative, remains unchanged,

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

but you can now generalise defaultFoo to an arbitrary Applicative.

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

Now, with a little bit of Traversable-inspired categorical nonsense,

-- "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 can be adjusted to express the invariant that the resulting Foo is not missing any values.

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

Probably overkill for what you need, but it's still pretty neat.

回答3:

Okay, I found a possible solution, but I'm still looking for a better one!

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

回答4:

How about just using fromMaybe instead of creating an instance of Default?

EDIT: Since you seem to want to use the Default for other purposes as well:

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

This seems to be what you are after.

来源：https://stackoverflow.com/questions/44184898/how-to-override-a-default-value-via-lenses-only-if-incoming-value-is-not-nothi

标签

haskell

lens