module Language.PureScript.AST.Exported
  ( exportedDeclarations
  , isExported
  ) where

import Prelude.Compat
import Protolude (sortBy, on)

import Control.Category ((>>>))

import Data.Maybe (mapMaybe)
import qualified Data.Map as M

import Language.PureScript.AST.Declarations
import Language.PureScript.Types
import Language.PureScript.Names

-- |
-- Return a list of all declarations which are exported from a module.
-- This function descends into data declarations to filter out unexported
-- data constructors, and also filters out type instance declarations if
-- they refer to classes or types which are not themselves exported.
--
-- Note that this function assumes that the module has already had its imports
-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
-- produce incorrect results if this is not the case - for example, type class
-- instances will be incorrectly removed in some cases.
--
-- The returned declarations are in the same order as they appear in the export
-- list, unless there is no export list, in which case they appear in the same
-- order as they do in the source file.
--
exportedDeclarations :: Module -> [Declaration]
exportedDeclarations :: Module -> [Declaration]
exportedDeclarations (Module SourceSpan
_ [Comment]
_ ModuleName
mn [Declaration]
decls Maybe [DeclarationRef]
exps) = [Declaration] -> [Declaration]
go [Declaration]
decls
  where
  go :: [Declaration] -> [Declaration]
go = [Declaration] -> [Declaration]
flattenDecls
        ([Declaration] -> [Declaration])
-> ([Declaration] -> [Declaration])
-> [Declaration]
-> [Declaration]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Declaration -> Bool) -> [Declaration] -> [Declaration]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe [DeclarationRef] -> Declaration -> Bool
isExported Maybe [DeclarationRef]
exps)
        ([Declaration] -> [Declaration])
-> ([Declaration] -> [Declaration])
-> [Declaration]
-> [Declaration]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Declaration -> Declaration) -> [Declaration] -> [Declaration]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe [DeclarationRef] -> Declaration -> Declaration
filterDataConstructors Maybe [DeclarationRef]
exps)
        ([Declaration] -> [Declaration])
-> ([Declaration] -> [Declaration])
-> [Declaration]
-> [Declaration]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ModuleName
-> Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
filterInstances ModuleName
mn Maybe [DeclarationRef]
exps
        ([Declaration] -> [Declaration])
-> ([Declaration] -> [Declaration])
-> [Declaration]
-> [Declaration]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Declaration] -> [Declaration])
-> ([DeclarationRef] -> [Declaration] -> [Declaration])
-> Maybe [DeclarationRef]
-> [Declaration]
-> [Declaration]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Declaration] -> [Declaration]
forall a. a -> a
id [DeclarationRef] -> [Declaration] -> [Declaration]
reorder Maybe [DeclarationRef]
exps

-- |
-- Filter out all data constructors from a declaration which are not exported.
-- If the supplied declaration is not a data declaration, this function returns
-- it unchanged.
--
filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
filterDataConstructors Maybe [DeclarationRef]
exps (DataDeclaration SourceAnn
sa DataDeclType
dType ProperName 'TypeName
tyName [(Text, Maybe SourceType)]
tyArgs [DataConstructorDeclaration]
dctors) =
  SourceAnn
-> DataDeclType
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> [DataConstructorDeclaration]
-> Declaration
DataDeclaration SourceAnn
sa DataDeclType
dType ProperName 'TypeName
tyName [(Text, Maybe SourceType)]
tyArgs ([DataConstructorDeclaration] -> Declaration)
-> [DataConstructorDeclaration] -> Declaration
forall a b. (a -> b) -> a -> b
$
    (DataConstructorDeclaration -> Bool)
-> [DataConstructorDeclaration] -> [DataConstructorDeclaration]
forall a. (a -> Bool) -> [a] -> [a]
filter (ProperName 'TypeName
-> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool
isDctorExported ProperName 'TypeName
tyName Maybe [DeclarationRef]
exps (ProperName 'ConstructorName -> Bool)
-> (DataConstructorDeclaration -> ProperName 'ConstructorName)
-> DataConstructorDeclaration
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorName) [DataConstructorDeclaration]
dctors
filterDataConstructors Maybe [DeclarationRef]
_ Declaration
other = Declaration
other

-- |
-- Filter out all the type instances from a list of declarations which
-- reference a type or type class which is both local and not exported.
--
-- Note that this function assumes that the module has already had its imports
-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
-- produce incorrect results if this is not the case - for example, type class
-- instances will be incorrectly removed in some cases.
--
filterInstances
  :: ModuleName
  -> Maybe [DeclarationRef]
  -> [Declaration]
  -> [Declaration]
filterInstances :: ModuleName
-> Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
filterInstances ModuleName
_ Maybe [DeclarationRef]
Nothing = [Declaration] -> [Declaration]
forall a. a -> a
id
filterInstances ModuleName
mn (Just [DeclarationRef]
exps) =
  let refs :: [Either (ProperName 'ClassName) (ProperName 'TypeName)]
refs = ProperName 'ClassName
-> Either (ProperName 'ClassName) (ProperName 'TypeName)
forall a b. a -> Either a b
Left (ProperName 'ClassName
 -> Either (ProperName 'ClassName) (ProperName 'TypeName))
-> [ProperName 'ClassName]
-> [Either (ProperName 'ClassName) (ProperName 'TypeName)]
forall a b. (a -> b) -> [a] -> [b]
`map` (DeclarationRef -> Maybe (ProperName 'ClassName))
-> [DeclarationRef] -> [ProperName 'ClassName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe (ProperName 'ClassName)
typeClassName [DeclarationRef]
exps
          [Either (ProperName 'ClassName) (ProperName 'TypeName)]
-> [Either (ProperName 'ClassName) (ProperName 'TypeName)]
-> [Either (ProperName 'ClassName) (ProperName 'TypeName)]
forall a. [a] -> [a] -> [a]
++ ProperName 'TypeName
-> Either (ProperName 'ClassName) (ProperName 'TypeName)
forall a b. b -> Either a b
Right (ProperName 'TypeName
 -> Either (ProperName 'ClassName) (ProperName 'TypeName))
-> [ProperName 'TypeName]
-> [Either (ProperName 'ClassName) (ProperName 'TypeName)]
forall a b. (a -> b) -> [a] -> [b]
`map` (DeclarationRef -> Maybe (ProperName 'TypeName))
-> [DeclarationRef] -> [ProperName 'TypeName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe (ProperName 'TypeName)
typeName [DeclarationRef]
exps
  in (Declaration -> Bool) -> [Declaration] -> [Declaration]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Either
   (Qualified (ProperName 'ClassName))
   (Qualified (ProperName 'TypeName))
 -> Bool)
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Either (ProperName 'ClassName) (ProperName 'TypeName)]
-> Either
     (Qualified (ProperName 'ClassName))
     (Qualified (ProperName 'TypeName))
-> Bool
visibleOutside [Either (ProperName 'ClassName) (ProperName 'TypeName)]
refs) ([Either
    (Qualified (ProperName 'ClassName))
    (Qualified (ProperName 'TypeName))]
 -> Bool)
-> (Declaration
    -> [Either
          (Qualified (ProperName 'ClassName))
          (Qualified (ProperName 'TypeName))])
-> Declaration
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
typeInstanceConstituents)
  where
  -- Given a Qualified ProperName, and a list of all exported types and type
  -- classes, returns whether the supplied Qualified ProperName is visible
  -- outside this module. This is true if one of the following hold:
  --
  --  * the name is defined in the same module and is exported,
  --  * the name is defined in a different module (and must be exported from
  --    that module; the code would fail to compile otherwise).
  visibleOutside
    :: [Either (ProperName 'ClassName) (ProperName 'TypeName)]
    -> Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))
    -> Bool
  visibleOutside :: [Either (ProperName 'ClassName) (ProperName 'TypeName)]
-> Either
     (Qualified (ProperName 'ClassName))
     (Qualified (ProperName 'TypeName))
-> Bool
visibleOutside [Either (ProperName 'ClassName) (ProperName 'TypeName)]
refs Either
  (Qualified (ProperName 'ClassName))
  (Qualified (ProperName 'TypeName))
q
    | (Qualified (ProperName 'ClassName) -> Bool)
-> (Qualified (ProperName 'TypeName) -> Bool)
-> Either
     (Qualified (ProperName 'ClassName))
     (Qualified (ProperName 'TypeName))
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Qualified (ProperName 'ClassName) -> Bool
forall a. Qualified a -> Bool
checkQual Qualified (ProperName 'TypeName) -> Bool
forall a. Qualified a -> Bool
checkQual Either
  (Qualified (ProperName 'ClassName))
  (Qualified (ProperName 'TypeName))
q = Bool
True
    | Bool
otherwise = (Qualified (ProperName 'ClassName)
 -> Either (ProperName 'ClassName) (ProperName 'TypeName))
-> (Qualified (ProperName 'TypeName)
    -> Either (ProperName 'ClassName) (ProperName 'TypeName))
-> Either
     (Qualified (ProperName 'ClassName))
     (Qualified (ProperName 'TypeName))
-> Either (ProperName 'ClassName) (ProperName 'TypeName)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ProperName 'ClassName
-> Either (ProperName 'ClassName) (ProperName 'TypeName)
forall a b. a -> Either a b
Left (ProperName 'ClassName
 -> Either (ProperName 'ClassName) (ProperName 'TypeName))
-> (Qualified (ProperName 'ClassName) -> ProperName 'ClassName)
-> Qualified (ProperName 'ClassName)
-> Either (ProperName 'ClassName) (ProperName 'TypeName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified (ProperName 'ClassName) -> ProperName 'ClassName
forall a. Qualified a -> a
disqualify) (ProperName 'TypeName
-> Either (ProperName 'ClassName) (ProperName 'TypeName)
forall a b. b -> Either a b
Right (ProperName 'TypeName
 -> Either (ProperName 'ClassName) (ProperName 'TypeName))
-> (Qualified (ProperName 'TypeName) -> ProperName 'TypeName)
-> Qualified (ProperName 'TypeName)
-> Either (ProperName 'ClassName) (ProperName 'TypeName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified (ProperName 'TypeName) -> ProperName 'TypeName
forall a. Qualified a -> a
disqualify) Either
  (Qualified (ProperName 'ClassName))
  (Qualified (ProperName 'TypeName))
q Either (ProperName 'ClassName) (ProperName 'TypeName)
-> [Either (ProperName 'ClassName) (ProperName 'TypeName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Either (ProperName 'ClassName) (ProperName 'TypeName)]
refs

  -- Check that a qualified name is qualified for a different module
  checkQual :: Qualified a -> Bool
  checkQual :: Qualified a -> Bool
checkQual Qualified a
q = Qualified a -> Bool
forall a. Qualified a -> Bool
isQualified Qualified a
q Bool -> Bool -> Bool
&& Bool -> Bool
not (ModuleName -> Qualified a -> Bool
forall a. ModuleName -> Qualified a -> Bool
isQualifiedWith ModuleName
mn Qualified a
q)

  typeName :: DeclarationRef -> Maybe (ProperName 'TypeName)
  typeName :: DeclarationRef -> Maybe (ProperName 'TypeName)
typeName (TypeRef SourceSpan
_ ProperName 'TypeName
n Maybe [ProperName 'ConstructorName]
_) = ProperName 'TypeName -> Maybe (ProperName 'TypeName)
forall a. a -> Maybe a
Just ProperName 'TypeName
n
  typeName DeclarationRef
_ = Maybe (ProperName 'TypeName)
forall a. Maybe a
Nothing

  typeClassName :: DeclarationRef -> Maybe (ProperName 'ClassName)
  typeClassName :: DeclarationRef -> Maybe (ProperName 'ClassName)
typeClassName (TypeClassRef SourceSpan
_ ProperName 'ClassName
n) = ProperName 'ClassName -> Maybe (ProperName 'ClassName)
forall a. a -> Maybe a
Just ProperName 'ClassName
n
  typeClassName DeclarationRef
_ = Maybe (ProperName 'ClassName)
forall a. Maybe a
Nothing

-- |
-- Get all type and type class names referenced by a type instance declaration.
--
typeInstanceConstituents :: Declaration -> [Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))]
typeInstanceConstituents :: Declaration
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
typeInstanceConstituents (TypeInstanceDeclaration SourceAnn
_ [Ident]
_ Integer
_ Ident
_ [SourceConstraint]
constraints Qualified (ProperName 'ClassName)
className [SourceType]
tys TypeInstanceBody
_) =
  Qualified (ProperName 'ClassName)
-> Either
     (Qualified (ProperName 'ClassName))
     (Qualified (ProperName 'TypeName))
forall a b. a -> Either a b
Left Qualified (ProperName 'ClassName)
className Either
  (Qualified (ProperName 'ClassName))
  (Qualified (ProperName 'TypeName))
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall a. a -> [a] -> [a]
: ((SourceConstraint
 -> [Either
       (Qualified (ProperName 'ClassName))
       (Qualified (ProperName 'TypeName))])
-> [SourceConstraint]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SourceConstraint
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall a.
Constraint a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
fromConstraint [SourceConstraint]
constraints [Either
   (Qualified (ProperName 'ClassName))
   (Qualified (ProperName 'TypeName))]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall a. [a] -> [a] -> [a]
++ (SourceType
 -> [Either
       (Qualified (ProperName 'ClassName))
       (Qualified (ProperName 'TypeName))])
-> [SourceType]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SourceType
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall a.
Type a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
fromType [SourceType]
tys)
  where

  fromConstraint :: Constraint a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
fromConstraint Constraint a
c = Qualified (ProperName 'ClassName)
-> Either
     (Qualified (ProperName 'ClassName))
     (Qualified (ProperName 'TypeName))
forall a b. a -> Either a b
Left (Constraint a -> Qualified (ProperName 'ClassName)
forall a. Constraint a -> Qualified (ProperName 'ClassName)
constraintClass Constraint a
c) Either
  (Qualified (ProperName 'ClassName))
  (Qualified (ProperName 'TypeName))
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall a. a -> [a] -> [a]
: (Type a
 -> [Either
       (Qualified (ProperName 'ClassName))
       (Qualified (ProperName 'TypeName))])
-> [Type a]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
fromType (Constraint a -> [Type a]
forall a. Constraint a -> [Type a]
constraintArgs Constraint a
c)
  fromType :: Type a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
fromType = ([Either
    (Qualified (ProperName 'ClassName))
    (Qualified (ProperName 'TypeName))]
 -> [Either
       (Qualified (ProperName 'ClassName))
       (Qualified (ProperName 'TypeName))]
 -> [Either
       (Qualified (ProperName 'ClassName))
       (Qualified (ProperName 'TypeName))])
-> (Type a
    -> [Either
          (Qualified (ProperName 'ClassName))
          (Qualified (ProperName 'TypeName))])
-> Type a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall r a. (r -> r -> r) -> (Type a -> r) -> Type a -> r
everythingOnTypes [Either
   (Qualified (ProperName 'ClassName))
   (Qualified (ProperName 'TypeName))]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
forall a. [a] -> [a] -> [a]
(++) Type a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
go

  -- Note that type synonyms are disallowed in instance declarations, so
  -- we don't need to handle them here.
  go :: Type a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
go (TypeConstructor a
_ Qualified (ProperName 'TypeName)
n) = [Qualified (ProperName 'TypeName)
-> Either
     (Qualified (ProperName 'ClassName))
     (Qualified (ProperName 'TypeName))
forall a b. b -> Either a b
Right Qualified (ProperName 'TypeName)
n]
  go (ConstrainedType a
_ Constraint a
c Type a
_) = Constraint a
-> [Either
      (Qualified (ProperName 'ClassName))
      (Qualified (ProperName 'TypeName))]
fromConstraint Constraint a
c
  go Type a
_ = []

typeInstanceConstituents Declaration
_ = []


-- |
-- Test if a declaration is exported, given a module's export list. Note that
-- this function does not account for type instance declarations of
-- non-exported types, or non-exported data constructors. Therefore, you should
-- prefer 'exportedDeclarations' to this function, where possible.
--
isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
isExported Maybe [DeclarationRef]
Nothing Declaration
_ = Bool
True
isExported Maybe [DeclarationRef]
_ TypeInstanceDeclaration{} = Bool
True
isExported (Just [DeclarationRef]
exps) Declaration
decl = (DeclarationRef -> Bool) -> [DeclarationRef] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DeclarationRef -> Bool
matches [DeclarationRef]
exps
  where
  matches :: DeclarationRef -> Bool
matches DeclarationRef
declRef = Declaration -> Maybe Name
declName Declaration
decl Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Name
forall a. a -> Maybe a
Just (DeclarationRef -> Name
declRefName DeclarationRef
declRef)

-- |
-- Test if a data constructor for a given type is exported, given a module's
-- export list. Prefer 'exportedDeclarations' to this function, where possible.
--
isDctorExported :: ProperName 'TypeName -> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool
isDctorExported :: ProperName 'TypeName
-> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool
isDctorExported ProperName 'TypeName
_ Maybe [DeclarationRef]
Nothing ProperName 'ConstructorName
_ = Bool
True
isDctorExported ProperName 'TypeName
ident (Just [DeclarationRef]
exps) ProperName 'ConstructorName
ctor = DeclarationRef -> Bool
test (DeclarationRef -> Bool) -> [DeclarationRef] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` [DeclarationRef]
exps
  where
  test :: DeclarationRef -> Bool
test (TypeRef SourceSpan
_ ProperName 'TypeName
ident' Maybe [ProperName 'ConstructorName]
Nothing) = ProperName 'TypeName
ident ProperName 'TypeName -> ProperName 'TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
ident'
  test (TypeRef SourceSpan
_ ProperName 'TypeName
ident' (Just [ProperName 'ConstructorName]
ctors)) = ProperName 'TypeName
ident ProperName 'TypeName -> ProperName 'TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
ident' Bool -> Bool -> Bool
&& ProperName 'ConstructorName
ctor ProperName 'ConstructorName
-> [ProperName 'ConstructorName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ProperName 'ConstructorName]
ctors
  test DeclarationRef
_ = Bool
False

-- |
-- Reorder declarations based on the order they appear in the given export
-- list.
--
reorder :: [DeclarationRef] -> [Declaration] -> [Declaration]
reorder :: [DeclarationRef] -> [Declaration] -> [Declaration]
reorder [DeclarationRef]
refs =
  (Declaration -> Declaration -> Ordering)
-> [Declaration] -> [Declaration]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Maybe Int -> Maybe Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Maybe Int -> Maybe Int -> Ordering)
-> (Declaration -> Maybe Int)
-> Declaration
-> Declaration
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Declaration -> Maybe Int
refIndex)
  where
  refIndices :: Map Name Int
refIndices =
    [(Name, Int)] -> Map Name Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Int)] -> Map Name Int) -> [(Name, Int)] -> Map Name Int
forall a b. (a -> b) -> a -> b
$ [Name] -> [Int] -> [(Name, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((DeclarationRef -> Name) -> [DeclarationRef] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map DeclarationRef -> Name
declRefName [DeclarationRef]
refs) [(Int
0::Int)..]
  refIndex :: Declaration -> Maybe Int
refIndex Declaration
decl =
    Declaration -> Maybe Name
declName Declaration
decl Maybe Name -> (Name -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Name -> Map Name Int -> Maybe Int)
-> Map Name Int -> Name -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Map Name Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Name Int
refIndices