Dijkstra shortest path algorithm (ADAA1 week 5)

Graph.hs

{-# LANGUAGE UnicodeSyntax #-}
module Graph
  ( Distance, Graph, Vertex
  , fromList, findShortestPath, findShortestPaths, findShortestPaths_
  ) where

import Control.Monad (when)
import Control.Monad.Reader (Reader, ask, runReader)
import Control.Monad.State (StateT, execStateT, get, put)
import Data.Function (on)
import Data.IntMap (fromList)
import Data.List (sortBy)
import Data.Maybe (listToMaybe)
import qualified Data.IntMap as IM

type Distance = Int
type Graph = IM.IntMap (IM.IntMap Vertex)
type Vertex = Int

findShortestPaths ∷ Graph → Vertex → IM.IntMap Distance
findShortestPaths γ v = runReader (execStateT allSteps (fromList [(v,0)])) γ

findShortestPaths_ ∷ Graph → Vertex → [(Vertex,Distance)]
findShortestPaths_ γ v = IM.toList $ findShortestPaths γ v

findShortestPath ∷ Graph → Vertex → Vertex → Maybe Distance
findShortestPath γ s t = IM.lookup t $ findShortestPaths γ s

step ∷ StateT (IM.IntMap Distance) (Reader Graph) Bool
step = do
  γ ← ask
  δ ← get
  case minimize . filterUnvisited δ . collectCandidated γ δ $ IM.keys δ of
    Just (v, d) → do
      put $ IM.insert v d δ
      return True
    Nothing → return False
    where
      minimize = listToMaybe . sortBy (compare `on` snd)
      filterUnvisited δ = IM.toList . IM.filterWithKey (\k _ → k `IM.notMember` δ)
      collectCandidated γ δ = IM.unionsWith min . map (\v → IM.map (+ δ IM.! v) $ γ IM.! v)

allSteps ∷ StateT (IM.IntMap Vertex) (Reader Graph) ()
allSteps = do
  r ← step
  when r allSteps

main.hs

{-# LANGUAGE UnicodeSyntax #-}
import System.Environment (getArgs)
import Control.Arrow ((&&&))
import Data.Maybe (fromJust, fromMaybe, mapMaybe)
import Control.Applicative ((<$>))
import Control.Monad (liftM)

import qualified Data.ByteString.Lazy.Char8 as BSC

import Graph

targets ∷ [Int]
targets = [7,37,59,82,99,115,133,165,188,197]

main = do
  γ ← readGraph . head =<< getArgs
  print $ map (fromMaybe 1000000 . flip lookup (findShortestPaths_ γ 1)) targets

readGraph ∷ FilePath → IO Graph
readGraph φ = fromList . map ((vert &&& (fromList . vertices)) . BSC.words) . BSC.lines <$> BSC.readFile φ
  where
    vert = fromJust . liftM fst . BSC.readInt . head
    vertices = map ((\[i,v] → (i,v)) . map fst . mapMaybe BSC.readInt . BSC.split ',') . tail

👍