Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Traversals
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
module Traversals where
import Control.Applicative (Applicative(..))
import Data.Bool (Bool(True))
import Data.Char (toLower)
import Data.Either (Either(Left, Right))
import Data.Foldable (length)
import Data.Function (($), (.))
import Data.Functor (Functor(..), (<$>))
import Data.Int (Int)
import Data.Maybe (Maybe(Just, Nothing))
import Data.Monoid (First(..), Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Traversable (Traversable(traverse))
import System.IO (IO, print)
import Text.Show (show)
type Lens s t a b =
forall f. Functor f => (a -> f b) -> s -> f t
_1 :: Lens (a, c) (b, c) a b
_1 a2fb (a, c) = (,c) <$> a2fb a
_2 :: Lens (c, a) (c, b) a b
_2 a2fb (c, a) = (c,) <$> a2fb a
newtype Identity a = Identity
{ runIdentity :: a
}
instance Functor Identity where
fmap :: (a -> b) -> Identity a -> Identity b
fmap f (Identity a) = Identity (f a)
type Setter s t a b =
(a -> Identity b) -> s -> Identity t
modify :: Setter s t a b -> (a -> b) -> s -> t
modify setting a2b = runIdentity . setting (Identity . a2b)
newtype Const a b = Const
{ getConst :: a
}
instance Functor (Const c) where
fmap :: (a -> b) -> Const c a -> Const c b
fmap _ (Const c) = Const c
type Getter s a =
(a -> Const a a) -> s -> Const a s
view :: Getter s a -> s -> a
view getting = getConst . getting Const
-- Cool, now, it's interesting to compare the similarities
-- between the type for Lens and the `traverse` function from
-- the Traversable type class:
--
-- ```
-- >>> :t traverse
-- traverse
-- :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)
-- >>> :i Lens
-- type Lens s t a b =
-- forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
-- -- Defined at Traversals.hs:20:1
-- ```
--
-- Note that there's nothing stopping `t a -> f (t b)`
-- standing in for `s -> f t` (it's made a bit more confusing
-- by the `t`s in the two types being different). `s -> f t`
-- is a very permissive type.
--
-- What might happen if we try to _use_ `traverse` as a Lens?
--
-- ```
-- >>> modify traverse show [1, 2, 3]
-- <interactive>:1:8: error:
-- • Could not deduce (Applicative Identity)
-- arising from a use of ‘traverse’
-- more ...
-- ```
--
-- No problemo, an Applicative instance for Identity is pretty
-- straight forward:
instance Applicative Identity where
pure = Identity
Identity f <*> Identity a = Identity (f a)
-- Alright then:
--
-- ```
-- >>> modify traverse show [1, 2, 3]
-- ["1","2","3"]
-- ```
--
-- What about `view`ing using traverse?
--
-- ```
-- >>> view traverse ["1", "2", "3"]
-- <interactive>:1:6: error:
-- • No instance for (Applicative (Const String))
-- arising from a use of ‘traverse’
-- more ...
-- ```
--
-- Writing an Applicative instance for Const is a little less
-- straight forward. Let's go step by step.
--
-- As with the Functor instance we'll need to fix the first type
-- arg, let's call it `c` again:
--
-- ```
-- instance Applicative (Const c) where
-- ```
--
-- Now `pure`
--
-- ```
-- pure :: a -> Const c a
-- pure = undefined
-- ```
--
-- We need to produce a value of type `c`, but we can't, we
-- don't have one. Now, because `c` has nothing to do with
-- Applicative, we can technically assign it to whatever we
-- want. If we turn on FlexibleInstances we could even write
-- something like this:
--
-- ```
-- instance Applicative (Const ()) where
-- pure _ = Const ()
-- ```
--
-- In fact the whole instance is now pretty ... well:
--
-- ```
-- instance Applicative (Const ()) where
-- pure _ = Const ()
-- Const () <*> Const () = Const ()
-- ```
--
-- If we try to _use_ this instance for the examples above
-- we pretty quickly run into an issue.
--
-- ```
-- >>> :t view @[String] @String traverse
--
-- <interactive>:1:24: error:
-- • No instance for (Applicative (Const String))
-- arising from a use of ‘traverse’
-- ... more
-- >>> :t view @[()] @() traverse
-- view @[()] @() traverse :: [()] -> ()
-- ```
--
-- This will only ever work when `a` is `()`, it might be a
-- good idea to use a more general type than `()`, or any
-- concrete type really. Maybe ... we could use a _class_ of
-- types?
--
-- We need to a) make a value of this type out of thin air, and
-- b) perform some action on two values to produce one. There's
-- a type class which encapsulates types that behave this way
-- very well: Monoid.
instance Monoid c => Applicative (Const c) where
pure _ = Const mempty
Const a <*> Const b = Const (a <> b)
-- Does `traverse` work for viewing values now?
--
-- ```
-- >>> view traverse ["1", "2", "3"]
-- "123"
-- ```
--
-- Uh, in a way, sure. But only if `a` is a Monoid.
--
-- ```
-- >>> view traverse [1, 2, 3] :: Int
--
-- <interactive>:1:6: error:
-- • No instance for (Monoid Int) arising from a use of ‘traverse’
-- ... more
--
-- >>> import Data.Monoid (Sum(..))
-- >>> view traverse [Sum 1, Sum 2, Sum 3]
-- Sum {getSum = 6}
-- ```
--
-- What good is this? Well, for a start there are many very interesting
-- Traversable things, there are also many very interesting Monoids.
--
-- For example, First is a pretty interesting Monoid:
--
-- ```
-- >>> import Data.Monoid(First(..))
-- >>> import Data.Maybe (Maybe(Nothing, Just))
-- >>> import Data.Either (Either(Left, Right))
-- >>> view traverse (Right (First (Just 1)))
-- First {getFirst = Just 1}
-- >>> view traverse (Just (First (Just 1)))
-- First {getFirst = Just 1}
-- >>> view traverse [First (Just 1), First (Just 2)]
-- First {getFirst = Just 1}
-- >>> view traverse (Left "Boo") :: First Int
-- First {getFirst = Nothing}
-- >>> view traverse Nothing :: First Int
-- First {getFirst = Nothing}
-- >>> view traverse [] :: First Int
-- First {getFirst = Nothing}
-- ```
--
-- This suggests that there's a pretty handy function we could
-- write:
--
-- ```
-- preview :: Getter s a -> s -> Maybe a
-- preview getter = getFirst . getConst . getter (Const . First . Just)
-- ```
--
-- However if we try to compile that we get a type error pointing out
-- that the Getter type is too restrictive. We need something that allows
-- us to specify that the Const will contain something other than `a`:
type Getting r s a =
(a -> Const r a) -> s -> Const r s
-- Now we can write preview:
preview :: Getting (First a) s a -> s -> Maybe a
preview getter = getFirst . getConst . getter (Const . First . Just)
-- It's fun to note that this can still be used with the above defined
-- Lenses:
--
-- ```
-- >>> preview _1 ("Y", "tho")
-- Just "Y"
-- ```
--
main :: IO ()
main = do
print $ modify _1 (("It's " <>) . fmap toLower . show) (True, "Wow")
-- ("It's true","Wow")
print $ view _2 (True, "Wow")
-- "Wow"
print $ modify traverse length ["Hey", "that's", "weird"]
-- [3,6,5]
print $ view traverse ["Hey", "really", "weird"]
-- "Heyreallyweird"
print $ preview traverse (Right 2)
-- Just 2
print $ preview traverse (Left "Nope" :: Either String Int)
-- Nothing
print $ modify traverse length (Just "Hey")
-- Just 3
print $ preview traverse ["Not", "so", "weird"]
-- Just "Not"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.