Generate a random 3x3 unlock pattern for Android devices

Lockpattern.hs

{-
	File: Lockpattern.hs

	This programm calculates a pattern for the 3x3 lock screen in Android
	devices. It outputs the path in form of a matrix with numbered
	finger positions.

-}

import System.Random
import Data.Maybe
import Data.List

main :: IO()
main = do
	seed <- getStdGen
	let allpoints = [(x,y) | x<-[1..3],y<-[1..3]]
	let lockpattern = swipe seed [] Nothing allpoints -- do the magic
	let numberedpoints = zip [1..9] lockpattern
	drawPattern $ map fst $ sortBy outputOrder numberedpoints

-- swipes one line at a time until everything was visited
-- check if we pass via points and remove them too, if needed
swipe :: StdGen -> [(Int,Int)] -> Maybe (Int,Int) -> [(Int,Int)] -> [(Int,Int)]
swipe seed lastpattern lastp unvisitedp =
	if unvisitedp==[]
		then lastpattern
		else swipe seed (lastpattern ++ via ++ [(x,y)]) (Just (x,y)) unvisitedp'
		where
			via = case viap of
				Nothing -> []
				Just p	-> [p]
			(x,y) = pickRand unvisitedp seed
			unvisitedpn = filterOut unvisitedp (x,y)
			(viap,unvisitedp') = searchCrossings lastp unvisitedpn (x,y)

-- removes one point element
filterOut :: [(Int,Int)] -> (Int,Int) -> [(Int,Int)]
filterOut arr (x,y) = filter (/=(x,y)) arr

-- picks one random point from the available in arr
pickRand :: [(Int,Int)] -> StdGen -> (Int,Int)
pickRand arr seed = arr !! (fst $ randomR (0,length arr-1) seed)

-- search for via points, return and remove them if found
searchCrossings :: Maybe (Int,Int) -> [(Int,Int)] -> (Int,Int) -> (Maybe (Int,Int),[(Int,Int)])
searchCrossings mlastp unvisitedp nextp = case mlastp of
	Just lastp	-> checkCrossing lastp unvisitedp nextp
	Nothing		-> (Nothing,unvisitedp)

-- returns the via point and remaining array, if passed across
checkCrossing :: (Int,Int) -> [(Int,Int)] -> (Int,Int) -> (Maybe (Int,Int),[(Int,Int)])
checkCrossing (x',y') unvisitedp (x,y) =
	let viap = if not (dx==1 || dy==1)
		then find ((==) (if dx==2 then 2 else x,if dy==2 then 2 else y)) unvisitedp
		else Nothing
		where (dx,dy) = (abs $ x-x',abs $ y-y')
	in case viap of
		Nothing	->	(Nothing,unvisitedp)
		Just p	->	(Just p,filterOut unvisitedp p)

-- sort order
outputOrder :: (Int,(Int,Int)) -> (Int,(Int,Int)) -> Ordering
outputOrder (_,(a,b)) (_,(c,d)) = if b/=d then compare b d else compare a c

-- outputs a human-readable pattern
drawPattern :: [Int] -> IO()
drawPattern point = do
	putStr $ concat $ map (\(x,y) -> if ((y `mod` 3)==2)
		then show x ++ "\n\n"
		else show x ++ "   ") $ zip point [0..]