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 :: forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceSpan
-> [[(Qualified (OpName 'TypeOpName), Associativity)]]
-> SourceType
-> m SourceType
matchTypeOperators SourceSpan
ss = forall (m :: * -> *) a (nameType :: OpNameType).
(Show a, MonadError MultipleErrors m) =>
(a -> Bool)
-> (a -> Maybe (a, a, a))
-> FromOp nameType a
-> Reapply nameType a
-> ([[Operator (Chain a) () Identity a]]
    -> [[Operator (Chain a) () Identity a]])
-> [[(Qualified (OpName nameType), Associativity)]]
-> a
-> m a
matchOperators SourceType -> Bool
isBinOp SourceType -> Maybe (SourceType, SourceType, SourceType)
extractOp SourceType -> Maybe (SourceSpan, Qualified (OpName 'TypeOpName))
fromOp forall a.
a
-> Qualified (OpName 'TypeOpName)
-> SourceType
-> SourceType
-> SourceType
reapply forall a. a -> a
id
  where

  isBinOp :: SourceType -> Bool
  isBinOp :: SourceType -> Bool
isBinOp BinaryNoParensType{} = Bool
True
  isBinOp SourceType
_ = Bool
False

  extractOp :: SourceType -> Maybe (SourceType, SourceType, SourceType)
  extractOp :: SourceType -> Maybe (SourceType, SourceType, SourceType)
extractOp (BinaryNoParensType (SourceSpan, [Comment])
_ SourceType
op SourceType
l SourceType
r) = forall a. a -> Maybe a
Just (SourceType
op, SourceType
l, SourceType
r)
  extractOp SourceType
_ = forall a. Maybe a
Nothing

  fromOp :: SourceType -> Maybe (SourceSpan, Qualified (OpName 'TypeOpName))
  fromOp :: SourceType -> Maybe (SourceSpan, Qualified (OpName 'TypeOpName))
fromOp (TypeOp (SourceSpan, [Comment])
_ q :: Qualified (OpName 'TypeOpName)
q@(Qualified QualifiedBy
_ (OpName Text
_))) = forall a. a -> Maybe a
Just (SourceSpan
ss, Qualified (OpName 'TypeOpName)
q)
  fromOp SourceType
_ = forall a. Maybe a
Nothing

  reapply :: a -> Qualified (OpName 'TypeOpName) -> SourceType -> SourceType -> SourceType
  reapply :: forall a.
a
-> Qualified (OpName 'TypeOpName)
-> SourceType
-> SourceType
-> SourceType
reapply a
_ Qualified (OpName 'TypeOpName)
op = SourceType -> SourceType -> SourceType
srcTypeApp forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceType -> SourceType -> SourceType
srcTypeApp (forall a. a -> Qualified (OpName 'TypeOpName) -> Type a
TypeOp (SourceSpan
ss, []) Qualified (OpName 'TypeOpName)
op)