{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
module Overload.General where

import Data.Functor.Identity
import Control.Effects.State
import Control.Monad
import Data.List (foldl')

import Overload.TypeTree

type VariableMapping a b = [(a, TypeTree b)]

trySetVar :: (MonadEffect (State (VariableMapping a b)) m, Eq a, Eq b) => a -> TypeTree b -> m Bool
trySetVar name typ = do
    mapping <- getState
    case lookup name mapping of
        Just typ' | typ == typ' -> return True
                  | otherwise   -> return False
        Nothing -> do
            setState ((name, typ) : mapping)
            return True

isMoreGeneralThan :: forall a b. (Eq a, Eq b) => TypeTree a -> TypeTree b -> Bool
isMoreGeneralThan t1 t2 =
    runIdentity (implementStateViaStateT ([] :: VariableMapping a b) (isMoreGeneralThan' t1 t2))

isMoreGeneralThan' :: (MonadEffect (State (VariableMapping a b)) m, Eq a, Eq b)
                   => TypeTree a -> TypeTree b -> m Bool
isMoreGeneralThan' (Var n) t = trySetVar n t
isMoreGeneralThan' (Concrete n1) (Concrete n2) | n1 == n2 = return True
isMoreGeneralThan' (App t1 t2) (App t3 t4) =
    (&&) <$> t1 `isMoreGeneralThan'` t3 <*> t2 `isMoreGeneralThan'` t4
isMoreGeneralThan' _ _ = return False

getEqualities :: forall a b. (Eq a, Eq b) => TypeTree a -> TypeTree b -> [(b, TypeTree a)]
getEqualities specific general = runIdentity $ implementStateViaStateT ([] :: VariableMapping b a) $ do
    res <- general `isMoreGeneralThan'` specific
    if res then getState
    else error "Can't get equalities because the second type isn't more general than the first"

minimize :: Eq a => [TypeTree a] -> [TypeTree a]
minimize [] = []
minimize (t : ts) = foldl' minimizer [t] ts
    where minimizer ms candidate = runIdentity $ implementStateViaStateT True $ do
              ms' <- filterM (\m ->
                  if m `isMoreGeneralThan` candidate then setState False >> return True
                  else if candidate `isMoreGeneralThan` m then return False
                  else return True) ms
              newMin <- getState
              if newMin then return (candidate : ms')
              else return ms'