obscure graph hackage

graphsearch.hs

import Data.List     		(unfoldr, minimumBy)
import Data.Char 			(isSpace)
import Data.Function 		(on)
import Data.Maybe 			(mapMaybe, fromMaybe)
import System.Environment 	(getArgs)

import qualified Data.ByteString.Char8 as L
import qualified Data.IntMap as IM

type GraphData = (IM.IntMap (IM.IntMap [(Int, Int)]), Int)

readGraph :: L.ByteString -> (GraphData, [Int])
readGraph contents = ((graph, n_nodes), traces)
	where
		intArray = unfoldr step contents
			where step s = case L.readInt s of
				Nothing -> Nothing
				Just (k, t) -> Just (k, L.dropWhile isSpace t)
		(n_nodes:n_edges:n_traces:n_labels:_, other) = splitAt 4 intArray
		(traces, edges) = splitAt n_traces other
		graph = foldl insertLabel initMap $ takeEvery 4 edges
			where
				initMap = IM.fromDistinctAscList [(n, IM.empty) | n <- [0 .. n_labels - 1]]
				insertLabel m (from:to:label:weight: _) = IM.insertWith 
					(IM.unionWith (++)) label (IM.singleton from [(to, weight)]) m
				takeEvery n = map (take n) . takeWhile (not . null) . iterate (drop n)

runBellman :: (GraphData, [Int]) -> Maybe (Int, [Int])
runBellman (graphData, traces) = if IM.null finalLayer then Nothing
		else Just $ bestPath $ map (\(a, (b, c)) -> (b, a:c)) (IM.toList finalLayer)
	where
		(graph, n_nodes) = graphData
		bestPath = minimumBy (compare `on` fst)
		startingLayer = IM.fromDistinctAscList [(n, (0, [n])) | n <- [0 .. n_nodes - 1]]
		layerProcessor label layer = IM.mapMaybe processNode subGraph
			where
				subGraph = IM.findWithDefault IM.empty label graph
				processEdge (to, weight) = case IM.lookup to layer of
					Nothing -> Nothing
					Just (cost, path) -> Just (cost + weight, to:path)
				processNode edges = if null result then Nothing  else Just (bestPath result)
					where result = mapMaybe processEdge edges
		finalLayer = foldr layerProcessor startingLayer traces
	
main = do
	args <- getArgs
	let filename = (if null args then "." else head args) ++ "/input.txt"
	fileContents <- L.readFile filename
	print . fst . fromMaybe (-1, []) . runBellman $ readGraph fileContents