488 lines
18 KiB
Haskell
488 lines
18 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
module Language.Haskell.Brittany.Internal.Components.OpTree where
|
|
|
|
import Language.Haskell.Brittany.Internal.Prelude
|
|
|
|
import qualified Data.Text as Text
|
|
import GHC.Types.Fixity ( Fixity(Fixity)
|
|
, FixityDirection
|
|
( InfixL
|
|
, InfixN
|
|
, InfixR
|
|
)
|
|
)
|
|
import GHC.Types.SourceText ( SourceText(NoSourceText) )
|
|
import qualified Safe
|
|
import qualified Data.Char
|
|
import Data.Data ( toConstr )
|
|
|
|
import Language.Haskell.Brittany.Internal.Components.BriDoc
|
|
import Language.Haskell.Brittany.Internal.Utils
|
|
import Language.Haskell.Brittany.Internal.Types
|
|
import Language.Haskell.Brittany.Internal.Config.Types
|
|
( UnknownFixityHandling(..) )
|
|
|
|
|
|
|
|
displayOpTree :: OpTree -> String
|
|
displayOpTree = \case
|
|
OpUnknown p _ _ leftTree rs ->
|
|
( "(OpUnknown "
|
|
++ show p
|
|
++ " "
|
|
++ displayOpTree leftTree
|
|
++ " ["
|
|
++ intercalate
|
|
","
|
|
[ ("(" ++ showOp op ++ "," ++ displayOpTree x ++ ")") | (op, x) <- rs ]
|
|
++ "])"
|
|
)
|
|
OpKnown p _ _ _ fixity tree ops ->
|
|
( "OpKnown "
|
|
++ show p
|
|
++ " "
|
|
++ showOutputable fixity
|
|
++ " ("
|
|
++ displayOpTree tree
|
|
++ ")"
|
|
++ join [ (showOp op ++ "(" ++ displayOpTree t ++ ")") | (op, t) <- ops ]
|
|
)
|
|
OpLeaf _ (x, _) -> show x
|
|
where
|
|
showOp :: BriDocNumbered -> String
|
|
showOp = \case
|
|
(_, BDFlushCommentsPrior _ x) -> showOp x
|
|
(_, BDQueueComments _ x ) -> showOp x
|
|
(_, BDLit x ) -> Text.unpack x
|
|
-- (_, BDFlushCommentsPrior _ (_, BDFlushCommentsPrior _ (_, x)))
|
|
-- | trace (show $ toConstr x) False -> "meow"
|
|
(i, _ ) -> show i
|
|
|
|
|
|
-- lookupFixities :: Monad m => OpTree -> m OpTree
|
|
-- lookupFixities = \case
|
|
-- OpNode par Nothing opDoc chldrn -> do
|
|
-- pure $ OpNode par (hardcodedFixity (Text.unpack opDoc)) opDoc chldrn
|
|
-- x@OpNode{} -> pure x
|
|
-- x@OpLeaf{} -> pure x
|
|
|
|
data ReformatParenMode
|
|
= ReformatParenModeKeep -- don't modify parens at all
|
|
| ReformatParenModeClean -- remove unnecessary parens
|
|
| ReformatParenModeAll -- add superfluous parens everywhere
|
|
|
|
-- [(Bool, Fixity, Text, [OpTree])]
|
|
|
|
-- a == b + c || d * e /= f
|
|
-- _ a
|
|
-- == a, _ b
|
|
-- == a, + b, _ c
|
|
-- == a, + b c
|
|
-- == a (+ b c)
|
|
-- || (== a (+ b c)), _ d
|
|
-- || (== a (+ b c)), * d, _ e
|
|
-- || (== a (+ b c)), * d e
|
|
-- || (== a (+ b c)), /= (* d e), _ f
|
|
-- || (== a (+ b c)), /= (* d e) f
|
|
-- || (== a (+ b c)) (/= (* d e) f)
|
|
|
|
data StackElem = StackElem (Bool, Fixity) [(OpTree, BriDocNumbered)]
|
|
type Stack = [StackElem]
|
|
|
|
balanceOpTree
|
|
:: UnknownFixityHandling -> Bool -> OpTree -> ([BrittanyError], OpTree)
|
|
balanceOpTree unknownFixityHandling allowUnqualify = outer
|
|
where
|
|
outer = \case
|
|
x@OpLeaf{} -> ([], x)
|
|
OpKnown paren allowT locO locC fixity@(Fixity _ (-1) _) left rest ->
|
|
let
|
|
(warnsLeft, balancedLeft) = outer left
|
|
opRes = [ (op, outer argTree) | (op, argTree) <- rest ]
|
|
in ( warnsLeft ++ [ w | (_, (warns, _)) <- opRes, w <- warns ]
|
|
, OpKnown paren
|
|
allowT
|
|
locO
|
|
locC
|
|
fixity
|
|
balancedLeft
|
|
[ (op, balanced) | (op, (_, balanced)) <- opRes ]
|
|
)
|
|
x@OpKnown{} -> ([], x)
|
|
x@(OpUnknown paren locO locC left rest) ->
|
|
let (warns, balancedLeft) = outer left
|
|
in case go [] rest balancedLeft of
|
|
Right (leaf@OpLeaf{}) -> (warns, leaf)
|
|
Right (OpKnown _paren allowT _ _ fixity c cs) ->
|
|
(warns, OpKnown paren allowT locO locC fixity c cs)
|
|
Right t -> (warns, t)
|
|
Left moreWarns -> ((warns ++ moreWarns), x)
|
|
-- singleton :: BriDocNumbered -> StackElem
|
|
-- singleton x = StackElem (Fixity NoSourceText 99 InfixN) (OpLeaf x) []
|
|
go
|
|
:: Stack
|
|
-> [(BriDocNumbered, OpTree)]
|
|
-> OpTree
|
|
-> Either [BrittanyError] OpTree
|
|
go [] [] _ = Left []
|
|
go [StackElem fxty cs] [] c =
|
|
let (e1, eops) = shiftOps cs c in Right (known fxty e1 eops)
|
|
go (StackElem fxty cs : StackElem fixity cs2 : rest) [] c =
|
|
-- go (StackElem fixity (OpKnown False fxty (reverse cs) : cs2) : rest) []
|
|
let (e1, eops) = shiftOps cs c
|
|
in go (StackElem fixity cs2 : rest) [] (known fxty e1 eops)
|
|
go stack input@((opDoc, val) : inputR) c = case stack of
|
|
[] -> do
|
|
fxty <- docFixity opDoc
|
|
go [StackElem fxty [(c, opDoc)]] inputR val
|
|
(StackElem fixityS cs : stackR) -> do
|
|
let (_, Fixity _ precS dirS) = fixityS
|
|
fxty@(_, Fixity _ prec dir) <- docFixity opDoc
|
|
case compare prec precS of
|
|
GT -> go (StackElem fxty [(c, opDoc)] : stack) inputR val
|
|
LT -> do
|
|
let (e1, eops) = shiftOps cs c
|
|
go stackR input (known fixityS e1 eops)
|
|
EQ -> case (dir, dirS) of
|
|
(InfixR, InfixR) ->
|
|
go (StackElem fixityS ((c, opDoc) : cs) : stackR) inputR val
|
|
(InfixL, InfixL) ->
|
|
go (StackElem fixityS ((c, opDoc) : cs) : stackR) inputR val
|
|
_ -> Left []
|
|
docFixity :: BriDocNumbered -> Either [BrittanyError] (Bool, Fixity)
|
|
docFixity (_, x) = case x of
|
|
BDLit (Text.unpack -> s) -> case hardcodedFixity allowUnqualify s of
|
|
Just f -> Right (True, f)
|
|
Nothing -> case unknownFixityHandling of
|
|
UFHSafeWarn -> Left
|
|
[LayoutWarning ("Fixity of operator not known: " ++ s)]
|
|
UFHSafeIgnore -> Left []
|
|
UFHDefaultFixity -> Right (False, defaultFixity)
|
|
UFHDangerousDefault -> Right (True, defaultFixity)
|
|
BDFlushCommentsPrior _ d -> docFixity d
|
|
BDQueueComments _ d -> docFixity d
|
|
_ -> Left
|
|
[ ( LayoutWarning
|
|
$ "internal brittany warning: "
|
|
++ "Unknown form of operator "
|
|
++ show (toConstr x)
|
|
++ "!"
|
|
)
|
|
]
|
|
shiftOps
|
|
:: [(OpTree, BriDocNumbered)]
|
|
-> OpTree
|
|
-> (OpTree, [(BriDocNumbered, OpTree)])
|
|
shiftOps ops final = case reverse ops of
|
|
[] -> (final, [])
|
|
((e1, o1) : rest) ->
|
|
( e1
|
|
, let (finalOp, list) =
|
|
mapAccumL (\op (nextE, nextOp) -> (nextOp, (op, nextE))) o1 rest
|
|
in list ++ [(finalOp, final)]
|
|
)
|
|
known (allowT, fixity) = OpKnown NoParen allowT Nothing Nothing fixity
|
|
|
|
addAllParens :: OpParenMode -> OpTree -> OpTree
|
|
addAllParens topLevelParen = \case
|
|
OpKnown _paren True locO locC fixity c cs ->
|
|
OpKnown topLevelParen
|
|
True
|
|
locO
|
|
locC
|
|
fixity
|
|
(addAllParens ParenWithSpace c)
|
|
[ (op, addAllParens ParenWithSpace tree) | (op, tree) <- cs ]
|
|
x -> x
|
|
|
|
remSuperfluousParens :: Int -> OpTree -> OpTree
|
|
remSuperfluousParens outerFixity = \case
|
|
OpUnknown _ locO locC c@(OpLeaf _ doc) [] | isLit doc ->
|
|
OpUnknown NoParen locO locC c []
|
|
OpUnknown _ locO locC c@(OpUnknown ParenWithSpace _ _ _ _) [] ->
|
|
OpUnknown NoParen locO locC (remSuperfluousParens 11 c) []
|
|
OpUnknown _ locO locC c@(OpUnknown ParenNoSpace _ _ _ _) [] ->
|
|
OpUnknown NoParen locO locC (remSuperfluousParens 11 c) []
|
|
OpKnown paren True locO locC fixity c cs ->
|
|
OpKnown
|
|
-- We do not support removing superfluous parens around
|
|
-- function types yet:
|
|
(if outerFixity > fixLevel fixity || fixLevel fixity < 0
|
|
then paren
|
|
else NoParen
|
|
)
|
|
True
|
|
locO
|
|
locC
|
|
fixity
|
|
(remSuperfluousParens
|
|
(case fixity of
|
|
Fixity _ level InfixN -> level + 1
|
|
Fixity _ level _ -> level
|
|
)
|
|
c
|
|
)
|
|
[ (op, remSuperfluousParens (fixLevel fixity) tree) | (op, tree) <- cs ]
|
|
x -> x
|
|
where
|
|
fixLevel (Fixity _ i _) = i
|
|
isLit = \case
|
|
(_, BDFlushCommentsPrior _ x ) -> isLit x
|
|
(_, BDFlushCommentsPost _ _ x) -> isLit x
|
|
(_, BDQueueComments _ x ) -> isLit x
|
|
(_, BDEntryDelta _ x ) -> isLit x
|
|
(_, BDForceAlt _ x ) -> isLit x
|
|
(_, BDDebug _ x ) -> isLit x
|
|
(_, BDAddBaseY _ x ) -> isLit x
|
|
(_, BDBaseYPushCur x ) -> isLit x
|
|
(_, BDIndentLevelPushCur x ) -> isLit x
|
|
(_, BDIndentLevelPop x ) -> isLit x
|
|
(_, BDLit{} ) -> True
|
|
_ -> False
|
|
|
|
|
|
hardcodedFixity :: Bool -> String -> Maybe Fixity
|
|
hardcodedFixity allowUnqualify = \case
|
|
--
|
|
"->" -> Just $ Fixity NoSourceText (-1) InfixR
|
|
"." -> Just $ Fixity NoSourceText 9 InfixR
|
|
"!!" -> Just $ Fixity NoSourceText 9 InfixL
|
|
"**" -> Just $ Fixity NoSourceText 8 InfixR
|
|
"^" -> Just $ Fixity NoSourceText 8 InfixR
|
|
"^^" -> Just $ Fixity NoSourceText 8 InfixR
|
|
"*" -> Just $ Fixity NoSourceText 7 InfixL
|
|
"/" -> Just $ Fixity NoSourceText 7 InfixL
|
|
"`quot`" -> Just $ Fixity NoSourceText 7 InfixL
|
|
"`rem`" -> Just $ Fixity NoSourceText 7 InfixL
|
|
"`div`" -> Just $ Fixity NoSourceText 7 InfixL
|
|
"`mod`" -> Just $ Fixity NoSourceText 7 InfixL
|
|
"+" -> Just $ Fixity NoSourceText 6 InfixL
|
|
"-" -> Just $ Fixity NoSourceText 6 InfixL
|
|
":" -> Just $ Fixity NoSourceText 5 InfixR
|
|
"==" -> Just $ Fixity NoSourceText 4 InfixN
|
|
"/=" -> Just $ Fixity NoSourceText 4 InfixN
|
|
"<" -> Just $ Fixity NoSourceText 4 InfixN
|
|
"<=" -> Just $ Fixity NoSourceText 4 InfixN
|
|
">" -> Just $ Fixity NoSourceText 4 InfixN
|
|
">=" -> Just $ Fixity NoSourceText 4 InfixN
|
|
"&&" -> Just $ Fixity NoSourceText 3 InfixR
|
|
"||" -> Just $ Fixity NoSourceText 2 InfixR
|
|
">>=" -> Just $ Fixity NoSourceText 1 InfixL
|
|
">>" -> Just $ Fixity NoSourceText 1 InfixL
|
|
"=<<" -> Just $ Fixity NoSourceText 1 InfixR
|
|
"$" -> Just $ Fixity NoSourceText 0 InfixR
|
|
"`seq`" -> Just $ Fixity NoSourceText 0 InfixR
|
|
"$!" -> Just $ Fixity NoSourceText 0 InfixR
|
|
"!" -> Just $ Fixity NoSourceText 9 InfixL
|
|
"//" -> Just $ Fixity NoSourceText 9 InfixL
|
|
"<>" -> Just $ Fixity NoSourceText 6 InfixR
|
|
"<+>" -> Just $ Fixity NoSourceText 5 InfixR
|
|
"<$" -> Just $ Fixity NoSourceText 4 InfixL
|
|
"$>" -> Just $ Fixity NoSourceText 4 InfixL
|
|
"<$>" -> Just $ Fixity NoSourceText 4 InfixL
|
|
"<&>" -> Just $ Fixity NoSourceText 1 InfixL
|
|
"&" -> Just $ Fixity NoSourceText 1 InfixL
|
|
"<*>" -> Just $ Fixity NoSourceText 4 InfixL
|
|
"<**>" -> Just $ Fixity NoSourceText 4 InfixL
|
|
"*>" -> Just $ Fixity NoSourceText 4 InfixL
|
|
"<*" -> Just $ Fixity NoSourceText 4 InfixL
|
|
"`elem`" -> Just $ Fixity NoSourceText 4 InfixN
|
|
"`notElem`" -> Just $ Fixity NoSourceText 4 InfixN
|
|
"++" -> Just $ Fixity NoSourceText 5 InfixR
|
|
"%" -> Just $ Fixity NoSourceText 7 InfixL
|
|
"<|>" -> Just $ Fixity NoSourceText 3 InfixL
|
|
".&." -> Just $ Fixity NoSourceText 7 InfixL
|
|
".|." -> Just $ Fixity NoSourceText 5 InfixL
|
|
"`xor`" -> Just $ Fixity NoSourceText 6 InfixL
|
|
"`shift`" -> Just $ Fixity NoSourceText 8 InfixL
|
|
"`rotate`" -> Just $ Fixity NoSourceText 8 InfixL
|
|
"`shiftL`" -> Just $ Fixity NoSourceText 8 InfixL
|
|
"`shiftR`" -> Just $ Fixity NoSourceText 8 InfixL
|
|
"`rotateL`" -> Just $ Fixity NoSourceText 8 InfixL
|
|
"`rotateR`" -> Just $ Fixity NoSourceText 8 InfixL
|
|
"+#" -> Just $ Fixity NoSourceText 6 InfixL
|
|
".^." -> Just $ Fixity NoSourceText 6 InfixL
|
|
".>>." -> Just $ Fixity NoSourceText 8 InfixL
|
|
".<<." -> Just $ Fixity NoSourceText 8 InfixL
|
|
"!>>." -> Just $ Fixity NoSourceText 8 InfixL
|
|
"!<<." -> Just $ Fixity NoSourceText 8 InfixL
|
|
">=>" -> Just $ Fixity NoSourceText 1 InfixR
|
|
"<=<" -> Just $ Fixity NoSourceText 1 InfixR
|
|
"&&&" -> Just $ Fixity NoSourceText 3 InfixR
|
|
"<$!>" -> fixity InfixL 4
|
|
|
|
"~" -> fixity InfixN 4
|
|
"~~" -> fixity InfixN 4
|
|
":~:" -> Just $ Fixity NoSourceText 4 InfixN
|
|
":~~:" -> Just $ Fixity NoSourceText 4 InfixN
|
|
":+:" -> fixity InfixR 5
|
|
":*:" -> fixity InfixR 6
|
|
":.:" -> fixity InfixR 7
|
|
":|" -> fixity InfixR 5
|
|
|
|
-- non-base from random sources.
|
|
"<|" -> Just $ Fixity NoSourceText 5 InfixR
|
|
"|>" -> Just $ Fixity NoSourceText 5 InfixL
|
|
"><" -> Just $ Fixity NoSourceText 5 InfixR
|
|
"$+$" -> Just $ Fixity NoSourceText 5 InfixL
|
|
"\\\\" -> Just $ Fixity NoSourceText 5 InfixN
|
|
".>" -> Just $ Fixity NoSourceText 9 InfixL
|
|
":?" -> Just $ Fixity NoSourceText 7 InfixN
|
|
":-" -> Just $ Fixity NoSourceText 9 InfixR
|
|
"$!!" -> fixity InfixR 0
|
|
"<$!!>" -> fixity InfixL 4
|
|
|
|
-- aeson
|
|
-- ".=" -> fixity InfixR 8 -- this clashes with lens :(
|
|
".?=" -> fixity InfixR 8
|
|
".:" -> fixity InfixL 9
|
|
".:!" -> fixity InfixL 9
|
|
".:?" -> fixity InfixL 9
|
|
".!=" -> fixity InfixL 9
|
|
".:?=" -> fixity InfixL 9
|
|
".:!=" -> fixity InfixL 9
|
|
|
|
-- lens, not complete!
|
|
"<|" -> fixity InfixR 5
|
|
"|>" -> fixity InfixL 5
|
|
"%~" -> fixity InfixR 4
|
|
".~" -> fixity InfixR 4
|
|
"?~" -> fixity InfixR 4
|
|
"<.~" -> fixity InfixR 4
|
|
"<?~" -> fixity InfixR 4
|
|
"+~" -> fixity InfixR 4
|
|
"*~" -> fixity InfixR 4
|
|
"-~" -> fixity InfixR 4
|
|
"//~" -> fixity InfixR 4
|
|
"^~" -> fixity InfixR 4
|
|
"^^~" -> fixity InfixR 4
|
|
"**~" -> fixity InfixR 4
|
|
"||~" -> fixity InfixR 4
|
|
"&&~" -> fixity InfixR 4
|
|
-- ".=" -> fixity InfixN 4 -- this clashes with aeson :(
|
|
"%=" -> fixity InfixN 4
|
|
"?=" -> fixity InfixN 4
|
|
"+=" -> fixity InfixN 4
|
|
"-=" -> fixity InfixN 4
|
|
"*=" -> fixity InfixN 4
|
|
"//=" -> fixity InfixN 4
|
|
"^=" -> fixity InfixN 4
|
|
"^^=" -> fixity InfixN 4
|
|
"**=" -> fixity InfixN 4
|
|
"&&=" -> fixity InfixN 4
|
|
"||=" -> fixity InfixN 4
|
|
"<~" -> fixity InfixR 2
|
|
"<.=" -> fixity InfixN 4
|
|
"<?=" -> fixity InfixN 4
|
|
"<>~" -> fixity InfixR 4
|
|
"<>=" -> fixity InfixN 4
|
|
"^.." -> fixity InfixL 8
|
|
"^?" -> fixity InfixL 8
|
|
"^?!" -> fixity InfixL 8
|
|
"^@.." -> fixity InfixL 8
|
|
"^@?" -> fixity InfixL 8
|
|
"^@?!" -> fixity InfixL 8
|
|
"^." -> fixity InfixL 8
|
|
"^@." -> fixity InfixL 8
|
|
"<." -> fixity InfixR 9
|
|
".>" -> fixity InfixR 9
|
|
"<.>" -> fixity InfixR 9
|
|
"@@~" -> fixity InfixR 4
|
|
"@@=" -> fixity InfixR 4
|
|
"&~" -> fixity InfixL 1
|
|
"??" -> fixity InfixL 1
|
|
|
|
|
|
-- certain other operators
|
|
-- "%." -> Just $ Fixity NoSourceText _ _
|
|
-- "%==" -> Just $ Fixity NoSourceText _ _
|
|
-- "%=>%" -> Just $ Fixity NoSourceText _ _
|
|
-- "&*" -> Just $ Fixity NoSourceText _ _
|
|
-- "&/" -> Just $ Fixity NoSourceText _ _
|
|
-- "&=" -> Just $ Fixity NoSourceText _ _
|
|
-- "-->" -> Just $ Fixity NoSourceText _ _
|
|
-- ".*?" -> fixity _ _
|
|
-- ".+." -> fixity _ _
|
|
-- ".-." -> fixity _ _
|
|
".&." -> fixity InfixR 1
|
|
".&&." -> fixity InfixR 1
|
|
".||." -> fixity InfixR 1
|
|
"==>" -> fixity InfixR 0
|
|
"=/=" -> fixity InfixN 4
|
|
"===" -> fixity InfixN 4
|
|
-- ".:>" -> fixity _ _
|
|
-- ".:>?" -> fixity _ _
|
|
"<.>" -> fixity InfixR 7
|
|
"</>" -> fixity InfixR 5
|
|
"<?>" -> fixity InfixL 9
|
|
-- "~" -> fixity _ _
|
|
"===" -> fixity InfixN 4
|
|
"!?" -> fixity InfixL 9
|
|
"%==" -> fixity InfixN 3
|
|
".*" -> fixity InfixR 8
|
|
".**" -> fixity InfixR 8
|
|
".***" -> fixity InfixR 8
|
|
":?-" -> fixity InfixN 1
|
|
"::-" -> fixity InfixN 0
|
|
"&!" -> fixity InfixL 1
|
|
|
|
-- extra
|
|
"||^" -> fixity InfixL 9
|
|
"&&^" -> fixity InfixL 9
|
|
|
|
-- quickcheck (-state-machine)
|
|
":&&" -> fixity InfixL 9
|
|
":||" -> fixity InfixL 9
|
|
":&&:" -> fixity InfixL 9
|
|
":=>" -> fixity InfixL 9
|
|
":==" -> fixity InfixL 9
|
|
":/=" -> fixity InfixL 9
|
|
":<" -> fixity InfixL 9
|
|
":<=" -> fixity InfixL 9
|
|
":>" -> fixity InfixL 9
|
|
":>=" -> fixity InfixL 9
|
|
":->" -> fixity InfixL 9
|
|
".==" -> fixity InfixN 5
|
|
"./" -> fixity InfixN 5
|
|
".<" -> fixity InfixN 5
|
|
".<=" -> fixity InfixN 5
|
|
".>" -> fixity InfixN 5
|
|
".>=" -> fixity InfixN 5
|
|
"`member`" -> fixity InfixN 8
|
|
"`notMember`" -> fixity InfixN 8
|
|
".//" -> fixity InfixL 4
|
|
".&&" -> fixity InfixR 3
|
|
".||" -> fixity InfixR 2
|
|
".=>" -> fixity InfixR 1
|
|
|
|
-- servant
|
|
":>" -> fixity InfixR 4
|
|
":<|>" -> fixity InfixR 3
|
|
":-" -> fixity InfixL 0
|
|
|
|
-- postgresql-simple
|
|
":." -> fixity InfixR 3 -- this has wildly different fixities in different libraries
|
|
|
|
-- ?
|
|
-- ":-:" -> fixity _ _
|
|
-- ":." -> fixity _ _
|
|
-- ":/:" -> fixity _ _
|
|
-- "::->" -> fixity _ _
|
|
-- ":<:" -> fixity _ _
|
|
-- ":<=:" -> fixity _ _
|
|
-- ":=:" -> fixity _ _
|
|
-- ":>:" -> fixity _ _
|
|
-- ":>=:" -> fixity _ _
|
|
|
|
str -> case (Safe.headMay str, Safe.lastMay str) of
|
|
(Just '\'', _) -> hardcodedFixity False (drop 1 str)
|
|
(Just '`', Just '`') -> Just $ Fixity NoSourceText 9 InfixL
|
|
(Just c, _) | Data.Char.isAlpha c && allowUnqualify -> hardcodedFixity False
|
|
$ dropWhile (\x -> (Data.Char.isAlpha x || x == '.')) str
|
|
_ -> Nothing
|
|
where fixity a b = Just (Fixity NoSourceText b a)
|
|
|
|
defaultFixity :: Fixity
|
|
defaultFixity = Fixity NoSourceText 9 InfixL
|