content: module Language.PureScript.Sugar.Operators.Types where
  
  import Prelude
  
  import Control.Monad.Except (MonadError)
  import Language.PureScript.AST (Associativity, SourceSpan)
  import Language.PureScript.Errors (MultipleErrors)
  import Language.PureScript.Names (OpName(..), OpNameType(..), Qualified(..))
  import Language.PureScript.Sugar.Operators.Common (matchOperators)
  import Language.PureScript.Types (SourceType, Type(..), srcTypeApp)
  
  matchTypeOperators
    :: MonadError MultipleErrors m
    => SourceSpan
    -> [[(Qualified (OpName 'TypeOpName), Associativity)]]
    -> SourceType
    -> m SourceType
  matchTypeOperators ss = matchOperators isBinOp extractOp fromOp reapply id
    where
  
    isBinOp :: SourceType -> Bool
    isBinOp BinaryNoParensType{} = True
    isBinOp _ = False
  
    extractOp :: SourceType -> Maybe (SourceType, SourceType, SourceType)
    extractOp (BinaryNoParensType _ op l r) = Just (op, l, r)
    extractOp _ = Nothing
  
    fromOp :: SourceType -> Maybe (SourceSpan, Qualified (OpName 'TypeOpName))
    fromOp (TypeOp _ q@(Qualified _ (OpName _))) = Just (ss, q)
    fromOp _ = Nothing
  
    reapply :: a -> Qualified (OpName 'TypeOpName) -> SourceType -> SourceType -> SourceType
    reapply _ op = srcTypeApp . srcTypeApp (TypeOp (ss, []) op)
  