Finding right angles between 2D vectors using comonads

comonadVectorDiff.hs

-- This is using a haskell comonad to find right angles between given geometrical vectors
-- The code is kind of overkill, but it is a cute showcase of comonads


-- a FocusSet. One element in Focus, and all other elements in a list.
data Fs a = Fs a [a] deriving (Show)

instance Functor Fs where
    fmap fun (Fs k l) = Fs (fun k) (map fun l)

class Functor w => Comonad w where
    (=>>)    :: w a -> (w a -> b) -> w b
    extract :: w a -> a -- alias for coreturn
    duplicate   :: w a -> w (w a) -- alias for cojoin
    x =>> f = fmap f (duplicate x) -- default implementation of co-kliesli

instance Comonad Fs where
    extract (Fs k _) = k
    duplicate f = Fs f (allShifts f)


focusOnItem :: [a] -> Fs a
focusOnItem s = Fs (head s) (tail s)

allShifts :: Fs a -> [Fs a]
allShifts f@(Fs _ set) = map (\i -> swapFocus i f) $ [0..n]
    where n = (length set) - 1

swapFocus i (Fs focus set) = Fs (set !! i) (replaceAt i set focus)
replaceAt :: Int -> [a] -> a -> [a]
replaceAt i set focus = a ++ [focus] ++ (tail b)
    where (a,b) = splitAt i set

toList :: Fs a -> [a]
toList (Fs f s) = f : s

edgy :: Fs Int -> [(Int,Int)]
edgy (Fs a bs) = map (\b -> (a,b) ) bs

-- Geometry code for 2D-vectors
-- N.B. this could have been written with restricted type parameter as
-- data (Num a) => Vec a = Vec a a deriving (Show) 
-- but the conventions of haskell says we should not. That should be in function declarations instead!
data Vec a = Vec a a deriving (Show)


vAdd :: (Num t) => Vec t -> Vec t -> Vec t
vScale :: (Num t) => t -> Vec t -> Vec t
vDiff :: (Num t) => Vec t -> Vec t -> Vec t
vScalar :: (Num t) => Vec t -> Vec t -> t

vAdd (Vec i j) (Vec k l) = Vec (i+k) (j+l)
vScale n (Vec k l) = Vec (n*k) (n*l)
vDiff v1 v2 = vAdd v1 $ vScale (-1) v2
vScalar (Vec i j) (Vec k l) = (i*k)+(j*l)


-- Generic Code
indexWhere p = map (\(a,b) -> a ) . filter p .  zip [0..]


-- Special Code
toDiffVectors (Fs v1 v2s) = map (\v2 -> vDiff v2 v1 ) v2s

findRightAngleCorner x = 
        indexWhere  (\(a,b) -> b == 0) $
        map (\l -> vScalar (head l) (l !! 1) ) $
        toList $ 
        x =>> toDiffVectors

-- program

main = let  x = focusOnItem [Vec 1 5, Vec 5 1,Vec 1 1]
        in putStrLn . show  $ (!!) ( toList $ x =>> toDiffVectors ) $ head . findRightAngleCorner  $ x