module Agda.Unused.Types.Context
(
Item
, Module(Module)
, AccessModule(AccessModule)
, Context
, AccessContext
, accessContextUnion
, LookupError(..)
, contextLookup
, contextLookupItem
, contextLookupModule
, accessContextLookup
, accessContextLookupModule
, accessContextLookupDefining
, accessContextLookupSpecial
, contextInsertRange
, contextInsertRangeModule
, contextInsertRangeAll
, accessContextInsertRangeAll
, contextDelete
, contextDeleteModule
, contextRename
, contextRenameModule
, accessContextDefine
, moduleRanges
, contextRanges
, accessContextMatch
, item
, itemPattern
, itemConstructor
, contextItem
, contextModule
, accessContextItem
, accessContextModule
, accessContextModule'
, accessContextImport
, 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)
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
data AccessItem where
AccessItemConstructor
:: ![Range]
-> ![Range]
-> ![Name]
-> ![Name]
-> AccessItem
AccessItemPattern
:: !Access
-> ![Range]
-> !(Maybe Name)
-> AccessItem
AccessItemSyntax
:: !Bool
-> ![Range]
-> AccessItem
AccessItem
:: !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
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
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
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
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
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
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)
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
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
accessModuleUnion
:: AccessModule
-> AccessModule
-> AccessModule
accessModuleUnion :: AccessModule -> AccessModule -> AccessModule
accessModuleUnion m1 :: AccessModule
m1@(AccessModule Public _ _) (AccessModule Private _ _)
= AccessModule
m1
accessModuleUnion _ m2 :: AccessModule
m2
= AccessModule
m2
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
}
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 [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
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
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
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
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
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
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)
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
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
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)
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)
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
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
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)
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
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)
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
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
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'
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
contextRanges
:: Context
-> [Range]
(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)
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)
item
:: [Range]
-> Maybe Name
-> Item
item :: [Range] -> Maybe Name -> Item
item
= [Range] -> Maybe Name -> Item
Item
itemPattern
:: [Range]
-> Maybe Name
-> Item
itemPattern :: [Range] -> Maybe Name -> Item
itemPattern
= [Range] -> Maybe Name -> Item
ItemPattern
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]
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
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)
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)
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
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))
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)
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
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
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)
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)