Last week I received some friendly criticism cause I've ended the post by postponing the refactor step of our Type-Driven-Developed kata:
I don't have any more time for today. We will be refactoring in a future post!
Better make it right ASAP! Let's refactor (for real).
But first, this is the code we got to last week:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Text (Text)
import qualified Data.Text as T (lines, words, unpack)
import Text.Read (readMaybe)
type Coord =
(Int, Int)
type CoordDir =
(Coord, Dir)
data Turn
= L
| R
deriving (Show, Read)
data Dir
= N
| E
| S
| W
deriving (Show, Read)
data Cmd
= Turn Turn
| Move
deriving (Show)
readMaybeT :: Read a => Text -> Maybe a
readMaybeT = readMaybe . T.unpack
parsePlateauMax :: Text -> Maybe Coord
parsePlateauMax txt =
case T.words txt of
[x, y] -> (,) <$> readMaybeT x <*> readMaybeT y
_ -> Nothing
parseStartingCoordDir :: Text -> Maybe CoordDir
parseStartingCoordDir txt = do
(x, y, d) <- case T.words txt of
[x, y, d] -> (,,) <$> readMaybeT x <*> readMaybeT y <*> readMaybeT d
_ -> Nothing
Just ((x, y), d)
parseCommands :: Text -> Maybe [Cmd]
parseCommands txt = toCmd `traverse` T.unpack txt
where
toCmd :: Char -> Maybe Cmd
toCmd 'L' = Just (Turn L)
toCmd 'R' = Just (Turn R)
toCmd 'M' = Just Move
toCmd _ = Nothing
runCommands :: [Cmd] -> Coord -> CoordDir -> CoordDir
runCommands [] _ coordDir = coordDir
runCommands (c:cmds) max coordDir = runCommands cmds max $ newCoordDir c
where
newCoordDir (Turn L) = turnL coordDir
newCoordDir (Turn R) = turnR coordDir
newCoordDir Move = move coordDir
turnL (c, N) = (c, W)
turnL (c, E) = (c, N)
turnL (c, S) = (c, E)
turnL (c, W) = (c, S)
turnR (c, N) = (c, E)
turnR (c, E) = (c, S)
turnR (c, S) = (c, W)
turnR (c, W) = (c, N)
move ((x, y), N) = (wrap max (x, y+1), N)
move ((x, y), E) = (wrap max (x+1, y), E)
move ((x, y), S) = (wrap max (x, y-1), S)
move ((x, y), W) = (wrap max (x-1, y), W)
wrap (maxX, maxY) (x, y) = (wrap' maxX x, wrap' maxY y)
wrap' max x | x < 0 = max + 1 + x
wrap' max x | x > max = x `rem` max
wrap' max x | otherwise = x
run :: Text -> Maybe CoordDir
run txt = do
(max, coordDir, cmds) <- go $ T.lines txt
Just $ runCommands cmds max coordDir
where
go [f, s, t] = (,,) <$> parsePlateauMax f <*> parseStartingCoordDir s <*> parseCommands t
go _ = Nothing
main :: IO ()
main = do
let commands = "5 5\n1 2 N\nLMLMLMLMM"
print $ parsePlateauMax "5 5"
print $ parseStartingCoordDir "1 2 N"
print $ parseCommands "LMLMLMLMM"
maybe (print "ERR!") print $ run commands
CyclicEnum
A couple of weeks ago, we introduced (i.e. blatantly copied) the CyclicEnum typeclass.
Let's use it in our turnL and turnR functions:
data Dir
= N
| E
| S
| W
- deriving (Show, Read)
+ deriving (Show, Read, Eq, Enum, Bounded, CyclicEnum)
...
- turnL (c, N) = (c, W)
- turnL (c, E) = (c, N)
- turnL (c, S) = (c, E)
- turnL (c, W) = (c, S)
+ turnL (c, d) = (c, csucc d)
- turnR (c, N) = (c, E)
- turnR (c, E) = (c, S)
- turnR (c, S) = (c, W)
- turnR (c, W) = (c, N)
+ turnR (c, d) = (c, cpred d)
The code is more tidy but what matters most is that in case we added more Dirs like NE (i.e. north-east), we wouldn't have to update turnL and turnR.
Since tuples are functors, we can refactor further to:
- turnL (c, d) = (c, csucc d)
+ turnL = fmap csucc
- turnR (c, d) = (c, cpred d)
+ turnR = fmap cpred
and inline turnL and turnR:
- newCoordDir (Turn L) = turnL coordDir
- newCoordDir (Turn R) = turnR coordDir
+ newCoordDir (Turn L) = fmap csucc coordDir
+ newCoordDir (Turn R) = fmap cpred coordDir
newCoordDir Move = move coordDir
- turnL = fmap csucc
-
- turnR = fmap cpred
Parsing
To make parsing more solid, we can make use of Parsec.
We first remove the old code:
-readMaybeT :: Read a => Text -> Maybe a
-readMaybeT = readMaybe . T.unpack
-
-parsePlateauMax :: Text -> Maybe Coord
-parsePlateauMax txt =
- case T.words txt of
- [x, y] -> (,) <$> readMaybeT x <*> readMaybeT y
- _ -> Nothing
-
-parseStartingCoordDir :: Text -> Maybe CoordDir
-parseStartingCoordDir txt = do
- (x, y, d) <- case T.words txt of
- [x, y, d] -> (,,) <$> readMaybeT x <*> readMaybeT y <*> readMaybeT d
- _ -> Nothing
- Just ((x, y), d)
-
-parseCommands :: Text -> Maybe [Cmd]
-parseCommands txt = toCmd `traverse` T.unpack txt
- where
- toCmd :: Char -> Maybe Cmd
- toCmd 'L' = Just (Turn L)
- toCmd 'R' = Just (Turn R)
- toCmd 'M' = Just Move
- toCmd _ = Nothing
Then, we add the Parsec parsers:
+toCmd :: Char -> Maybe Cmd
+toCmd 'L' = Just (Turn L)
+toCmd 'R' = Just (Turn R)
+toCmd 'M' = Just Move
+toCmd _ = Nothing
+
+toDir :: Char -> Maybe Dir
+toDir c = readMaybe [c]
+
+dirParser = do
+ dir <- toDir <$> letter
+ maybe (parserFail "not a valid dir") pure dir
+
+cmdParser = do
+ cmd <- toCmd <$> letter
+ maybe (parserFail "not a valid cmd") pure cmd
+
+parser = do
+ min <- read <$> many1 digit
+ space
+ max <- read <$> many1 digit
+ _ <- newline
+ x <- read <$> many1 digit
+ space
+ y <- read <$> many1 digit
+ space
+ d <- dirParser
+ _ <- newline
+ cs <- many1 cmdParser
+ pure ((min, max), ((x, y), d), cs)
Finally, we plug the new parser in:
+eitherToMaybe :: Either a b -> Maybe b
+eitherToMaybe (Right x) = Just x
+eitherToMaybe (Left _) = Nothing
run :: Text -> Maybe CoordDir
run txt = do
- (max, coordDir, cmds) <- go $ T.lines txt
+ (max, coordDir, cmds) <- eitherToMaybe $ parse parser "" txt
Just $ runCommands cmds max coordDir
- where
- go [f, s, t] = (,,) <$> parsePlateauMax f <*> parseStartingCoordDir s <*> parseCommands t
- go _ = Nothing
Our previous parser returned a Maybe but Parsec's parse returns Either. Thus, we make use of eitherToMaybe to plug in the new parser into our old logic.
Since the Left case of the Either provides some nice information in case parsing fails, let's keep it:
-eitherToMaybe :: Either a b -> Maybe b
-eitherToMaybe (Right x) = Just x
-eitherToMaybe (Left _) = Nothing
-
-run :: Text -> Maybe CoordDir
+run :: Text -> Either ParseError CoordDir
run txt = do
- (max, coordDir, cmds) <- eitherToMaybe $ parse parser "" txt
- Just $ runCommands cmds max coordDir
+ (max, coordDir, cmds) <- parse parser "" txt
+ Right $ runCommands cmds max coordDir
BoundedInt
Part of our code is taking care of wrapping the coordinates when they reach the extremes of the grid:
move ((x, y), N) = (wrap max (x, y+1), N)
move ((x, y), E) = (wrap max (x+1, y), E)
move ((x, y), S) = (wrap max (x, y-1), S)
move ((x, y), W) = (wrap max (x-1, y), W)
wrap (maxX, maxY) (x, y) = (wrap' maxX x, wrap' maxY y)
wrap' max x | x < 0 = max + 1 + x
wrap' max x | x > max = x `rem` max
wrap' max x | otherwise = x
Let's abstract that logic away.
We first define a BoundedInt with an update function which takes care of the wrapping:
+data BoundedInt =
+ BoundedInt Int Int Int
+ deriving (Read, Show)
+
+update :: (Int -> Int) -> BoundedInt -> BoundedInt
+update g (BoundedInt min max val) =
+ BoundedInt min max $ wrap (g val)
+ where
+ wrap x | x < 0 = max + 1 + x `rem` max
+ wrap x | x > max = x `rem` max
+ wrap x | otherwise = x
Then, we update the rest of the code
type Coord =
- (Int, Int)
+ (BoundedInt, BoundedInt)
...
parser = do
- min <- read <$> many1 digit
+ maxX <- read <$> many1 digit
space
- max <- read <$> many1 digit
+ maxY <- read <$> many1 digit
_ <- newline
x <- read <$> many1 digit
space
y <- read <$> many1 digit
space
d <- dirParser
_ <- newline
cs <- many1 cmdParser
- pure ((min, max), ((x, y), d), cs)
+ pure (((BoundedInt 0 maxX x, BoundedInt 0 maxY y), d), cs)
...
- move ((x, y), N) = (wrap max (x, y+1), N)
- move ((x, y), E) = (wrap max (x+1, y), E)
- move ((x, y), S) = (wrap max (x, y-1), S)
- move ((x, y), W) = (wrap max (x-1, y), W)
-
- wrap (maxX, maxY) (x, y) = (wrap' maxX x, wrap' maxY y)
-
- wrap' max x | x < 0 = max + 1 + x
- wrap' max x | x > max = x `rem` max
- wrap' max x | otherwise = x
+ move ((x, y), N) = ((x, update (+ 1) y), N)
+ move ((x, y), E) = ((update (subtract 1) x, y), E)
+ move ((x, y), S) = ((x, update (subtract 1) y), S)
+ move ((x, y), W) = ((update (+ 1) x, y), W)
Extracting modules
It should be quite clear by now that our solution relies on specific types: CoordDir, Cmd, Turn. It's time to house them in their own modules.
We start by promoting CoordDir to a data type:
-type CoordDir =
- (Coord, Dir)
+data CoordDir =
+ CoordDir Coord Dir
+ deriving (Show)
...
parser = do
maxX <- read <$> many1 digit
space
maxY <- read <$> many1 digit
_ <- newline
x <- read <$> many1 digit
space
y <- read <$> many1 digit
space
d <- dirParser
_ <- newline
cs <- many1 cmdParser
- pure (((BoundedInt 0 maxX x, BoundedInt 0 maxY y), d), cs)
+ pure ((CoordDir (BoundedInt 0 maxX x, BoundedInt 0 maxY y) d), cs)
...
runCommands :: [Cmd] -> CoordDir -> CoordDir
runCommands [] coordDir = coordDir
-runCommands (c:cmds) coordDir = runCommands cmds $ newCoordDir c
+runCommands (c:cmds) (CoordDir coord dir) = runCommands cmds $ newCoordDir c
where
- newCoordDir (Turn L) = fmap csucc coordDir
- newCoordDir (Turn R) = fmap cpred coordDir
- newCoordDir Move = move coordDir
-
- move ((x, y), N) = ((x, update (+ 1) y), N)
- move ((x, y), E) = ((update (subtract 1) x, y), E)
- move ((x, y), S) = ((x, update (subtract 1) y), S)
- move ((x, y), W) = ((update (+ 1) x, y), W)
+ newCoordDir (Turn L) = CoordDir coord $ csucc dir
+ newCoordDir (Turn R) = CoordDir coord $ csucc dir
+ newCoordDir Move = move coord dir
+
+ move (x, y) N = CoordDir (x, update (+ 1) y) N
+ move (x, y) E = CoordDir (update (subtract 1) x, y) E
+ move (x, y) S = CoordDir (x, update (subtract 1) y) S
+ move (x, y) W = CoordDir (update (+ 1) x, y) W
Notice how the move function either updates the first or second element of the Coord tuple. Let's refactor that to use the bifunctor instance of tuple:
- move (x, y) N = CoordDir (x, update (+ 1) y) N
- move (x, y) E = CoordDir (update (subtract 1) x, y) E
- move (x, y) S = CoordDir (x, update (subtract 1) y) S
- move (x, y) W = CoordDir (update (+ 1) x, y) W
+ move coord N = CoordDir (second (update (+ 1)) coord) N
+ move coord E = CoordDir (first (update (subtract 1)) coord) E
+ move coord S = CoordDir (second (update (subtract 1)) coord) S
+ move coord W = CoordDir (first (update (+ 1)) coord) W
Now we can extract the modules:
-- Turn.hs
module Turn where
data Turn
= L
| R
deriving (Show, Read)
-- Cmd.hs
module Cmd (Cmd(..), parser) where
import Turn (Turn(..))
import Text.Parsec (parserFail)
import Text.Parsec.Text (Parser)
import Text.Parsec.Char (letter)
data Cmd
= Turn Turn
| Move
deriving (Show)
toCmd :: Char -> Maybe Cmd
toCmd 'L' = Just (Turn L)
toCmd 'R' = Just (Turn R)
toCmd 'M' = Just Move
toCmd _ = Nothing
parser :: Parser Cmd
parser = do
cmd <- toCmd <$> letter
maybe (parserFail "not a valid cmd") pure cmd
-- CoordDir.hs
{-# LANGUAGE DeriveAnyClass #-}
module CoordDir (CoordDir, parser, move, turn) where
import Data.Bifunctor (first, second)
import Text.Read (readMaybe)
import Text.Parsec (parserFail)
import Text.Parsec.Text (Parser)
import Text.Parsec.Char (space, digit, newline, letter)
import Text.Parsec.Combinator (many1)
import Turn (Turn(..))
class (Eq a, Enum a, Bounded a) => CyclicEnum a where
cpred :: a -> a
cpred d
| d == minBound = maxBound
| otherwise = pred d
csucc :: a -> a
csucc d
| d == maxBound = minBound
| otherwise = succ d
data BoundedInt =
BoundedInt Int Int Int
deriving (Read, Show)
type Coord =
(BoundedInt, BoundedInt)
data Dir
= N
| E
| S
| W
deriving (Show, Read, Eq, Enum, Bounded, CyclicEnum)
data CoordDir =
CoordDir Coord Dir
deriving (Show)
toDir :: Char -> Maybe Dir
toDir c = readMaybe [c]
dirParser :: Parser Dir
dirParser = do
dir <- toDir <$> letter
maybe (parserFail "not a valid dir") pure dir
parser :: Parser CoordDir
parser = do
maxX <- read <$> many1 digit
space
maxY <- read <$> many1 digit
_ <- newline
x <- read <$> many1 digit
space
y <- read <$> many1 digit
space
d <- dirParser
pure $ CoordDir (BoundedInt 0 maxX x, BoundedInt 0 maxY y) d
update :: (Int -> Int) -> BoundedInt -> BoundedInt
update g (BoundedInt min max val) =
BoundedInt min max $ wrap (g val)
where
wrap x | x < 0 = max + 1 + x `rem` max
wrap x | x > max = x `rem` max
wrap x | otherwise = x
move :: CoordDir -> CoordDir
move (CoordDir coord N) = CoordDir (second (update (+ 1)) coord) N
move (CoordDir coord E) = CoordDir (first (update (subtract 1)) coord) E
move (CoordDir coord S) = CoordDir (second (update (subtract 1)) coord) S
move (CoordDir coord W) = CoordDir (first (update (+ 1)) coord) W
turn :: Turn -> CoordDir -> CoordDir
turn L (CoordDir coord dir) = CoordDir coord $ cpred dir
turn R (CoordDir coord dir) = CoordDir coord $ csucc dir
-- Main.hs
module Main where
import Data.Text (Text)
import Text.Parsec (parse, ParseError)
import Text.Parsec.Char (newline)
import Text.Parsec.Combinator (many1)
import Text.Parsec.Text (Parser)
import Turn (Turn(..))
import CoordDir (CoordDir)
import qualified CoordDir (turn, move, parser)
import Cmd (Cmd(..))
import qualified Cmd (parser)
parser :: Parser (CoordDir, [Cmd])
parser = do
coordDir <- CoordDir.parser
_ <- newline
cmds <- many1 Cmd.parser
pure (coordDir, cmds)
runCommands :: CoordDir -> [Cmd] -> CoordDir
runCommands = foldl f
where
f coordDir (Turn turn) = CoordDir.turn turn coordDir
f coordDir Move = CoordDir.move coordDir
run :: Text -> Either ParseError CoordDir
run txt = do
(coordDir, cmds) <- parse parser "" txt
pure $ runCommands coordDir cmds
main :: IO ()
main = do
let commands = "5 5\n1 2 N\nLMLMLMLMM"
print $ (parse parser "" ("5 5\n1 2 N\nLM" :: Text) :: Either ParseError (CoordDir, [Cmd]))
either print print $ run commands
One important thing to notice is that CoordDir internals are not exposed from CoordDir.hs. In other words, CoordDir is an opaque data type. That means we could refactor the representation of CoordDir to a totally different type without breaking other modules.
Tidying up
We can refactor runCommands to replace recursiveness to fold. In fact, we can go from
runCommands :: [Cmd] -> CoordDir -> CoordDir
runCommands [] coordDir = coordDir
runCommands (x:xs) coordDir = runCommands xs $ newCoordDir x
where
newCoordDir (Turn turn) = CoordDir.turn turn coordDir
newCoordDir Move = CoordDir.move coordDir
to
runCommands :: CoordDir -> [Cmd] -> CoordDir
runCommands = foldl f
where
f coordDir (Turn turn) = CoordDir.turn turn coordDir
f coordDir Move = CoordDir.move coordDir
Outro
While refactoring I've experimented with a lot of things. Some ideas miserably failed. For example I've tried to make BoundedInt a functor by having a data Bounded2D a b c = Bounded2D a b c type. Unfortunately, implementing a sensible fmap for that proved to be impossible. I've also tried to use a phantom type to make impossible to update the x coord with a y offset but didn't like how it looked like.
In any case, I'm pretty sure I've missed some cool math abstractions. So please let me know in the comments if you have any ideas!