module Language.PureScript.Sugar.Operators.Binders where

import Prelude

import Control.Monad.Except (MonadError)

import Language.PureScript.AST (Associativity, Binder(..), SourceSpan)
import Language.PureScript.Errors (MultipleErrors)
import Language.PureScript.Names (OpName(..), OpNameType(..), Qualified(..))
import Language.PureScript.Sugar.Operators.Common (matchOperators)

matchBinderOperators
  :: MonadError MultipleErrors m
  => [[(Qualified (OpName 'ValueOpName), Associativity)]] 
  -> Binder
  -> m Binder
matchBinderOperators :: forall (m :: * -> *).
MonadError MultipleErrors m =>
[[(Qualified (OpName 'ValueOpName), Associativity)]]
-> Binder -> m Binder
matchBinderOperators = 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 Binder -> Bool
isBinOp Binder -> Maybe (Binder, Binder, Binder)
extractOp Binder -> Maybe (SourceSpan, Qualified (OpName 'ValueOpName))
fromOp SourceSpan
-> Qualified (OpName 'ValueOpName) -> Binder -> Binder -> Binder
reapply forall a. a -> a
id
  where

  isBinOp :: Binder -> Bool
  isBinOp :: Binder -> Bool
isBinOp BinaryNoParensBinder{} = Bool
True
  isBinOp Binder
_ = Bool
False

  extractOp :: Binder -> Maybe (Binder, Binder, Binder)
  extractOp :: Binder -> Maybe (Binder, Binder, Binder)
extractOp (BinaryNoParensBinder Binder
op Binder
l Binder
r) = forall a. a -> Maybe a
Just (Binder
op, Binder
l, Binder
r)
  extractOp Binder
_ = forall a. Maybe a
Nothing

  fromOp :: Binder -> Maybe (SourceSpan, Qualified (OpName 'ValueOpName))
  fromOp :: Binder -> Maybe (SourceSpan, Qualified (OpName 'ValueOpName))
fromOp (OpBinder SourceSpan
ss q :: Qualified (OpName 'ValueOpName)
q@(Qualified QualifiedBy
_ (OpName Text
_))) = forall a. a -> Maybe a
Just (SourceSpan
ss, Qualified (OpName 'ValueOpName)
q)
  fromOp Binder
_ = forall a. Maybe a
Nothing

  reapply :: SourceSpan -> Qualified (OpName 'ValueOpName) -> Binder -> Binder -> Binder
  reapply :: SourceSpan
-> Qualified (OpName 'ValueOpName) -> Binder -> Binder -> Binder
reapply SourceSpan
ss = Binder -> Binder -> Binder -> Binder
BinaryNoParensBinder forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Qualified (OpName 'ValueOpName) -> Binder
OpBinder SourceSpan
ss