    {-# LANGUAGE ViewPatterns #-}

    module Fixity(
        FixityInfo, Associativity(..),
        defaultFixities,
        fromFixitySig, toFixitySig, toFixity,
        ) where

    import GHC.Generics(Associativity(..))
    import GHC.Hs.Binds
    import GHC.Hs.Extension
    import GHC.Types.Name.Occurrence
    import GHC.Types.Name.Reader
    import GHC.Types.Fixity
    import GHC.Parser.Annotation
    import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
    import Language.Haskell.GhclibParserEx.Fixity

    -- Lots of things define a fixity. None define it quite right, so let's have our own type.

    -- | A Fixity definition, comprising the name the fixity applies to,
    --   the direction and the precedence. As an example, a source file containing:
    --
    -- > infixr 3 `foo`
    --
    --   would create @(\"foo\", RightAssociative, 3)@.
    type FixityInfo = (String, Associativity, Int)

    fromFixitySig :: FixitySig GhcPs -> [FixityInfo]
    fromFixitySig :: FixitySig GhcPs -> [FixityInfo]
    fromFixitySig (FixitySig XFixitySig GhcPs
    _ [LIdP GhcPs]
    names (Fixity Int
    i FixityDirection
    dir)) =
        [(LocatedN RdrName -> String
    rdrNameStr LocatedN RdrName
    name, FixityDirection -> Associativity
    f FixityDirection
    dir, Int
    i) | LocatedN RdrName
    name <- [LIdP GhcPs]
    [LocatedN RdrName]
    names]
        where
            f :: FixityDirection -> Associativity
    f FixityDirection
    InfixL = Associativity
    LeftAssociative
            f FixityDirection
    InfixR = Associativity
    RightAssociative
            f FixityDirection
    InfixN = Associativity
    NotAssociative

    toFixity :: FixityInfo -> (String, Fixity)
    toFixity :: FixityInfo -> (String, Fixity)
    toFixity (String
    name, Associativity
    dir, Int
    i) = (String
    name, Int -> FixityDirection -> Fixity
    Fixity Int
    i (FixityDirection -> Fixity) -> FixityDirection -> Fixity
    forall a b. (a -> b) -> a -> b
    $ Associativity -> FixityDirection
    f Associativity
    dir)
        where
            f :: Associativity -> FixityDirection
    f Associativity
    LeftAssociative = FixityDirection
    InfixL
            f Associativity
    RightAssociative = FixityDirection
    InfixR
            f Associativity
    NotAssociative = FixityDirection
    InfixN

    fromFixity :: (String, Fixity) -> FixityInfo
    fromFixity :: (String, Fixity) -> FixityInfo
    fromFixity (String
    name, Fixity Int
    i FixityDirection
    dir) = (String
    name, FixityDirection -> Associativity
    assoc FixityDirection
    dir, Int
    i)
      where
        assoc :: FixityDirection -> Associativity
    assoc FixityDirection
    dir = case FixityDirection
    dir of
          FixityDirection
    InfixL -> Associativity
    LeftAssociative
          FixityDirection
    InfixR -> Associativity
    RightAssociative
          FixityDirection
    InfixN -> Associativity
    NotAssociative

    toFixitySig :: FixityInfo -> FixitySig GhcPs
    toFixitySig :: FixityInfo -> FixitySig GhcPs
    toFixitySig (FixityInfo -> (String, Fixity)
    toFixity -> (String
    name, Fixity
    x)) = XFixitySig GhcPs -> [LIdP GhcPs] -> Fixity -> FixitySig GhcPs
    forall pass.
    XFixitySig pass -> [LIdP pass] -> Fixity -> FixitySig pass
    FixitySig XFixitySig GhcPs
    NamespaceSpecifier
    NoNamespaceSpecifier [RdrName -> LocatedN RdrName
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (RdrName -> LocatedN RdrName) -> RdrName -> LocatedN RdrName
    forall a b. (a -> b) -> a -> b
    $ OccName -> RdrName
    mkRdrUnqual (String -> OccName
    mkVarOcc String
    name)] Fixity
    x

    defaultFixities :: [FixityInfo]
    defaultFixities :: [FixityInfo]
    defaultFixities = ((String, Fixity) -> FixityInfo)
    -> [(String, Fixity)] -> [FixityInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Fixity) -> FixityInfo
    fromFixity ([(String, Fixity)] -> [FixityInfo])
    -> [(String, Fixity)] -> [FixityInfo]
    forall a b. (a -> b) -> a -> b
    $ [(String, Fixity)]
    customFixities [(String, Fixity)] -> [(String, Fixity)] -> [(String, Fixity)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, Fixity)]
    baseFixities [(String, Fixity)] -> [(String, Fixity)] -> [(String, Fixity)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, Fixity)]
    lensFixities [(String, Fixity)] -> [(String, Fixity)] -> [(String, Fixity)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, Fixity)]
    otherFixities

    -- List as provided at https://github.com/ndmitchell/hlint/issues/416.
    lensFixities :: [(String, Fixity)]
    lensFixities :: [(String, Fixity)]
    lensFixities = [[(String, Fixity)]] -> [(String, Fixity)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        [ Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    4 [String
    "%%@~",String
    "<%@~",String
    "%%~",String
    "<+~",String
    "<*~",String
    "<-~",String
    "<//~",String
    "<^~",String
    "<^^~",String
    "<**~"]
        , Int -> [String] -> [(String, Fixity)]
    infix_ Int
    4 [String
    "%%@=",String
    "<%@=",String
    "%%=",String
    "<+=",String
    "<*=",String
    "<-=",String
    "<//=",String
    "<^=",String
    "<^^=",String
    "<**="]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    2 [String
    "<<~"]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    9 [String
    "#."]
        , Int -> [String] -> [(String, Fixity)]
    infixl_ Int
    8 [String
    ".#"]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    8 [String
    "^!",String
    "^@!"]
        , Int -> [String] -> [(String, Fixity)]
    infixl_ Int
    1 [String
    "&",String
    "<&>",String
    "??"]
        , Int -> [String] -> [(String, Fixity)]
    infixl_ Int
    8 [String
    "^.",String
    "^@."]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    9 [String
    "<.>",String
    "<.",String
    ".>"]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    4 [String
    "%@~",String
    ".~",String
    "+~",String
    "*~",String
    "-~",String
    "//~",String
    "^~",String
    "^^~",String
    "**~",String
    "&&~",String
    "<>~",String
    "||~",String
    "%~"]
        , Int -> [String] -> [(String, Fixity)]
    infix_ Int
    4 [String
    "%@=",String
    ".=",String
    "+=",String
    "*=",String
    "-=",String
    "//=",String
    "^=",String
    "^^=",String
    "**=",String
    "&&=",String
    "<>=",String
    "||=",String
    "%="]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    2 [String
    "<~"]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    2 [String
    "`zoom`",String
    "`magnify`"]
        , Int -> [String] -> [(String, Fixity)]
    infixl_ Int
    8 [String
    "^..",String
    "^?",String
    "^?!",String
    "^@..",String
    "^@?",String
    "^@?!"]
        , Int -> [String] -> [(String, Fixity)]
    infixl_ Int
    8 [String
    "^#"]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    4 [String
    "<#~",String
    "#~",String
    "#%~",String
    "<#%~",String
    "#%%~"]
        , Int -> [String] -> [(String, Fixity)]
    infix_ Int
    4 [String
    "<#=",String
    "#=",String
    "#%=",String
    "<#%=",String
    "#%%="]
        , Int -> [String] -> [(String, Fixity)]
    infixl_ Int
    9 [String
    ":>"]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    4 [String
    "</>~",String
    "<</>~",String
    "<.>~",String
    "<<.>~"]
        , Int -> [String] -> [(String, Fixity)]
    infix_ Int
    4 [String
    "</>=",String
    "<</>=",String
    "<.>=",String
    "<<.>="]
        , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    4 [String
    ".|.~",String
    ".&.~",String
    "<.|.~",String
    "<.&.~"]
        , Int -> [String] -> [(String, Fixity)]
    infix_ Int
    4 [String
    ".|.=",String
    ".&.=",String
    "<.|.=",String
    "<.&.="]
        ]

    otherFixities :: [(String, Fixity)]
    otherFixities :: [(String, Fixity)]
    otherFixities = [[(String, Fixity)]] -> [(String, Fixity)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
      -- hspec
      [ Int -> [String] -> [(String, Fixity)]
    infix_ Int
    1 [String
    "shouldBe",String
    "shouldSatisfy",String
    "shouldStartWith",String
    "shouldEndWith",String
    "shouldContain",String
    "shouldMatchList"
                  ,String
    "shouldReturn",String
    "shouldNotBe",String
    "shouldNotSatisfy",String
    "shouldNotContain",String
    "shouldNotReturn",String
    "shouldThrow"]
        -- quickcheck
      , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    0 [String
    "==>"]
      , Int -> [String] -> [(String, Fixity)]
    infix_ Int
    4 [String
    "==="]
        -- esqueleto
      , Int -> [String] -> [(String, Fixity)]
    infix_ Int
    4 [String
    "==."]
        -- lattices
      , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    5 [String
    "\\/"] -- \/
      , Int -> [String] -> [(String, Fixity)]
    infixr_ Int
    6 [String
    "/\\"] -- /\
      ]

    customFixities :: [(String, Fixity)]
    customFixities :: [(String, Fixity)]
    customFixities =
      Int -> [String] -> [(String, Fixity)]
    infixl_ Int
    1 [String
    "`on`"]
            -- See https://github.com/ndmitchell/hlint/issues/425
            -- otherwise GTK apps using `on` at a different fixity have
            -- spurious warnings.