Skip to content

Instantly share code, notes, and snippets.

@KirinDave
Last active April 16, 2018 17:24
Show Gist options
  • Save KirinDave/63054c44acd53adee4d50f0c440de5ea to your computer and use it in GitHub Desktop.
Save KirinDave/63054c44acd53adee4d50f0c440de5ea to your computer and use it in GitHub Desktop.
{-# LANGUAGE TypeFamilies, ScopedTypeVariables, OverloadedStrings, TemplateHaskell, RankNTypes #-}
module Main where
import Data.Map (Map(..), empty)
import Control.Lens
import Data.Monoid (mempty)
import Data.Text (Text(..))
import Control.Applicative (pure)
-- We'll start by making an animal
-- with room for helpful descriptors.
data Animal = A { _name :: Text
, _call :: Text
, _tags :: [Text]
} deriving (Show)
-- We need lenses. You'll see why.
makeLenses ''Animal
-- Now let's get a nice collection for our spaceship.
menagerie :: [Animal]
menagerie = [ A "Dog" "woof" ["friendly", "stinky", "snuggly"]
, A "Cat" "meow" ["stinky", "snuggly"]
, A "Tapeworm" "slurp" ["friendly", "unscented", "snuggly"]
, A "Human" "Notice me!" ["dangerous"]
, A "Wolf" "woof" ["stinky", "dangerous"]
]
-- Of course, if folks are viewing our menagier we'd like to categorize
-- our confsing array of Terran animals. We'd also like to make a sound
-- guidebook, so alien kids have something to bring home.
-- Both of these involve the creation of a map from a key, either one of
-- many tags or from a cry. We can use lenses to make this task easier.
-- Firstly, let's assume given a getting lens and a menagerie, we can make a guidebook.
guidebook :: Ord a => Getter Animal [a] -> [Animal] -> Map a [Animal]
-- Or generically:
-- guidebook :: (Ord a, Foldable f, Applicative f, Monoid (f a)) =>
-- Getter r (f a) -> f r -> Map a (f r)
guidebook lens animals = foldr step empty animals
where step animal book = foldr (istep animal) book (view lens animal)
istep v k m = m & at k <>~ Just (pure v) -- pure :: a -> f a ([] in this case)
-- This is a bit tricky since it's a double fold, but the real
-- interesting bit is the `istep` part where we step inside the
-- list of tags and start updating the dictionary we've been passed
-- in:
-- istep v k m = m & at k <>~ Just [v]
--
-- This innter step takes our Map m, and updates it with the lens "at k",
-- monoidally appending and setting (<>~ operator) the current animal to the list.
-- If no value is found, the existing value is used (by virtue of list
-- being a monoid).
--
-- In the world of ruby we might write that as:
-- istep = lambda { |x k m| m[k] ||= [] ; m[k] += [x] }
main :: IO ()
main = do
putStrLn "Welcome to the Menagerie!"
-- We give our guidebook function the tags lens.
let tagBook = guidebook tags menagerie
putStrLn $ show tagBook
-- What's kinda cool about this is that, thanks to the power of lenses,
-- we can actually reuse the guidebook call for the book of calls, without
-- premeditation. The call field isn't a list, so it may seem surprising,
-- but we have specified we have a "Getter of a list of a's from an Animal'".
-- So all we need to do is use a function that wraps a value as a list and
-- bam, we've converted it.
-- The simplest and most future proof way I can think of to go `a -> [a]`.
-- There is no "singleton" function for single-kind data structures like
-- this because you can think of it as `a -> f a`, which is `pure` for
-- any Applicative or Monad. If we ever do change the type of our calls
-- or the structures we store (and make the type signature of guidebook
-- more generic) then this code won't be an issue. That's defensive with
-- lenses, as even profunctor lenses sometimes give somewhat obtuse type
-- errors.
let callBook = guidebook (call . to pure) menagerie
putStrLn $ show callBook
@KirinDave
Copy link
Author

I suppose we could also use these lenses to write back to the animals and update copies of guidebooks for users. That might be a fun way to extend the exercise.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment