$ whoami
traverse
?newtype Name = Name String
deriving newtype (Eq, Show, IsString, Monoid)
newtype Secret = Secret String
deriving newtype (Eq, Show, IsString)
getSecret :: Name -> IO Secret
getSecret (Name serviceName) =
let varName = toUpper <$> serviceName <> "_SECRET"
in Secret <$> getEnv varName
services :: [Name]
services = [ "bingo"
, "papaya"
, "magicbaby"
, "galactus"
, "clogger"
, "lmnop"
, "raccoon"
, "omegastar"
, "olympus"
, "eks"
]
a -> f b
) to a collection (t a
), and collects the results in a single effect f (t b)
Map
?traverse getSecret
may appear a few times in this talk
Rhododendron
is a french name, it’s usually called a rose tree
{-# LANGUAGE DeriveTraversable #-}
data Rhododendron a
= Rhododendron a [Rhododendron a]
deriving (Show, Functor, Foldable, Traversable)
Traversable
can be automatically derived by GHC with the right extensions
{-# LANGUAGE DeriveTraversable #-}
data Services a
= Services
{ bingo :: a
, papaya :: a
, magicbaby :: a
, galactus :: a
}
deriving (Show, Functor, Foldable, Traversable)
secrets :: IO (Services Secret)
secrets = traverse getSecret $
Services
{ bingo = "bingo"
, papaya = "papaya"
, magicbaby = "magicbaby"
, galactus = "galactus"
}
:t traverse @Services @IO getSecret
Services Name -> IO (Services Secret)
secrets :: Services [Name]
-> IO (Services [Secret])
secrets = traverse traverseList
where
traverseList :: [Name]
-> IO [Secret]
traverseList = traverse getSecret
traverse
, no type-specific functions.
newtype Compose f g a
= Compose
{ getCompose :: f (g a)
}
instance (Traversable f, Traversable g)
=> Traversable (Compose f g)
secrets :: Services [Name]
-> IO (Services [Secret])
secrets = magicTraverse getSecret
where
magicTraverse f =
fmap getCompose . traverse f . Compose
traverse
allows to run an effectful function on any kind of collection (lists, trees, records)if
with a side effect and no else
printIfAvailable :: Maybe String
-> IO ()
printIfAvailable (Just s) = putStrLn s
printIfAvailable Nothing = pure ()
traverse
?Maybe
is a list with at most one elementtraverse_
!Traversable
constraint, since you don’t keep it. (That’s why it’s defined in Data.Foldable
)
Traversable
instance
IO
secretParser :: Name
-> Parser Secret
secretParser (Name s) =
required $ nonEmptyString (toUpper <$> s <> "_SECRET")
instance Traverse [] where
traverse :: Applicative f
=> (a -> f b)
-> [a] -> f [b]
traverse _ [] = pure []
traverse f (x : xs) =
(:) <$> f x <*> traverse f xs
pure
for “empty” structures<*>
to reconstruct the structure by combining elementsparseJSONFile :: FilePath
-> IO (Validation [String] Parsed)
parseJSONFile = …
parseFiles :: [FilePath]
-> IO (Validation [String] [Parsed])
parseFiles = _
IO
level, not the Validation
parseFiles :: [FilePath]
-> IO (Validation [String] [Parsed])
parseFiles = magicTraverse2 parseJSONFile
where
magicTraverse2 f =
getCompose $ traverse (Compose . f)
Compose
is in the traverse argument, while getComposesequenceA
instead of traverse, as the type signatures are a bit simpler
traverse
and sequenceA
Text
?Text
has a monoid instance, and anything that is traversable is also foldable
traverse_
. Here, what we need to use traverseb
type parameter here is called a phantom type:mempty :: Monoid m => m
(<>) :: Monoid m => m -> m -> m
pure :: Applicative f => a -> f a
liftA2 (,) :: Applicative f => f a -> f b -> f (a, b)
instance Monoid a => Monoid (IO a)
λ> foldMap putStrLn ["yolo", "swag"]
yolo
swag
λ> traverse_ putStrLn ["yolo", "swag"]
yolo
swag
instance Monoid e => Monoid (Validation e a)
isEven :: Int
-> Validation [String] ()
isEven n | even n = Success ()
| otherwise = Failure [show n <> " is not even"]
λ> foldMap isEven [2, 5]
Success ()
λ> traverse_ isEven [2, 5]
Failure ["5 is not even"]
λ> getConst $ traverse_ (Const . isEven) [2, 5]
Success ()
any
,traverse_
acts like all
mapM
traverse
, à fond la forM
for
, as evidenced by the name forM
. It makes it easier to understand why traverse is useful in so many context. the for
loop is also pervasive in imperative languages so pervasive that we don’t even have jokes about it.traverse
is a double generalization of for loops:traverse
, different kindsCompose
). It’s rather easy