It draws an ASCII spiral

Spiral.hs

module Spiral where

import System.Environment
import qualified Data.List as List
import qualified Data.Set as Set

{- Process outline:
 - 1. Create infinite sequence of points on the spiral
 - 2. Take a finite subsequence
 - 3. Shift all the points so the origin is in the top left
 - 4. Create a [[Char]] array using the set of points
 -
 - CLI: spiral <n> <points|arms>
 - The reference spiral is 600 points
 -}

main :: IO ()
main = do
    (nstr:kind:_) <- getArgs
    let n = read nstr
        k = case kind of "arms" -> spiralByArms; "points" -> spiralByPoints
        pts = shiftOrigin $ k n
    mapM_ putStrLn $ makeStrings pts

-- Represent direction of travel when building spiral or translating points
data Facing = Dn | Ri | Up | Le
    deriving (Eq, Show, Ord, Enum)

-- I want a spiral with N sides/arms
spiralByArms :: Int -> [(Int, Int)]
spiralByArms n = List.concat $ List.take n spiralCoordSeq

-- I want a spiral with N points (may truncate an arm)
spiralByPoints :: Int -> [(Int, Int)]
spiralByPoints n = List.take n $ List.concat spiralCoordSeq

-- Infinite sequence of list of points in a spiral, starting at 0,0
-- start the spiral at (0,0), facing down, first arm length 1
spiralCoordSeq :: [[(Int, Int)]]
spiralCoordSeq = moreCoordSeq (0,0) (List.cycle [(Dn)..(Le)]) 1

-- recursively generate infinite sequence of "arms" in a spriral
-- FIXME: call to `last` is inefficient; can we make that a `head`?
moreCoordSeq :: (Int, Int) -> [Facing] -> Int -> [[(Int, Int)]]
moreCoordSeq startCoord (dir:restDir) len = arm : moreCoordSeq nextStart restDir (len + 1)
    where arm = makeArm startCoord dir len
          nextStart = nudge dir (last arm)

-- Specifically for determining the start point of the next arm based on the
-- last point in the current one
-- `nudge = translate 1`
-- ...was all good until we realized that horizontal arms have to skip cells:
nudge :: Facing -> (Int, Int) -> (Int, Int)
nudge Dn (x, y) = (x, y + 1)
nudge Up (x, y) = (x, y - 1)
nudge Ri (x, y) = (x + 2, y)
nudge Le (x, y) = (x - 2, y)

-- ( these could easily all be off by one )
-- check: (0,0) -> _ -> 1
makeArm :: (Int, Int) -> Facing -> Int -> [(Int, Int)]
makeArm (sx, sy) Dn len = [(sx, y) | y <- [sy..(sy + (len - 1))]]
makeArm (sx, sy) Up len = [(sx, y) | y <- List.reverse [(sy - (len - 1))..sy]]
makeArm (sx, sy) Ri len = each 2 [(x, sy) | x <- [sx..(sx + (len * 2 - 1))]]
makeArm (sx, sy) Le len = each 2 [(x, sy) | x <- List.reverse [(sx - (len * 2 - 1))..sx]]

-- Used to take every nth element of a list, *starting with the first*
-- http://stackoverflow.com/a/7600153
each :: Int -> [a] -> [a]
each n = map snd . filter ((==1) . fst) . zip (cycle [1..n])

-- we need to shift all the coordinates so that 0,0 is at the top left
-- instead of being at the center, so we can create a [String] more easily
shiftOrigin :: [(Int, Int)] -> [(Int, Int)]
shiftOrigin coords = List.map (shiftleft . shiftup) coords
    where minx = List.minimum $ List.map fst coords
          miny = List.minimum $ List.map snd coords
          shiftleft = translate (abs minx) Ri
          shiftup = translate (abs miny) Dn

-- move a point the specified amount in the specified direction
translate :: Int -> Facing -> (Int, Int) -> (Int, Int)
translate mag Dn (x, y) = (x, y + mag)
translate mag Ri (x, y) = (x + mag, y)
translate mag Up (x, y) = (x, y - mag)
translate mag Le (x, y) = (x - mag, y)

-- convert list of coordinates into something printable
makeStrings :: [(Int, Int)] -> [[Char]]
makeStrings coords = [[ if Set.member (x,y) cset then '*' else ' ' | x <- [0..xsize]] | y <- [0..ysize]]
    where cset = Set.fromList coords
          (xsize,ysize) = findDimensions coords

-- to build the [[Char]], we have to find how large this thing is...
-- so find the largest and smallest x and y, subtract for size
-- TODO: can add padding to the top left to match example spiral
findDimensions :: [(Int, Int)] -> (Int, Int)
findDimensions coords = (lrgx - smlx, lrgy - smly)
    where (smlx, lrgx, smly, lrgy) = List.foldl foldhelp (0,0,0,0) coords
          foldhelp (minx, maxx, miny, maxy) (x,y) =
              (min minx x, max maxx x, min miny y, max maxy y)