{- |
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(..)
  , contextLookup
  , contextLookupItem
  , contextLookupModule
  , accessContextLookup
  , accessContextLookupModule
  , accessContextLookupDefining
  , accessContextLookupSpecial
  
    -- ** Insert

  , contextInsertRange
  , contextInsertRangeModule
  , contextInsertRangeAll
  , accessContextInsertRangeAll

    -- ** Delete

  , contextDelete
  , contextDeleteModule

    -- ** Rename

  , contextRename
  , contextRenameModule

    -- ** Define

  , accessContextDefine

    -- ** Ranges

  , moduleRanges
  , contextRanges

    -- ** Match

  , accessContextMatch

    -- * Construction

  , item
  , itemPattern
  , itemConstructor
  , contextItem
  , contextModule
  , 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 Agda.Unused.Utils
  (mapUpdateKey)

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

-- ## 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
    :: ![Range]
    -> ![Name]
    -> Item

  ItemPattern
    :: ![Range]
    -> !(Maybe Name)
    -> Item

  Item
    :: ![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

-- 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
    -- Private ranges.
    :: ![Range]
    -- Public ranges.
    -> ![Range]
    -- Private syntax.
    -> ![Name]
    -- Public syntax.
    -> ![Name]
    -> AccessItem

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

  AccessItemSyntax
    -- Whether the item is special.
    :: !Bool
    -> ![Range]
    -> AccessItem

  AccessItem
    -- Whether we are currently defining this item.
    :: !Bool
    -> !Access
    -> ![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 -> [Range]
moduleRanges'
    :: ![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 -> [Range]
accessModuleRanges
    :: ![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 rs1 :: [Range]
rs1 ss1 :: [Range]
ss1 ts1 :: [Name]
ts1 us1 :: [Name]
us1 <> :: AccessItem -> AccessItem -> AccessItem
<> AccessItemConstructor rs2 :: [Range]
rs2 ss2 :: [Range]
ss2 ts2 :: [Name]
ts2 us2 :: [Name]
us2
    = [Range] -> [Range] -> [Name] -> [Name] -> AccessItem
AccessItemConstructor ([Range]
rs1 [Range] -> [Range] -> [Range]
forall a. Semigroup a => a -> a -> a
<> [Range]
rs2) ([Range]
ss1 [Range] -> [Range] -> [Range]
forall a. Semigroup a => a -> a -> a
<> [Range]
ss2) ([Name]
ts1 [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> [Name]
ts2) ([Name]
us1 [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> [Name]
us2)
  _ <> i :: AccessItem
i
    = AccessItem
i

-- | Prefer values from second context.
instance Semigroup Context where
  Context is1 :: Map Name Item
is1 ms1 :: Map Name Module
ms1 <> :: Context -> Context -> Context
<> Context is2 :: Map Name Item
is2 ms2 :: 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 is1 :: Map Name AccessItem
is1 ms1 :: Map Name AccessModule
ms1 js1 :: Map QName Context
js1 <> :: AccessContext -> AccessContext -> AccessContext
<> AccessContext is2 :: Map Name AccessItem
is2 ms2 :: Map Name AccessModule
ms2 js2 :: 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 _ Public _ _) (AccessItemConstructor _ [] _ _)
  = AccessItem
i
accessItemUnion i :: AccessItem
i@(AccessItem _ Public _ _) (AccessItem _ Private _ _)
  = AccessItem
i
accessItemUnion i1 :: AccessItem
i1 i2 :: 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 Public _ _) (AccessModule Private _ _)
  = AccessModule
m1
accessModuleUnion _ m2 :: 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 is1 :: Map Name AccessItem
is1 ms1 :: Map Name AccessModule
ms1 js1 :: Map QName Context
js1) (AccessContext is2 :: Map Name AccessItem
is2 ms2 :: Map Name AccessModule
ms2 js2 :: Map QName Context
js2)
  = $WAccessContext :: 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

-- | Get the ranges for the given name, or 'Nothing' if not in context.
contextLookup
  :: QName
  -> Context
  -> Maybe [Range]
contextLookup :: QName -> Context -> Maybe [Range]
contextLookup n :: QName
n c :: Context
c
  = Item -> [Range]
itemRanges (Item -> [Range]) -> Maybe Item -> Maybe [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 n :: Name
n) (Context _ ms :: 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 n :: Name
n ns :: QName
ns) (Context _ ms :: 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 n :: Name
n) (Context is :: Map Name Item
is _)
  = 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 n :: Name
n ns :: QName
ns) (Context _ ms :: 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 [Range]
accessContextLookup :: QName -> AccessContext -> Either LookupError [Range]
accessContextLookup n :: QName
n c :: AccessContext
c@(AccessContext _ _ is :: Map QName Context
is)
  = QName -> Context -> Maybe [Range]
contextLookup QName
n (AccessContext -> Context
toContext' AccessContext
c)
  Maybe [Range]
-> Map QName (Maybe [Range]) -> Either LookupError [Range]
forall a k. Maybe a -> Map k (Maybe a) -> Either LookupError a
<|> (QName -> Context -> Maybe [Range])
-> Map QName Context -> Map QName (Maybe [Range])
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (QName -> QName -> Context -> Maybe [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 n :: QName
n c :: AccessContext
c@(AccessContext _ _ is :: 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 [Range]
accessContextLookupImport :: QName -> QName -> Context -> Maybe [Range]
accessContextLookupImport n :: QName
n i :: QName
i c :: Context
c
  = QName -> QName -> Maybe QName
stripPrefix QName
i QName
n Maybe QName -> (QName -> Maybe [Range]) -> Maybe [Range]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QName -> Context -> Maybe [Range])
-> Context -> QName -> Maybe [Range]
forall a b c. (a -> b -> c) -> b -> a -> c
flip QName -> Context -> Maybe [Range]
contextLookup Context
c

accessContextLookupModuleImport
  :: QName
  -> QName
  -> Context
  -> Maybe Module
accessContextLookupModuleImport :: QName -> QName -> Context -> Maybe Module
accessContextLookupModuleImport n :: QName
n i :: QName
i c :: 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 ([Range] -> Context -> Module
Module [] Context
c)
accessContextLookupModuleImport n :: QName
n i :: QName
i c :: 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
x :: Maybe a
x <|> :: Maybe a -> Map k (Maybe a) -> Either LookupError a
<|> xs :: 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 (x :: a
x : [])
  = a -> Either LookupError a
forall a b. b -> Either a b
Right a
x
resolve (_ : _ : _)
  = LookupError -> Either LookupError a
forall a b. a -> Either a b
Left LookupError
LookupAmbiguous

accessItemDefining
  :: AccessItem
  -> Bool
accessItemDefining :: AccessItem -> Bool
accessItemDefining (AccessItem b :: Bool
b _ _ _)
  = Bool
b
accessItemDefining _
  = Bool
False

-- | Like 'accessContextLookup', but also return a boolean indicating whether we
-- are currently defining the referenced item.
accessContextLookupDefining
  :: QName
  -> AccessContext
  -> Either LookupError (Bool, [Range])
accessContextLookupDefining :: QName -> AccessContext -> Either LookupError (Bool, [Range])
accessContextLookupDefining (QName n :: Name
n) (AccessContext is :: Map Name AccessItem
is _ _)
  = Either LookupError (Bool, [Range])
-> (AccessItem -> Either LookupError (Bool, [Range]))
-> Maybe AccessItem
-> Either LookupError (Bool, [Range])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (LookupError -> Either LookupError (Bool, [Range])
forall a b. a -> Either a b
Left LookupError
LookupNotFound)
    (\i :: AccessItem
i -> (Bool, [Range]) -> Either LookupError (Bool, [Range])
forall a b. b -> Either a b
Right (AccessItem -> Bool
accessItemDefining AccessItem
i, AccessItem -> [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 _ _) c :: AccessContext
c
  = (,) Bool
False ([Range] -> (Bool, [Range]))
-> Either LookupError [Range] -> Either LookupError (Bool, [Range])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> AccessContext -> Either LookupError [Range]
accessContextLookup QName
n AccessContext
c

itemSpecial
  :: Item
  -> Bool
itemSpecial :: Item -> Bool
itemSpecial (ItemConstructor _ _)
  = Bool
True
itemSpecial (ItemPattern _ _)
  = Bool
True
itemSpecial (Item _ _)
  = 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 n :: QName
n c :: 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 r :: Range
r (ItemConstructor rs :: [Range]
rs ss :: [Name]
ss)
  = [Range] -> [Name] -> Item
ItemConstructor (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs) [Name]
ss
itemInsertRange r :: Range
r (ItemPattern rs :: [Range]
rs s :: Maybe Name
s)
  = [Range] -> Maybe Name -> Item
ItemPattern (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs) Maybe Name
s
itemInsertRange r :: Range
r (Item rs :: [Range]
rs s :: Maybe Name
s)
  = [Range] -> Maybe Name -> Item
Item (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs) Maybe Name
s

accessItemInsertRange
  :: Range
  -> AccessItem
  -> AccessItem
accessItemInsertRange :: Range -> AccessItem -> AccessItem
accessItemInsertRange r :: Range
r (AccessItemConstructor rs1 :: [Range]
rs1 rs2 :: [Range]
rs2 ns1 :: [Name]
ns1 ns2 :: [Name]
ns2)
  = [Range] -> [Range] -> [Name] -> [Name] -> AccessItem
AccessItemConstructor (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs1) (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs2) [Name]
ns1 [Name]
ns2
accessItemInsertRange r :: Range
r (AccessItemPattern a :: Access
a rs :: [Range]
rs n :: Maybe Name
n)
  = Access -> [Range] -> Maybe Name -> AccessItem
AccessItemPattern Access
a (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs) Maybe Name
n
accessItemInsertRange r :: Range
r (AccessItemSyntax b :: Bool
b rs :: [Range]
rs)
  = Bool -> [Range] -> AccessItem
AccessItemSyntax Bool
b (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs)
accessItemInsertRange r :: Range
r (AccessItem b :: Bool
b a :: Access
a rs :: [Range]
rs n :: Maybe Name
n)
  = Bool -> Access -> [Range] -> Maybe Name -> AccessItem
AccessItem Bool
b Access
a (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs) Maybe Name
n

-- | Insert a range for the given name, if present.
contextInsertRange
  :: Name
  -> Range
  -> Context
  -> Context
contextInsertRange :: Name -> Range -> Context -> Context
contextInsertRange n :: Name
n r :: Range
r (Context is :: Map Name Item
is ms :: Map Name Module
ms)
  = Map Name Item -> Map Name Module -> Context
Context ((Item -> Item) -> Name -> Map Name Item -> Map Name Item
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Range -> Item -> Item
itemInsertRange Range
r) Name
n Map Name Item
is) Map Name Module
ms

-- | Insert a range for all names in the given module, if present.
contextInsertRangeModule
  :: Name
  -> Range
  -> Context
  -> Context
contextInsertRangeModule :: Name -> Range -> Context -> Context
contextInsertRangeModule n :: Name
n r :: Range
r (Context is :: Map Name Item
is ms :: Map Name Module
ms)
  = Map Name Item -> Map Name Module -> Context
Context Map Name Item
is ((Module -> Module) -> Name -> Map Name Module -> Map Name Module
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Range -> Module -> Module
moduleInsertRangeAll Range
r) Name
n Map Name Module
ms)

moduleInsertRangeAll
  :: Range
  -> Module
  -> Module
moduleInsertRangeAll :: Range -> Module -> Module
moduleInsertRangeAll r :: Range
r (Module rs :: [Range]
rs c :: Context
c)
  = [Range] -> Context -> Module
Module (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
rs) (Range -> Context -> Context
contextInsertRangeAll Range
r Context
c)

accessModuleInsertRangeAll
  :: Range
  -> AccessModule
  -> AccessModule
accessModuleInsertRangeAll :: Range -> AccessModule -> AccessModule
accessModuleInsertRangeAll r :: Range
r (AccessModule a :: Access
a rs :: [Range]
rs c :: Context
c)
  = Access -> [Range] -> Context -> AccessModule
AccessModule Access
a (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [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 r :: Range
r (Context is :: Map Name Item
is ms :: 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 r :: Range
r (AccessContext is :: Map Name AccessItem
is ms :: Map Name AccessModule
ms js :: 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 n :: Name
n (Context is :: Map Name Item
is ms :: 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 n :: Name
n (Context is :: Map Name Item
is ms :: 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)

-- ### Rename

-- | Rename an item, if present.
contextRename
  :: Name
  -> Name
  -> Context
  -> Context
contextRename :: Name -> Name -> Context -> Context
contextRename n :: Name
n n' :: Name
n' (Context is :: Map Name Item
is ms :: Map Name Module
ms)
  = Map Name Item -> Map Name Module -> Context
Context (Name -> Name -> Map Name Item -> Map Name Item
forall k a. Ord k => k -> k -> Map k a -> Map k a
mapUpdateKey Name
n Name
n' Map Name Item
is) Map Name Module
ms

-- | Rename a module, if present.
contextRenameModule
  :: Name
  -> Name
  -> Context
  -> Context
contextRenameModule :: Name -> Name -> Context -> Context
contextRenameModule n :: Name
n n' :: Name
n' (Context is :: Map Name Item
is ms :: Map Name Module
ms)
  = Map Name Item -> Map Name Module -> Context
Context Map Name Item
is (Name -> Name -> Map Name Module -> Map Name Module
forall k a. Ord k => k -> k -> Map k a -> Map k a
mapUpdateKey Name
n Name
n' Map Name Module
ms)

-- ### Define

accessItemDefine
  :: AccessItem
  -> AccessItem
accessItemDefine :: AccessItem -> AccessItem
accessItemDefine (AccessItem _ a :: Access
a rs :: [Range]
rs s :: Maybe Name
s)
  = Bool -> Access -> [Range] -> Maybe Name -> AccessItem
AccessItem Bool
True Access
a [Range]
rs Maybe Name
s
accessItemDefine i :: AccessItem
i
  = AccessItem
i

-- | Mark an existing name as in process of being defined.
accessContextDefine
  :: Name
  -> AccessContext
  -> AccessContext
accessContextDefine :: Name -> AccessContext -> AccessContext
accessContextDefine n :: Name
n (AccessContext is :: Map Name AccessItem
is ms :: Map Name AccessModule
ms js :: 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

-- ### Ranges

itemRanges
  :: Item
  -> [Range]
itemRanges :: Item -> [Range]
itemRanges (ItemConstructor rs :: [Range]
rs _)
  = [Range]
rs
itemRanges (ItemPattern rs :: [Range]
rs _)
  = [Range]
rs
itemRanges (Item rs :: [Range]
rs _)
  = [Range]
rs

accessItemRanges
  :: AccessItem
  -> [Range]
accessItemRanges :: AccessItem -> [Range]
accessItemRanges
  = Item -> [Range]
itemRanges (Item -> [Range]) -> (AccessItem -> Item) -> AccessItem -> [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
  -> [Range]
moduleRanges :: Module -> [Range]
moduleRanges (Module rs :: [Range]
rs c :: Context
c)
  = [Range]
rs [Range] -> [Range] -> [Range]
forall a. Semigroup a => a -> a -> a
<> Context -> [Range]
contextRanges Context
c

-- | Get all ranges associated with names in the given context.
contextRanges
  :: Context
  -> [Range]
contextRanges :: Context -> [Range]
contextRanges (Context is :: Map Name Item
is ms :: Map Name Module
ms)
  = [[Range]] -> [Range]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Item -> [Range]
itemRanges (Item -> [Range]) -> [Item] -> [[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)
  [Range] -> [Range] -> [Range]
forall a. Semigroup a => a -> a -> a
<> [[Range]] -> [Range]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Module -> [Range]
moduleRanges (Module -> [Range]) -> [Module] -> [[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)

-- ### Match

-- | Find all operators matching the given list of tokens.
accessContextMatch
  :: [String]
  -> AccessContext
  -> [Name]
accessContextMatch :: [String] -> AccessContext -> [Name]
accessContextMatch ss :: [String]
ss (AccessContext is :: Map Name AccessItem
is _ _)
  = [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 an 'Item' representing an ordinary definition.
item
  :: [Range]
  -> Maybe Name
  -> Item
item :: [Range] -> Maybe Name -> Item
item
  = [Range] -> Maybe Name -> Item
Item

-- | Construct an 'Item' representing a pattern synonym.
itemPattern
  :: [Range]
  -> Maybe Name
  -> Item
itemPattern :: [Range] -> Maybe Name -> Item
itemPattern
  = [Range] -> Maybe Name -> Item
ItemPattern

-- | Construct an 'Item' representing a constructor.
itemConstructor
  :: [Range]
  -> Maybe Name
  -> Item
itemConstructor :: [Range] -> Maybe Name -> Item
itemConstructor rs :: [Range]
rs Nothing
  = [Range] -> [Name] -> Item
ItemConstructor [Range]
rs []
itemConstructor rs :: [Range]
rs (Just s :: Name
s)
  = [Range] -> [Name] -> Item
ItemConstructor [Range]
rs [Name
s]

-- | Construct a 'Context' with a single item.
contextItem
  :: Name
  -> Item
  -> Context
contextItem :: Name -> Item -> Context
contextItem n :: Name
n i :: 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 n :: Name
n m :: 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 item, along with the relevant
-- syntax item if applicable.
accessContextItem
  :: Name
  -> Access
  -> Item
  -> AccessContext
accessContextItem :: Name -> Access -> Item -> AccessContext
accessContextItem n :: Name
n a :: Access
a i :: 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 n :: Name
n m :: 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
  -> [Range]
  -> AccessContext
  -> AccessContext
accessContextModule' :: Name -> Access -> [Range] -> AccessContext -> AccessContext
accessContextModule' n :: Name
n a :: Access
a rs :: [Range]
rs c :: AccessContext
c
  = Name -> AccessModule -> AccessContext
accessContextModule Name
n (Access -> [Range] -> Context -> AccessModule
AccessModule Access
a [Range]
rs (AccessContext -> Context
toContext AccessContext
c))

-- | Construct an access context with a single import.
accessContextImport
  :: QName
  -> Context
  -> AccessContext
accessContextImport :: QName -> Context -> AccessContext
accessContextImport n :: QName
n c :: 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 Private (ItemConstructor rs :: [Range]
rs ss :: [Name]
ss)
  = [Range] -> [Range] -> [Name] -> [Name] -> AccessItem
AccessItemConstructor [Range]
rs [] [Name]
ss []
fromItem Public (ItemConstructor rs :: [Range]
rs ss :: [Name]
ss)
  = [Range] -> [Range] -> [Name] -> [Name] -> AccessItem
AccessItemConstructor [] [Range]
rs [] [Name]
ss
fromItem a :: Access
a (ItemPattern rs :: [Range]
rs s :: Maybe Name
s)
  = Access -> [Range] -> Maybe Name -> AccessItem
AccessItemPattern Access
a [Range]
rs Maybe Name
s
fromItem a :: Access
a (Item rs :: [Range]
rs s :: Maybe Name
s)
  = Bool -> Access -> [Range] -> Maybe Name -> AccessItem
AccessItem Bool
False Access
a [Range]
rs Maybe Name
s

fromItemSyntax
  :: Item
  -> [(Name, AccessItem)]
fromItemSyntax :: Item -> [(Name, AccessItem)]
fromItemSyntax (ItemConstructor rs :: [Range]
rs ss :: [Name]
ss)
  = (Name -> AccessItem -> (Name, AccessItem))
-> AccessItem -> Name -> (Name, AccessItem)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (Bool -> [Range] -> AccessItem
AccessItemSyntax Bool
True [Range]
rs) (Name -> (Name, AccessItem)) -> [Name] -> [(Name, AccessItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
ss
fromItemSyntax (ItemPattern rs :: [Range]
rs s :: Maybe Name
s)
  = (Name -> AccessItem -> (Name, AccessItem))
-> AccessItem -> Name -> (Name, AccessItem)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (Bool -> [Range] -> AccessItem
AccessItemSyntax Bool
True [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 rs :: [Range]
rs s :: Maybe Name
s)
  = (Name -> AccessItem -> (Name, AccessItem))
-> AccessItem -> Name -> (Name, AccessItem)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (Bool -> [Range] -> AccessItem
AccessItemSyntax Bool
False [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 _ rs :: [Range]
rs@(_ : _) _ ss :: [Name]
ss)
  = Item -> Maybe Item
forall a. a -> Maybe a
Just ([Range] -> [Name] -> Item
ItemConstructor [Range]
rs [Name]
ss)
toItem (AccessItemPattern Public rs :: [Range]
rs s :: Maybe Name
s)
  = Item -> Maybe Item
forall a. a -> Maybe a
Just ([Range] -> Maybe Name -> Item
ItemPattern [Range]
rs Maybe Name
s)
toItem (AccessItem _ Public rs :: [Range]
rs s :: Maybe Name
s)
  = Item -> Maybe Item
forall a. a -> Maybe a
Just ([Range] -> Maybe Name -> Item
Item [Range]
rs Maybe Name
s)
toItem _
  = Maybe Item
forall a. Maybe a
Nothing

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

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

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

toModule'
  :: AccessModule
  -> Module
toModule' :: AccessModule -> Module
toModule' (AccessModule _ rs :: [Range]
rs c :: Context
c)
  = [Range] -> Context -> Module
Module [Range]
rs Context
c

-- | Convert a 'Context' to 'AccessContext'. Give all items the given access.
fromContext
  :: Access
  -> Context
  -> AccessContext
fromContext :: Access -> Context -> AccessContext
fromContext a :: Access
a (Context is :: Map Name Item
is ms :: 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 is :: Map Name AccessItem
is ms :: Map Name AccessModule
ms _)
  = 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 is :: Map Name AccessItem
is ms :: Map Name AccessModule
ms _)
  = 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)