{- |
Module: Agda.Unused.Types.Context

Definitions and interface for the 'Context' and 'AccessContext' types, which
represent namespaces of definitions.
-}
module Agda.Unused.Types.Context

  ( -- * Definitions

    Item
  , Module(Module)
  , AccessModule(AccessModule)
  , Context
  , AccessContext
  , accessContextUnion

    -- * Interface

    -- ** Lookup

  , LookupError(..)
  , contextLookupItem
  , contextLookupModule
  , accessContextLookup
  , accessContextLookupModule
  , accessContextLookupDefining
  , accessContextLookupSpecial
  
    -- ** Insert

  , contextInsertRangeAll
  , accessContextInsertRangeAll

    -- ** Delete

  , contextDelete
  , contextDeleteModule

    -- ** Define

  , accessContextDefine
  , accessContextDefineFields

    -- ** Ranges

  , moduleRanges
  , contextRanges
  , accessContextRanges

    -- ** Match

  , accessContextMatch

    -- * Construction

  , contextItem
  , contextModule
  , accessContextConstructor
  , accessContextPattern
  , accessContextField
  , accessContextItem
  , accessContextModule
  , accessContextModule'
  , accessContextImport

    -- * Conversion

  , fromContext
  , toContext

  ) where

import Agda.Unused.Types.Access
  (Access(..))
import Agda.Unused.Types.Name
  (Name, QName(..), matchOperators, stripPrefix)
import Agda.Unused.Types.Range
  (Range)

import Data.Map.Strict
  (Map)
import qualified Data.Map.Strict
  as Map
import Data.Maybe
  (catMaybes)
import Data.Set
  (Set)
import qualified Data.Set
  as Set

-- ## Definitions

-- | The data associated with a name in context. This includes:
--
-- - Whether the name is a constructor, pattern synonym, or ordinary definition.
-- - A list of ranges associated with the name, which includes the site of the
-- original definition, as well as any relevant @import@ or @open@ statements.
-- - Alternative syntax for the name, if any.
data Item where

  ItemConstructor
    :: !(Set Range)
    -> !(Set Name)
    -> Item

  ItemPattern
    :: !(Set Range)
    -> !(Maybe Name)
    -> Item

  Item
    :: !(Set Range)
    -> !(Maybe Name)
    -> Item

  deriving Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show

data Defining where

  Defining
    :: Defining

  NotDefiningField
    :: Defining

  NotDefining
    :: Defining

  deriving Int -> Defining -> ShowS
[Defining] -> ShowS
Defining -> String
(Int -> Defining -> ShowS)
-> (Defining -> String) -> ([Defining] -> ShowS) -> Show Defining
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Defining] -> ShowS
$cshowList :: [Defining] -> ShowS
show :: Defining -> String
$cshow :: Defining -> String
showsPrec :: Int -> Defining -> ShowS
$cshowsPrec :: Int -> Defining -> ShowS
Show

-- Whether the item represents a constructor or pattern.
data Special where

  Special
    :: Special

  NotSpecial
    :: Special

  deriving Int -> Special -> ShowS
[Special] -> ShowS
Special -> String
(Int -> Special -> ShowS)
-> (Special -> String) -> ([Special] -> ShowS) -> Show Special
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Special] -> ShowS
$cshowList :: [Special] -> ShowS
show :: Special -> String
$cshow :: Special -> String
showsPrec :: Int -> Special -> ShowS
$cshowsPrec :: Int -> Special -> ShowS
Show

-- Like 'Item', but with some additional data:
--
-- - Whether the name is public or private.
-- - Whether the name is currently being defined.
--
-- Since constructors may be overloaded, a constructor AccessItem may
-- represent multiple constructors, some public and some private.
data AccessItem where

  AccessItemConstructor
    :: !(Set Range)
    -- ^ Private ranges.
    -> !(Set Range)
    -- ^ Public ranges.
    -> !(Set Name)
    -- ^ Private syntax.
    -> !(Set Name)
    -- ^ Public syntax.
    -> AccessItem

  AccessItemPattern
    :: !Access
    -> !(Set Range)
    -> !(Maybe Name)
    -> AccessItem

  AccessItemSyntax
    :: !Defining
    -> !Special
    -> !(Set Range)
    -> AccessItem

  AccessItem
    :: !Defining
    -> !Access
    -> !(Set Range)
    -> !(Maybe Name)
    -> AccessItem

  deriving Int -> AccessItem -> ShowS
[AccessItem] -> ShowS
AccessItem -> String
(Int -> AccessItem -> ShowS)
-> (AccessItem -> String)
-> ([AccessItem] -> ShowS)
-> Show AccessItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessItem] -> ShowS
$cshowList :: [AccessItem] -> ShowS
show :: AccessItem -> String
$cshow :: AccessItem -> String
showsPrec :: Int -> AccessItem -> ShowS
$cshowsPrec :: Int -> AccessItem -> ShowS
Show

-- | The data associated with a module in context. This includes:
--
-- - A list of ranges associated with the module, which includes the site of the
-- original definition, as well as any relevant @import@ or @open@ statements.
-- - The inner context of the module.
data Module
  = Module
  { Module -> Set Range
moduleRanges'
    :: !(Set Range)
  , Module -> Context
moduleContext
    :: !Context
  } deriving Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
(Int -> Module -> ShowS)
-> (Module -> String) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> String
$cshow :: Module -> String
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show

-- | Like 'Module', but also recording whether the module is public or private.
data AccessModule
  = AccessModule
  { AccessModule -> Access
accessModuleAccess
    :: !Access
  , AccessModule -> Set Range
accessModuleRanges
    :: !(Set Range)
  , AccessModule -> Context
accessModuleContext
    :: !Context
  } deriving Int -> AccessModule -> ShowS
[AccessModule] -> ShowS
AccessModule -> String
(Int -> AccessModule -> ShowS)
-> (AccessModule -> String)
-> ([AccessModule] -> ShowS)
-> Show AccessModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessModule] -> ShowS
$cshowList :: [AccessModule] -> ShowS
show :: AccessModule -> String
$cshow :: AccessModule -> String
showsPrec :: Int -> AccessModule -> ShowS
$cshowsPrec :: Int -> AccessModule -> ShowS
Show

-- | A namespace of definitions. Any Agda module produces a 'Context'.
data Context
  = Context
  { Context -> Map Name Item
contextItems
    :: !(Map Name Item)
  , Context -> Map Name Module
contextModules
    :: !(Map Name Module)
  } deriving Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show

-- | A namespace of definitions, which may be public or private. Any collection
-- of Agda declarations produces an 'AccessContext', for example.
data AccessContext
  = AccessContext
  { AccessContext -> Map Name AccessItem
accessContextItems
    :: !(Map Name AccessItem)
  , AccessContext -> Map Name AccessModule
accessContextModules
    :: !(Map Name AccessModule)
  , AccessContext -> Map QName Context
accessContextImports
    :: !(Map QName Context)
  } deriving Int -> AccessContext -> ShowS
[AccessContext] -> ShowS
AccessContext -> String
(Int -> AccessContext -> ShowS)
-> (AccessContext -> String)
-> ([AccessContext] -> ShowS)
-> Show AccessContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessContext] -> ShowS
$cshowList :: [AccessContext] -> ShowS
show :: AccessContext -> String
$cshow :: AccessContext -> String
showsPrec :: Int -> AccessContext -> ShowS
$cshowsPrec :: Int -> AccessContext -> ShowS
Show

-- | If both items are constructors, collect the private and public ranges for
-- both. Otherwise, return the second item.
instance Semigroup AccessItem where
  AccessItemConstructor Set Range
rs1 Set Range
ss1 Set Name
ts1 Set Name
us1 <> :: AccessItem -> AccessItem -> AccessItem
<> AccessItemConstructor Set Range
rs2 Set Range
ss2 Set Name
ts2 Set Name
us2
    = Set Range -> Set Range -> Set Name -> Set Name -> AccessItem
AccessItemConstructor (Set Range
rs1 Set Range -> Set Range -> Set Range
forall a. Semigroup a => a -> a -> a
<> Set Range
rs2) (Set Range
ss1 Set Range -> Set Range -> Set Range
forall a. Semigroup a => a -> a -> a
<> Set Range
ss2) (Set Name
ts1 Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Set Name
ts2) (Set Name
us1 Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Set Name
us2)
  AccessItem
_ <> AccessItem
i
    = AccessItem
i

-- | Prefer values from second context.
instance Semigroup Context where
  Context Map Name Item
is1 Map Name Module
ms1 <> :: Context -> Context -> Context
<> Context Map Name Item
is2 Map Name Module
ms2
    = Map Name Item -> Map Name Module -> Context
Context (Map Name Item
is2 Map Name Item -> Map Name Item -> Map Name Item
forall a. Semigroup a => a -> a -> a
<> Map Name Item
is1) (Map Name Module
ms2 Map Name Module -> Map Name Module -> Map Name Module
forall a. Semigroup a => a -> a -> a
<> Map Name Module
ms1)

-- | Prefer values from second access context.
instance Semigroup AccessContext where
  AccessContext Map Name AccessItem
is1 Map Name AccessModule
ms1 Map QName Context
js1 <> :: AccessContext -> AccessContext -> AccessContext
<> AccessContext Map Name AccessItem
is2 Map Name AccessModule
ms2 Map QName Context
js2
    = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext ((AccessItem -> AccessItem -> AccessItem)
-> Map Name AccessItem
-> Map Name AccessItem
-> Map Name AccessItem
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith AccessItem -> AccessItem -> AccessItem
forall a. Semigroup a => a -> a -> a
(<>) Map Name AccessItem
is1 Map Name AccessItem
is2) (Map Name AccessModule
ms2 Map Name AccessModule
-> Map Name AccessModule -> Map Name AccessModule
forall a. Semigroup a => a -> a -> a
<> Map Name AccessModule
ms1) (Map QName Context
js2 Map QName Context -> Map QName Context -> Map QName Context
forall a. Semigroup a => a -> a -> a
<> Map QName Context
js1)

instance Monoid Context where
  mempty :: Context
mempty
    = Map Name Item -> Map Name Module -> Context
Context Map Name Item
forall a. Monoid a => a
mempty Map Name Module
forall a. Monoid a => a
mempty

instance Monoid AccessContext where
  mempty :: AccessContext
mempty
    = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext Map Name AccessItem
forall a. Monoid a => a
mempty Map Name AccessModule
forall a. Monoid a => a
mempty Map QName Context
forall a. Monoid a => a
mempty

-- Ensure public names are not shadowed by private names.
accessItemUnion
  :: AccessItem
  -> AccessItem
  -> AccessItem
accessItemUnion :: AccessItem -> AccessItem -> AccessItem
accessItemUnion i :: AccessItem
i@(AccessItem Defining
_ Access
Public Set Range
_ Maybe Name
_) (AccessItemConstructor Set Range
_ Set Range
rs Set Name
_ Set Name
_)
  | Set Range -> Bool
forall a. Set a -> Bool
Set.null Set Range
rs
  = AccessItem
i
accessItemUnion i :: AccessItem
i@(AccessItem Defining
_ Access
Public Set Range
_ Maybe Name
_) (AccessItem Defining
_ Access
Private Set Range
_ Maybe Name
_)
  = AccessItem
i
accessItemUnion AccessItem
i1 AccessItem
i2
  = AccessItem
i1 AccessItem -> AccessItem -> AccessItem
forall a. Semigroup a => a -> a -> a
<> AccessItem
i2

-- Ensure public names are not shadowed by private names.
accessModuleUnion
  :: AccessModule
  -> AccessModule
  -> AccessModule
accessModuleUnion :: AccessModule -> AccessModule -> AccessModule
accessModuleUnion m1 :: AccessModule
m1@(AccessModule Access
Public Set Range
_ Context
_) (AccessModule Access
Private Set Range
_ Context
_)
  = AccessModule
m1
accessModuleUnion AccessModule
_ AccessModule
m2
  = AccessModule
m2

-- | Like '(<>)', but public items take precedence over private items. This is
-- important when combining contexts from successive declarations; for example:
--
-- @ 
-- module M where
--
--   postulate
--     A : Set
--
-- module N where
--
--   postulate
--     A : Set
--
--   open M
--
-- x : N.A
-- x = ?
-- @ 
--
-- This code type-checks, and the identifier @N.A@ refers to the postulate
-- declared in the definition of @N@, not the definition opened from @M@.
accessContextUnion
  :: AccessContext
  -> AccessContext
  -> AccessContext
accessContextUnion :: AccessContext -> AccessContext -> AccessContext
accessContextUnion (AccessContext Map Name AccessItem
is1 Map Name AccessModule
ms1 Map QName Context
js1) (AccessContext Map Name AccessItem
is2 Map Name AccessModule
ms2 Map QName Context
js2)
  = AccessContext :: Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext
  { accessContextItems :: Map Name AccessItem
accessContextItems
    = (AccessItem -> AccessItem -> AccessItem)
-> Map Name AccessItem
-> Map Name AccessItem
-> Map Name AccessItem
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith AccessItem -> AccessItem -> AccessItem
accessItemUnion Map Name AccessItem
is1 Map Name AccessItem
is2
  , accessContextModules :: Map Name AccessModule
accessContextModules
    = (AccessModule -> AccessModule -> AccessModule)
-> Map Name AccessModule
-> Map Name AccessModule
-> Map Name AccessModule
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith AccessModule -> AccessModule -> AccessModule
accessModuleUnion Map Name AccessModule
ms1 Map Name AccessModule
ms2
  , accessContextImports :: Map QName Context
accessContextImports
    = Map QName Context
js2 Map QName Context -> Map QName Context -> Map QName Context
forall a. Semigroup a => a -> a -> a
<> Map QName Context
js1
  }

-- ## Interface

-- ### Lookup

-- | A description of failure for an 'AccessContext' lookup.
data LookupError where

  LookupNotFound
    :: LookupError

  LookupAmbiguous
    :: LookupError

  deriving Int -> LookupError -> ShowS
[LookupError] -> ShowS
LookupError -> String
(Int -> LookupError -> ShowS)
-> (LookupError -> String)
-> ([LookupError] -> ShowS)
-> Show LookupError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LookupError] -> ShowS
$cshowList :: [LookupError] -> ShowS
show :: LookupError -> String
$cshow :: LookupError -> String
showsPrec :: Int -> LookupError -> ShowS
$cshowsPrec :: Int -> LookupError -> ShowS
Show

contextLookup
  :: QName
  -> Context
  -> Maybe (Set Range)
contextLookup :: QName -> Context -> Maybe (Set Range)
contextLookup QName
n Context
c
  = Item -> Set Range
itemRanges (Item -> Set Range) -> Maybe Item -> Maybe (Set Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Context -> Maybe Item
contextLookupItem QName
n Context
c

-- | Get the inner module for the given name, or 'Nothing' if not in context.
contextLookupModule
  :: QName
  -> Context
  -> Maybe Module
contextLookupModule :: QName -> Context -> Maybe Module
contextLookupModule (QName Name
n) (Context Map Name Item
_ Map Name Module
ms)
  = Name -> Map Name Module -> Maybe Module
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Module
ms
contextLookupModule (Qual Name
n QName
ns) (Context Map Name Item
_ Map Name Module
ms)
  = Name -> Map Name Module -> Maybe Module
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Module
ms Maybe Module -> (Module -> Maybe Module) -> Maybe Module
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QName -> Context -> Maybe Module
contextLookupModule QName
ns (Context -> Maybe Module)
-> (Module -> Context) -> Module -> Maybe Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Context
moduleContext

-- | Get the item for the given name, or 'Nothing' if not in context.
contextLookupItem
  :: QName
  -> Context
  -> Maybe Item
contextLookupItem :: QName -> Context -> Maybe Item
contextLookupItem (QName Name
n) (Context Map Name Item
is Map Name Module
_)
  = Name -> Map Name Item -> Maybe Item
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Item
is
contextLookupItem (Qual Name
n QName
ns) (Context Map Name Item
_ Map Name Module
ms)
  = Name -> Map Name Module -> Maybe Module
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name Module
ms Maybe Module -> (Module -> Maybe Item) -> Maybe Item
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QName -> Context -> Maybe Item
contextLookupItem QName
ns (Context -> Maybe Item)
-> (Module -> Context) -> Module -> Maybe Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Context
moduleContext

-- | Get the ranges for the given name, or produce a 'LookupError'.
accessContextLookup
  :: QName
  -> AccessContext
  -> Either LookupError (Set Range)
accessContextLookup :: QName -> AccessContext -> Either LookupError (Set Range)
accessContextLookup QName
n c :: AccessContext
c@(AccessContext Map Name AccessItem
_ Map Name AccessModule
_ Map QName Context
is)
  = QName -> Context -> Maybe (Set Range)
contextLookup QName
n (AccessContext -> Context
toContext' AccessContext
c)
  Maybe (Set Range)
-> Map QName (Maybe (Set Range)) -> Either LookupError (Set Range)
forall a k. Maybe a -> Map k (Maybe a) -> Either LookupError a
<|> (QName -> Context -> Maybe (Set Range))
-> Map QName Context -> Map QName (Maybe (Set Range))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (QName -> QName -> Context -> Maybe (Set Range)
accessContextLookupImport QName
n) Map QName Context
is

-- | Get the inner module for the given name, or produce a 'LookupError'.
accessContextLookupModule
  :: QName
  -> AccessContext
  -> Either LookupError Module
accessContextLookupModule :: QName -> AccessContext -> Either LookupError Module
accessContextLookupModule QName
n c :: AccessContext
c@(AccessContext Map Name AccessItem
_ Map Name AccessModule
_ Map QName Context
is)
  = QName -> Context -> Maybe Module
contextLookupModule QName
n (AccessContext -> Context
toContext' AccessContext
c)
  Maybe Module
-> Map QName (Maybe Module) -> Either LookupError Module
forall a k. Maybe a -> Map k (Maybe a) -> Either LookupError a
<|> (QName -> Context -> Maybe Module)
-> Map QName Context -> Map QName (Maybe Module)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (QName -> QName -> Context -> Maybe Module
accessContextLookupModuleImport QName
n) Map QName Context
is

accessContextLookupImport
  :: QName
  -> QName
  -> Context
  -> Maybe (Set Range)
accessContextLookupImport :: QName -> QName -> Context -> Maybe (Set Range)
accessContextLookupImport QName
n QName
i Context
c
  = QName -> QName -> Maybe QName
stripPrefix QName
i QName
n Maybe QName -> (QName -> Maybe (Set Range)) -> Maybe (Set Range)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QName -> Context -> Maybe (Set Range))
-> Context -> QName -> Maybe (Set Range)
forall a b c. (a -> b -> c) -> b -> a -> c
flip QName -> Context -> Maybe (Set Range)
contextLookup Context
c

accessContextLookupModuleImport
  :: QName
  -> QName
  -> Context
  -> Maybe Module
accessContextLookupModuleImport :: QName -> QName -> Context -> Maybe Module
accessContextLookupModuleImport QName
n QName
i Context
c | QName
n QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
i
  = Module -> Maybe Module
forall a. a -> Maybe a
Just (Set Range -> Context -> Module
Module Set Range
forall a. Monoid a => a
mempty Context
c)
accessContextLookupModuleImport QName
n QName
i Context
c
  = QName -> QName -> Maybe QName
stripPrefix QName
i QName
n Maybe QName -> (QName -> Maybe Module) -> Maybe Module
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QName -> Context -> Maybe Module)
-> Context -> QName -> Maybe Module
forall a b c. (a -> b -> c) -> b -> a -> c
flip QName -> Context -> Maybe Module
contextLookupModule Context
c

(<|>)
  :: Maybe a
  -> Map k (Maybe a)
  -> Either LookupError a
Maybe a
x <|> :: Maybe a -> Map k (Maybe a) -> Either LookupError a
<|> Map k (Maybe a)
xs
  = [a] -> Either LookupError a
forall a. [a] -> Either LookupError a
resolve ([Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes (Maybe a
x Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: Map k (Maybe a) -> [Maybe a]
forall k a. Map k a -> [a]
Map.elems Map k (Maybe a)
xs))

resolve
  :: [a]
  -> Either LookupError a
resolve :: [a] -> Either LookupError a
resolve []
  = LookupError -> Either LookupError a
forall a b. a -> Either a b
Left LookupError
LookupNotFound
resolve (a
x : [])
  = a -> Either LookupError a
forall a b. b -> Either a b
Right a
x
resolve (a
_ : a
_ : [a]
_)
  = LookupError -> Either LookupError a
forall a b. a -> Either a b
Left LookupError
LookupAmbiguous

accessItemDefining
  :: AccessItem
  -> Bool
accessItemDefining :: AccessItem -> Bool
accessItemDefining (AccessItem Defining
Defining Access
_ Set Range
_ Maybe Name
_)
  = Bool
True
accessItemDefining (AccessItemSyntax Defining
Defining Special
_ Set Range
_)
  = Bool
True
accessItemDefining AccessItem
_
  = Bool
False

-- | Like 'accessContextLookup', but also return a boolean indicating whether we
-- are currently defining the referenced item.
accessContextLookupDefining
  :: QName
  -> AccessContext
  -> Either LookupError (Bool, Set Range)
accessContextLookupDefining :: QName -> AccessContext -> Either LookupError (Bool, Set Range)
accessContextLookupDefining (QName Name
n) (AccessContext Map Name AccessItem
is Map Name AccessModule
_ Map QName Context
_)
  = Either LookupError (Bool, Set Range)
-> (AccessItem -> Either LookupError (Bool, Set Range))
-> Maybe AccessItem
-> Either LookupError (Bool, Set Range)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (LookupError -> Either LookupError (Bool, Set Range)
forall a b. a -> Either a b
Left LookupError
LookupNotFound)
    (\AccessItem
i -> (Bool, Set Range) -> Either LookupError (Bool, Set Range)
forall a b. b -> Either a b
Right (AccessItem -> Bool
accessItemDefining AccessItem
i, AccessItem -> Set Range
accessItemRanges AccessItem
i))
    (Name -> Map Name AccessItem -> Maybe AccessItem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name AccessItem
is)
accessContextLookupDefining n :: QName
n@(Qual Name
_ QName
_) AccessContext
c
  = (,) Bool
False (Set Range -> (Bool, Set Range))
-> Either LookupError (Set Range)
-> Either LookupError (Bool, Set Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> AccessContext -> Either LookupError (Set Range)
accessContextLookup QName
n AccessContext
c

itemSpecial
  :: Item
  -> Bool
itemSpecial :: Item -> Bool
itemSpecial (ItemConstructor Set Range
_ Set Name
_)
  = Bool
True
itemSpecial (ItemPattern Set Range
_ Maybe Name
_)
  = Bool
True
itemSpecial (Item Set Range
_ Maybe Name
_)
  = Bool
False

-- | Determine whether a name represents a constructor or pattern synonym.
-- Return 'Nothing' if the name is not in context.
accessContextLookupSpecial
  :: QName
  -> AccessContext
  -> Maybe Bool
accessContextLookupSpecial :: QName -> AccessContext -> Maybe Bool
accessContextLookupSpecial QName
n AccessContext
c
  = Item -> Bool
itemSpecial (Item -> Bool) -> Maybe Item -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Context -> Maybe Item
contextLookupItem QName
n (AccessContext -> Context
toContext' AccessContext
c)

-- ### Insert

itemInsertRange
  :: Range
  -> Item
  -> Item
itemInsertRange :: Range -> Item -> Item
itemInsertRange Range
r (ItemConstructor Set Range
rs Set Name
ss)
  = Set Range -> Set Name -> Item
ItemConstructor (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs) Set Name
ss
itemInsertRange Range
r (ItemPattern Set Range
rs Maybe Name
s)
  = Set Range -> Maybe Name -> Item
ItemPattern (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs) Maybe Name
s
itemInsertRange Range
r (Item Set Range
rs Maybe Name
s)
  = Set Range -> Maybe Name -> Item
Item (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs) Maybe Name
s

accessItemInsertRange
  :: Range
  -> AccessItem
  -> AccessItem
accessItemInsertRange :: Range -> AccessItem -> AccessItem
accessItemInsertRange Range
r (AccessItemConstructor Set Range
rs1 Set Range
rs2 Set Name
ss1 Set Name
ss2)
  = Set Range -> Set Range -> Set Name -> Set Name -> AccessItem
AccessItemConstructor (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs1) (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs2) Set Name
ss1 Set Name
ss2
accessItemInsertRange Range
r (AccessItemPattern Access
a Set Range
rs Maybe Name
s)
  = Access -> Set Range -> Maybe Name -> AccessItem
AccessItemPattern Access
a (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs) Maybe Name
s
accessItemInsertRange Range
r (AccessItemSyntax Defining
d Special
s Set Range
rs)
  = Defining -> Special -> Set Range -> AccessItem
AccessItemSyntax Defining
d Special
s (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs)
accessItemInsertRange Range
r (AccessItem Defining
i Access
a Set Range
rs Maybe Name
s)
  = Defining -> Access -> Set Range -> Maybe Name -> AccessItem
AccessItem Defining
i Access
a (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs) Maybe Name
s

moduleInsertRangeAll
  :: Range
  -> Module
  -> Module
moduleInsertRangeAll :: Range -> Module -> Module
moduleInsertRangeAll Range
r (Module Set Range
rs Context
c)
  = Set Range -> Context -> Module
Module (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs) (Range -> Context -> Context
contextInsertRangeAll Range
r Context
c)

accessModuleInsertRangeAll
  :: Range
  -> AccessModule
  -> AccessModule
accessModuleInsertRangeAll :: Range -> AccessModule -> AccessModule
accessModuleInsertRangeAll Range
r (AccessModule Access
a Set Range
rs Context
c)
  = Access -> Set Range -> Context -> AccessModule
AccessModule Access
a (Range -> Set Range -> Set Range
forall a. Ord a => a -> Set a -> Set a
Set.insert Range
r Set Range
rs) (Range -> Context -> Context
contextInsertRangeAll Range
r Context
c)

-- | Insert a range for all names in a context.
contextInsertRangeAll
  :: Range
  -> Context
  -> Context
contextInsertRangeAll :: Range -> Context -> Context
contextInsertRangeAll Range
r (Context Map Name Item
is Map Name Module
ms)
  = Map Name Item -> Map Name Module -> Context
Context
    (Range -> Item -> Item
itemInsertRange Range
r (Item -> Item) -> Map Name Item -> Map Name Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Item
is)
    (Range -> Module -> Module
moduleInsertRangeAll Range
r (Module -> Module) -> Map Name Module -> Map Name Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Module
ms)

-- | Insert a range for all names in an access context.
accessContextInsertRangeAll
  :: Range
  -> AccessContext
  -> AccessContext
accessContextInsertRangeAll :: Range -> AccessContext -> AccessContext
accessContextInsertRangeAll Range
r (AccessContext Map Name AccessItem
is Map Name AccessModule
ms Map QName Context
js)
  = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext
    (Range -> AccessItem -> AccessItem
accessItemInsertRange Range
r (AccessItem -> AccessItem)
-> Map Name AccessItem -> Map Name AccessItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name AccessItem
is)
    (Range -> AccessModule -> AccessModule
accessModuleInsertRangeAll Range
r (AccessModule -> AccessModule)
-> Map Name AccessModule -> Map Name AccessModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name AccessModule
ms) Map QName Context
js

-- ### Delete

-- | Delete an item from the context.
contextDelete
  :: Name
  -> Context
  -> Context
contextDelete :: Name -> Context -> Context
contextDelete Name
n (Context Map Name Item
is Map Name Module
ms)
  = Map Name Item -> Map Name Module -> Context
Context (Name -> Map Name Item -> Map Name Item
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Name
n Map Name Item
is) Map Name Module
ms

-- | Delete a module from the context.
contextDeleteModule
  :: Name
  -> Context
  -> Context
contextDeleteModule :: Name -> Context -> Context
contextDeleteModule Name
n (Context Map Name Item
is Map Name Module
ms)
  = Map Name Item -> Map Name Module -> Context
Context Map Name Item
is (Name -> Map Name Module -> Map Name Module
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Name
n Map Name Module
ms)

-- ### Define

accessItemDefine
  :: AccessItem
  -> AccessItem
accessItemDefine :: AccessItem -> AccessItem
accessItemDefine (AccessItem Defining
_ Access
a Set Range
rs Maybe Name
s)
  = Defining -> Access -> Set Range -> Maybe Name -> AccessItem
AccessItem Defining
Defining Access
a Set Range
rs Maybe Name
s
accessItemDefine (AccessItemSyntax Defining
_ Special
s Set Range
rs)
  = Defining -> Special -> Set Range -> AccessItem
AccessItemSyntax Defining
Defining Special
s Set Range
rs
accessItemDefine AccessItem
i
  = AccessItem
i

accessItemDefineField
  :: AccessItem
  -> AccessItem
accessItemDefineField :: AccessItem -> AccessItem
accessItemDefineField (AccessItem Defining
NotDefiningField Access
a Set Range
rs Maybe Name
s)
  = Defining -> Access -> Set Range -> Maybe Name -> AccessItem
AccessItem Defining
Defining Access
a Set Range
rs Maybe Name
s
accessItemDefineField (AccessItemSyntax Defining
NotDefiningField Special
s Set Range
rs)
  = Defining -> Special -> Set Range -> AccessItem
AccessItemSyntax Defining
Defining Special
s Set Range
rs
accessItemDefineField AccessItem
i
  = AccessItem
i

-- | Mark an existing name as in process of being defined.
accessContextDefine
  :: Name
  -> AccessContext
  -> AccessContext
accessContextDefine :: Name -> AccessContext -> AccessContext
accessContextDefine Name
n (AccessContext Map Name AccessItem
is Map Name AccessModule
ms Map QName Context
js)
  = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext ((AccessItem -> AccessItem)
-> Name -> Map Name AccessItem -> Map Name AccessItem
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust AccessItem -> AccessItem
accessItemDefine Name
n Map Name AccessItem
is) Map Name AccessModule
ms Map QName Context
js

-- | Mark all fields as in process of being defined.
accessContextDefineFields
  :: AccessContext
  -> AccessContext
accessContextDefineFields :: AccessContext -> AccessContext
accessContextDefineFields (AccessContext Map Name AccessItem
is Map Name AccessModule
ms Map QName Context
js)
  = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext ((AccessItem -> AccessItem)
-> Map Name AccessItem -> Map Name AccessItem
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map AccessItem -> AccessItem
accessItemDefineField Map Name AccessItem
is) Map Name AccessModule
ms Map QName Context
js

-- ### Ranges

itemRanges
  :: Item
  -> Set Range
itemRanges :: Item -> Set Range
itemRanges (ItemConstructor Set Range
rs Set Name
_)
  = Set Range
rs
itemRanges (ItemPattern Set Range
rs Maybe Name
_)
  = Set Range
rs
itemRanges (Item Set Range
rs Maybe Name
_)
  = Set Range
rs

accessItemRanges
  :: AccessItem
  -> Set Range
accessItemRanges :: AccessItem -> Set Range
accessItemRanges
  = Item -> Set Range
itemRanges (Item -> Set Range)
-> (AccessItem -> Item) -> AccessItem -> Set Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessItem -> Item
toItem'

-- | Get all ranges associated with names in the given module, including ranges
-- associated with the module itself.
moduleRanges
  :: Module
  -> Set Range
moduleRanges :: Module -> Set Range
moduleRanges (Module Set Range
rs Context
c)
  = Set Range
rs Set Range -> Set Range -> Set Range
forall a. Semigroup a => a -> a -> a
<> Context -> Set Range
contextRanges Context
c

-- | Get all ranges associated with names in the given context.
contextRanges
  :: Context
  -> Set Range
contextRanges :: Context -> Set Range
contextRanges (Context Map Name Item
is Map Name Module
ms)
  = [Set Range] -> Set Range
forall a. Monoid a => [a] -> a
mconcat (Item -> Set Range
itemRanges (Item -> Set Range) -> [Item] -> [Set Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Item -> [Item]
forall k a. Map k a -> [a]
Map.elems Map Name Item
is)
  Set Range -> Set Range -> Set Range
forall a. Semigroup a => a -> a -> a
<> [Set Range] -> Set Range
forall a. Monoid a => [a] -> a
mconcat (Module -> Set Range
moduleRanges (Module -> Set Range) -> [Module] -> [Set Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name Module -> [Module]
forall k a. Map k a -> [a]
Map.elems Map Name Module
ms)

-- | Get all ranges associated with names in the given access context.
accessContextRanges
  :: AccessContext
  -> Set Range
accessContextRanges :: AccessContext -> Set Range
accessContextRanges c :: AccessContext
c@(AccessContext Map Name AccessItem
_ Map Name AccessModule
_ Map QName Context
js)
  = Context -> Set Range
contextRanges (AccessContext -> Context
toContext' AccessContext
c)
  Set Range -> Set Range -> Set Range
forall a. Semigroup a => a -> a -> a
<> [Set Range] -> Set Range
forall a. Monoid a => [a] -> a
mconcat (Context -> Set Range
contextRanges (Context -> Set Range) -> [Context] -> [Set Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map QName Context -> [Context]
forall k a. Map k a -> [a]
Map.elems Map QName Context
js)

-- ### Match

-- | Find all operators matching the given list of tokens.
accessContextMatch
  :: [String]
  -> AccessContext
  -> [Name]
accessContextMatch :: [String] -> AccessContext -> [Name]
accessContextMatch [String]
ss (AccessContext Map Name AccessItem
is Map Name AccessModule
_ Map QName Context
_)
  = [String] -> [Name] -> [Name]
matchOperators [String]
ss (Map Name AccessItem -> [Name]
forall k a. Map k a -> [k]
Map.keys Map Name AccessItem
is)

-- ## Construction

-- | Construct a 'Context' with a single item.
contextItem
  :: Name
  -> Item
  -> Context
contextItem :: Name -> Item -> Context
contextItem Name
n Item
i
  = Map Name Item -> Map Name Module -> Context
Context (Name -> Item -> Map Name Item
forall k a. k -> a -> Map k a
Map.singleton Name
n Item
i) Map Name Module
forall a. Monoid a => a
mempty

-- | Construct a 'Context' with a single module.
contextModule
  :: Name
  -> Module
  -> Context
contextModule :: Name -> Module -> Context
contextModule Name
n Module
m
  = Map Name Item -> Map Name Module -> Context
Context Map Name Item
forall a. Monoid a => a
mempty (Name -> Module -> Map Name Module
forall k a. k -> a -> Map k a
Map.singleton Name
n Module
m)

-- | Construct an 'AccessContext' with a single constructor.
accessContextConstructor
  :: Name
  -> Access
  -> Set Range
  -> Maybe Name
  -> AccessContext
accessContextConstructor :: Name -> Access -> Set Range -> Maybe Name -> AccessContext
accessContextConstructor Name
n Access
a Set Range
rs Maybe Name
s
  = Name -> Access -> Item -> AccessContext
accessContextItem' Name
n Access
a (Set Range -> Set Name -> Item
ItemConstructor Set Range
rs (Set Name -> (Name -> Set Name) -> Maybe Name -> Set Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Name
forall a. Monoid a => a
mempty Name -> Set Name
forall a. a -> Set a
Set.singleton Maybe Name
s))

-- | Construct an 'AccessContext' with a single pattern synonym.
accessContextPattern
  :: Name
  -> Access
  -> Set Range
  -> Maybe Name
  -> AccessContext
accessContextPattern :: Name -> Access -> Set Range -> Maybe Name -> AccessContext
accessContextPattern Name
n Access
a Set Range
rs Maybe Name
s
  = Name -> Access -> Item -> AccessContext
accessContextItem' Name
n Access
a (Set Range -> Maybe Name -> Item
ItemPattern Set Range
rs Maybe Name
s)

-- | Construct an 'AccessContext' with a single field.
accessContextField
  :: Name
  -> Access
  -> Set Range
  -> Maybe Name
  -> AccessContext
accessContextField :: Name -> Access -> Set Range -> Maybe Name -> AccessContext
accessContextField Name
n Access
a Set Range
rs Maybe Name
s
  = AccessContext -> AccessContext
toFields (Name -> Access -> Item -> AccessContext
accessContextItem' Name
n Access
a (Set Range -> Maybe Name -> Item
Item Set Range
rs Maybe Name
s))

-- | Construct an 'AccessContext' with a single ordinary definition.
accessContextItem
  :: Name
  -> Access
  -> Set Range
  -> Maybe Name
  -> AccessContext
accessContextItem :: Name -> Access -> Set Range -> Maybe Name -> AccessContext
accessContextItem Name
n Access
a Set Range
rs Maybe Name
s
  = Name -> Access -> Item -> AccessContext
accessContextItem' Name
n Access
a (Set Range -> Maybe Name -> Item
Item Set Range
rs Maybe Name
s)

-- Construct an 'AccessContext' with a single item, along with the relevant
-- syntax item if applicable.
accessContextItem'
  :: Name
  -> Access
  -> Item
  -> AccessContext
accessContextItem' :: Name -> Access -> Item -> AccessContext
accessContextItem' Name
n Access
a Item
i
  = Access -> Context -> AccessContext
fromContext Access
a (Name -> Item -> Context
contextItem Name
n Item
i)

-- | Construct an 'AccessContext' with a single access module.
accessContextModule
  :: Name
  -> AccessModule
  -> AccessContext
accessContextModule :: Name -> AccessModule -> AccessContext
accessContextModule Name
n AccessModule
m
  = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext Map Name AccessItem
forall a. Monoid a => a
mempty (Name -> AccessModule -> Map Name AccessModule
forall k a. k -> a -> Map k a
Map.singleton Name
n AccessModule
m) Map QName Context
forall a. Monoid a => a
mempty

-- | Like 'accessContextModule', but taking an access context. We convert the
-- given access context to an ordinary context using 'toContext':
--
-- @
-- accessContextModule' n a rs c
--   = accessContextModule n (AccessModule a rs (toContext c))
-- @
accessContextModule'
  :: Name
  -> Access
  -> Set Range
  -> AccessContext
  -> AccessContext
accessContextModule' :: Name -> Access -> Set Range -> AccessContext -> AccessContext
accessContextModule' Name
n Access
a Set Range
rs AccessContext
c
  = Name -> AccessModule -> AccessContext
accessContextModule Name
n (Access -> Set Range -> Context -> AccessModule
AccessModule Access
a Set Range
rs (AccessContext -> Context
toContext AccessContext
c))

-- | Construct an access context with a single import.
accessContextImport
  :: QName
  -> Context
  -> AccessContext
accessContextImport :: QName -> Context -> AccessContext
accessContextImport QName
n Context
c
  = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext Map Name AccessItem
forall a. Monoid a => a
mempty Map Name AccessModule
forall a. Monoid a => a
mempty (QName -> Context -> Map QName Context
forall k a. k -> a -> Map k a
Map.singleton QName
n Context
c)

-- ## Conversion

fromItem
  :: Access
  -> Item
  -> AccessItem
fromItem :: Access -> Item -> AccessItem
fromItem Access
Private (ItemConstructor Set Range
rs Set Name
ss)
  = Set Range -> Set Range -> Set Name -> Set Name -> AccessItem
AccessItemConstructor Set Range
rs Set Range
forall a. Monoid a => a
mempty Set Name
ss Set Name
forall a. Monoid a => a
mempty
fromItem Access
Public (ItemConstructor Set Range
rs Set Name
ss)
  = Set Range -> Set Range -> Set Name -> Set Name -> AccessItem
AccessItemConstructor Set Range
forall a. Monoid a => a
mempty Set Range
rs Set Name
forall a. Monoid a => a
mempty Set Name
ss
fromItem Access
a (ItemPattern Set Range
rs Maybe Name
s)
  = Access -> Set Range -> Maybe Name -> AccessItem
AccessItemPattern Access
a Set Range
rs Maybe Name
s
fromItem Access
a (Item Set Range
rs Maybe Name
s)
  = Defining -> Access -> Set Range -> Maybe Name -> AccessItem
AccessItem Defining
NotDefining Access
a Set Range
rs Maybe Name
s

fromItemSyntax
  :: Item
  -> [(Name, AccessItem)]
fromItemSyntax :: Item -> [(Name, AccessItem)]
fromItemSyntax (ItemConstructor Set Range
rs Set Name
ss)
  = (Name -> AccessItem -> (Name, AccessItem))
-> AccessItem -> Name -> (Name, AccessItem)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (Defining -> Special -> Set Range -> AccessItem
AccessItemSyntax Defining
NotDefining Special
Special Set Range
rs) (Name -> (Name, AccessItem)) -> [Name] -> [(Name, AccessItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Name -> [Name]
forall a. Set a -> [a]
Set.elems Set Name
ss
fromItemSyntax (ItemPattern Set Range
rs Maybe Name
s)
  = (Name -> AccessItem -> (Name, AccessItem))
-> AccessItem -> Name -> (Name, AccessItem)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (Defining -> Special -> Set Range -> AccessItem
AccessItemSyntax Defining
NotDefining Special
Special Set Range
rs) (Name -> (Name, AccessItem)) -> [Name] -> [(Name, AccessItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name] -> (Name -> [Name]) -> Maybe Name -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: []) Maybe Name
s
fromItemSyntax (Item Set Range
rs Maybe Name
s)
  = (Name -> AccessItem -> (Name, AccessItem))
-> AccessItem -> Name -> (Name, AccessItem)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (Defining -> Special -> Set Range -> AccessItem
AccessItemSyntax Defining
NotDefining Special
NotSpecial Set Range
rs) (Name -> (Name, AccessItem)) -> [Name] -> [(Name, AccessItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name] -> (Name -> [Name]) -> Maybe Name -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: []) Maybe Name
s

toItem
  :: AccessItem
  -> Maybe Item
toItem :: AccessItem -> Maybe Item
toItem (AccessItemConstructor Set Range
_ Set Range
rs Set Name
_ Set Name
ss) | Bool -> Bool
not (Set Range -> Bool
forall a. Set a -> Bool
Set.null Set Range
rs)
  = Item -> Maybe Item
forall a. a -> Maybe a
Just (Set Range -> Set Name -> Item
ItemConstructor Set Range
rs Set Name
ss)
toItem (AccessItemPattern Access
Public Set Range
rs Maybe Name
s)
  = Item -> Maybe Item
forall a. a -> Maybe a
Just (Set Range -> Maybe Name -> Item
ItemPattern Set Range
rs Maybe Name
s)
toItem (AccessItem Defining
_ Access
Public Set Range
rs Maybe Name
s)
  = Item -> Maybe Item
forall a. a -> Maybe a
Just (Set Range -> Maybe Name -> Item
Item Set Range
rs Maybe Name
s)
toItem AccessItem
_
  = Maybe Item
forall a. Maybe a
Nothing

toItem'
  :: AccessItem
  -> Item
toItem' :: AccessItem -> Item
toItem' (AccessItemConstructor Set Range
rs1 Set Range
rs2 Set Name
ss1 Set Name
ss2)
  = Set Range -> Set Name -> Item
ItemConstructor (Set Range
rs1 Set Range -> Set Range -> Set Range
forall a. Semigroup a => a -> a -> a
<> Set Range
rs2) (Set Name
ss1 Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Set Name
ss2)
toItem' (AccessItemPattern Access
_ Set Range
rs Maybe Name
s)
  = Set Range -> Maybe Name -> Item
ItemPattern Set Range
rs Maybe Name
s
toItem' (AccessItemSyntax Defining
_ Special
_ Set Range
rs)
  = Set Range -> Maybe Name -> Item
Item Set Range
rs Maybe Name
forall a. Maybe a
Nothing
toItem' (AccessItem Defining
_ Access
_ Set Range
rs Maybe Name
s)
  = Set Range -> Maybe Name -> Item
Item Set Range
rs Maybe Name
s

fromModule
  :: Access
  -> Module
  -> AccessModule
fromModule :: Access -> Module -> AccessModule
fromModule Access
a (Module Set Range
rs Context
c)
  = Access -> Set Range -> Context -> AccessModule
AccessModule Access
a Set Range
rs Context
c

toModule
  :: AccessModule
  -> Maybe Module
toModule :: AccessModule -> Maybe Module
toModule (AccessModule Access
Private Set Range
_ Context
_)
  = Maybe Module
forall a. Maybe a
Nothing
toModule (AccessModule Access
Public Set Range
rs Context
c)
  = Module -> Maybe Module
forall a. a -> Maybe a
Just (Set Range -> Context -> Module
Module Set Range
rs Context
c)

toModule'
  :: AccessModule
  -> Module
toModule' :: AccessModule -> Module
toModule' (AccessModule Access
_ Set Range
rs Context
c)
  = Set Range -> Context -> Module
Module Set Range
rs Context
c

-- | Convert a 'Context' to 'AccessContext'. Give all items the given access.
fromContext
  :: Access
  -> Context
  -> AccessContext
fromContext :: Access -> Context -> AccessContext
fromContext Access
a (Context Map Name Item
is Map Name Module
ms)
  = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext
    ((Item -> AccessItem) -> Map Name Item -> Map Name AccessItem
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Access -> Item -> AccessItem
fromItem Access
a) Map Name Item
is Map Name AccessItem -> Map Name AccessItem -> Map Name AccessItem
forall a. Semigroup a => a -> a -> a
<> [(Name, AccessItem)] -> Map Name AccessItem
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Map Name Item -> [Item]
forall k a. Map k a -> [a]
Map.elems Map Name Item
is [Item] -> (Item -> [(Name, AccessItem)]) -> [(Name, AccessItem)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item -> [(Name, AccessItem)]
fromItemSyntax))
    ((Module -> AccessModule)
-> Map Name Module -> Map Name AccessModule
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Access -> Module -> AccessModule
fromModule Access
a) Map Name Module
ms)
    Map QName Context
forall a. Monoid a => a
mempty

-- | Convert an 'AccessContext' to 'Context'. Discard private items and imports.
toContext
  :: AccessContext
  -> Context
toContext :: AccessContext -> Context
toContext (AccessContext Map Name AccessItem
is Map Name AccessModule
ms Map QName Context
_)
  = Map Name Item -> Map Name Module -> Context
Context ((AccessItem -> Maybe Item) -> Map Name AccessItem -> Map Name Item
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe AccessItem -> Maybe Item
toItem Map Name AccessItem
is) ((AccessModule -> Maybe Module)
-> Map Name AccessModule -> Map Name Module
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe AccessModule -> Maybe Module
toModule Map Name AccessModule
ms)

-- Like 'toContext`, but keep private items.
toContext'
  :: AccessContext
  -> Context
toContext' :: AccessContext -> Context
toContext' (AccessContext Map Name AccessItem
is Map Name AccessModule
ms Map QName Context
_)
  = Map Name Item -> Map Name Module -> Context
Context ((AccessItem -> Item) -> Map Name AccessItem -> Map Name Item
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map AccessItem -> Item
toItem' Map Name AccessItem
is) ((AccessModule -> Module)
-> Map Name AccessModule -> Map Name Module
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map AccessModule -> Module
toModule' Map Name AccessModule
ms)

toField
  :: AccessItem
  -> AccessItem
toField :: AccessItem -> AccessItem
toField (AccessItem Defining
_ Access
a Set Range
rs Maybe Name
s)
  = Defining -> Access -> Set Range -> Maybe Name -> AccessItem
AccessItem Defining
NotDefiningField Access
a Set Range
rs Maybe Name
s
toField (AccessItemSyntax Defining
_ Special
s Set Range
rs)
  = Defining -> Special -> Set Range -> AccessItem
AccessItemSyntax Defining
NotDefiningField Special
s Set Range
rs
toField AccessItem
i
  = AccessItem
i

-- Convert all ordinary & syntax items to fields.
toFields
  :: AccessContext
  -> AccessContext
toFields :: AccessContext -> AccessContext
toFields (AccessContext Map Name AccessItem
is Map Name AccessModule
ms Map QName Context
js)
  = Map Name AccessItem
-> Map Name AccessModule -> Map QName Context -> AccessContext
AccessContext ((AccessItem -> AccessItem)
-> Map Name AccessItem -> Map Name AccessItem
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map AccessItem -> AccessItem
toField Map Name AccessItem
is) Map Name AccessModule
ms Map QName Context
js