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.