never executed always true always false
    1 {-|
    2 Module:      Y2015.D03
    3 Description: Advent of Code Day 03 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the day 03 set of problems for <adventofcode.com>.
    8 -}
    9 module Y2015.D03
   10   ( santaRun
   11   , roboRun
   12   ) where
   13 
   14 import Data.Set  (Set)
   15 import Data.Text (Text)
   16 import Witch
   17 
   18 import qualified Data.Set  as Set
   19 import qualified Data.Text as T
   20 
   21 type Point = (Int, Int)
   22 
   23 direction :: Char -> Point
   24 direction c
   25   | c == '^' = (0, 1)
   26   | c == 'v' = (0, -1)
   27   | c == '>' = (1, 0)
   28   | c == '<' = (-1, 0)
   29   | otherwise = (0, 0)
   30 
   31 mapDirection :: Text -> [Point]
   32 mapDirection = T.foldl' dir []
   33   where
   34     dir l c = direction c : l
   35 
   36 start :: Set Point
   37 start = Set.singleton (0, 0)
   38 
   39 move :: Point -> Point -> Point
   40 move (dx, dy) (x, y) = (x + dx, y + dy)
   41 
   42 -- |Find number of deliverables for santa's route
   43 santaRun
   44   :: Text -- ^ Route input
   45   -> Int  -- ^ Number of stops
   46 santaRun = Set.size . deliver start . mapDirection
   47 
   48 -- |Find number of deliverables for the robot's route
   49 roboRun
   50   :: Text -- ^ Route input
   51   ->  Int -- ^ Number of stops
   52 roboRun = Set.size . teamDelivery . tMap direction . divideWork . into @String
   53   where
   54     teamDelivery = uncurry (deliver . deliver start)
   55 
   56 tMap :: (a -> b) -> ([a], [a]) -> ([b], [b])
   57 tMap f (a1, a2) = (map f a1, map f a2)
   58 
   59 divideWork :: String -> (String, String)
   60 divideWork [] = ([], [])
   61 divideWork [x] = ([x], [])
   62 divideWork (x:y:zs) = (x : xp, y : yp)
   63   where
   64     (xp, yp) = divideWork zs
   65 
   66 deliver :: Set Point -> [Point] -> Set Point
   67 deliver = navigate (0, 0)
   68 
   69 navigate :: Point -> Set Point -> [Point] -> Set Point
   70 navigate _ history [] = history
   71 navigate origin history (dir:plans) =
   72   let newPoint = move dir origin
   73       step = Set.insert newPoint history
   74   in navigate newPoint step plans