Broken Dijkstra

{-# LANGUAGE FlexibleInstances #-}
module Main where

import Control.Monad
import Control.Monad.ST
import Data.Ix (Ix, rangeSize)
import Data.Array
import Data.Array.MArray
import Data.Array.ST
import Data.STRef
--import Data.Array.Unboxed

main :: IO ()
main = return ()

data RealPlus a = Infinity | RealPlus a

instance (Eq a) => Eq (RealPlus a) where
    (==) (RealPlus v1) (RealPlus v2) = v1 == v2
    (==) Infinity Infinity = True
    (==) _ _ = False

instance (Ord a) => Ord (RealPlus a) where
    (<=) (RealPlus v1) (RealPlus v2) = v1 <= v2
    (<=) Infinity (RealPlus v) = False
    (<=) (RealPlus v) Infinity = True

instance Functor (RealPlus) where
    fmap f Infinity = Infinity
    fmap f (RealPlus x) = RealPlus . f $ x

data Edge a b = Edge { dest :: a
                     , dist :: b }

data Node a b = Node  { ix     :: a
                      , edgev  :: [Edge a b] -- edgevector
                      , active :: Bool
                      }

data Result a b = Result { target  :: a
                         , resultv :: [(a, b, a)]
                         }

type Graph i w = Array i ([Edge i w], Bool)


insertSorted :: (Ix i, Ord a, Real a) => [(i, RealPlus a)] -> (i, RealPlus a) -> [(i, RealPlus a)] -- Makeshift pqueue
insertSorted [] a = [a]
insertSorted (h@(i1, v1) : xs) e@(i2, v2)
    | i1 == i2 = (i1, min v1 v2) : xs
    | v1 < v1 = h : insertSorted xs e
    | v1 > v2 = e : h : xs
    | v1 == v2 = e : h : xs


graph :: (Ix i, Real w, Ord w) => (i, i) -> [Node i (RealPlus w)] -> Graph i (RealPlus w)
graph r xs = array r $ map f xs where
    f (Node i e x) = (i, (e, x))

-- Result i (RealPlus w)
dijkstra :: (Ix i, Real w, Ord w) => i -> Graph i (RealPlus w) -> ()
dijkstra t g =  let
    sz = rangeSize . bounds $ g
    f target result n = runSTArray $ do
        result_raw <- newArray (bounds g) (Infinity, Nothing) :: ST s (STArray s i (RealPlus w, Maybe i)) -- Distance, Previous. Results hashed -> dist prev
        fresh <- newArray (bounds g) True :: ST s (STArray s i Bool )                                     -- Detect if traversed previously
        --writeArray fresh t False
        --writeArray result_raw t (0, Nothing)
        return result_raw
    in ()