{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}

module QIO.Vec where

newtype Vec x a = Vec {unVec :: [(a,x)]} deriving Show

empty :: Vec x a
empty = Vec []
 
(<@@>) :: (Num x,Eq a) => Vec x a -> a -> x
(Vec ms) <@@> a = foldr (\(b,k) m -> if a == b then m + k else m) 0 ms

(<**>) :: Num x => x -> (Vec x a) -> Vec x a
l <**> (Vec as) = (Vec (map (\ (a,k) -> (a,l*k)) as))

(<++>) :: (Vec x a) -> (Vec x a) -> Vec x a
(Vec as) <++> (Vec bs) = (Vec (as ++ bs))

instance Num n => Monad (Vec n) where
    return a = Vec [(a,1)]
    (Vec ms) >>= f = Vec [(b,i*j) | (a,i) <- ms, (b,j) <- unVec (f a)]