{-# LANGUAGE FlexibleInstances #-} module HsDev.Symbols.HaskellNames ( ToEnvironment(..), fromSymbol, toSymbol ) where import Control.Lens (view) import Data.String import qualified Data.Map.Strict as M import qualified Data.Text as T (unpack) import qualified Language.Haskell.Exts as H import qualified Language.Haskell.Names as N import HsDev.Symbols.Types class ToEnvironment a where environment :: a -> N.Environment instance ToEnvironment Module where environment :: Module -> Environment environment Module m = ModuleName () -> [Symbol] -> Environment forall k a. k -> a -> Map k a M.singleton (() -> String -> ModuleName () forall l. l -> String -> ModuleName l H.ModuleName () (Text -> String T.unpack (Text -> String) -> Text -> String forall a b. (a -> b) -> a -> b $ Getting Text Module Text -> Module -> Text forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Text Module Text forall a. Sourced a => Lens' a Text sourcedName Module m)) ((Symbol -> Symbol) -> [Symbol] -> [Symbol] forall a b. (a -> b) -> [a] -> [b] map Symbol -> Symbol toSymbol ([Symbol] -> [Symbol]) -> [Symbol] -> [Symbol] forall a b. (a -> b) -> a -> b $ Getting [Symbol] Module [Symbol] -> Module -> [Symbol] forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting [Symbol] Module [Symbol] Lens' Module [Symbol] moduleExports Module m) instance ToEnvironment [Module] where environment :: [Module] -> Environment environment = [Environment] -> Environment forall (f :: * -> *) k a. (Foldable f, Ord k) => f (Map k a) -> Map k a M.unions ([Environment] -> Environment) -> ([Module] -> [Environment]) -> [Module] -> Environment forall b c a. (b -> c) -> (a -> b) -> a -> c . (Module -> Environment) -> [Module] -> [Environment] forall a b. (a -> b) -> [a] -> [b] map Module -> Environment forall a. ToEnvironment a => a -> Environment environment fromSymbol :: N.Symbol -> Symbol fromSymbol :: Symbol -> Symbol fromSymbol Symbol s = SymbolId -> Maybe Text -> Maybe Position -> SymbolInfo -> Symbol Symbol SymbolId sid Maybe Text forall a. Maybe a Nothing Maybe Position forall a. Maybe a Nothing SymbolInfo info where sid :: SymbolId sid = Text -> ModuleId -> SymbolId SymbolId (Name () -> Text fromName_ (Name () -> Text) -> Name () -> Text forall a b. (a -> b) -> a -> b $ Symbol -> Name () N.symbolName Symbol s) ModuleId mid mid :: ModuleId mid = case Symbol -> ModuleName () N.symbolModule Symbol s of H.ModuleName () _ String m -> Text -> ModuleLocation -> ModuleId ModuleId (String -> Text forall a. IsString a => String -> a fromString String m) ModuleLocation NoLocation info :: SymbolInfo info = case Symbol s of N.Value ModuleName () _ Name () _ -> Maybe Text -> SymbolInfo Function Maybe Text forall a. Monoid a => a mempty N.Method ModuleName () _ Name () _ Name () p -> Maybe Text -> Text -> SymbolInfo Method Maybe Text forall a. Monoid a => a mempty (Name () -> Text fromName_ Name () p) N.Selector ModuleName () _ Name () _ Name () p [Name ()] cs -> Maybe Text -> Text -> [Text] -> SymbolInfo Selector Maybe Text forall a. Monoid a => a mempty (Name () -> Text fromName_ Name () p) ((Name () -> Text) -> [Name ()] -> [Text] forall a b. (a -> b) -> [a] -> [b] map Name () -> Text fromName_ [Name ()] cs) N.Constructor ModuleName () _ Name () _ Name () p -> [Text] -> Text -> SymbolInfo Constructor [Text] forall a. Monoid a => a mempty (Name () -> Text fromName_ Name () p) N.Type ModuleName () _ Name () _ -> [Text] -> [Text] -> SymbolInfo Type [Text] forall a. Monoid a => a mempty [Text] forall a. Monoid a => a mempty N.NewType ModuleName () _ Name () _ -> [Text] -> [Text] -> SymbolInfo NewType [Text] forall a. Monoid a => a mempty [Text] forall a. Monoid a => a mempty N.Data ModuleName () _ Name () _ -> [Text] -> [Text] -> SymbolInfo Data [Text] forall a. Monoid a => a mempty [Text] forall a. Monoid a => a mempty N.Class ModuleName () _ Name () _ -> [Text] -> [Text] -> SymbolInfo Class [Text] forall a. Monoid a => a mempty [Text] forall a. Monoid a => a mempty N.TypeFam ModuleName () _ Name () _ Maybe (Name ()) a -> [Text] -> [Text] -> Maybe Text -> SymbolInfo TypeFam [Text] forall a. Monoid a => a mempty [Text] forall a. Monoid a => a mempty ((Name () -> Text) -> Maybe (Name ()) -> Maybe Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Name () -> Text fromName_ Maybe (Name ()) a) N.DataFam ModuleName () _ Name () _ Maybe (Name ()) a -> [Text] -> [Text] -> Maybe Text -> SymbolInfo DataFam [Text] forall a. Monoid a => a mempty [Text] forall a. Monoid a => a mempty ((Name () -> Text) -> Maybe (Name ()) -> Maybe Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Name () -> Text fromName_ Maybe (Name ()) a) N.PatternConstructor ModuleName () _ Name () _ Maybe (Name ()) p -> [Text] -> Maybe Text -> SymbolInfo PatConstructor [Text] forall a. Monoid a => a mempty ((Name () -> Text) -> Maybe (Name ()) -> Maybe Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Name () -> Text fromName_ Maybe (Name ()) p) N.PatternSelector ModuleName () _ Name () _ Maybe (Name ()) p Name () c -> Maybe Text -> Maybe Text -> Text -> SymbolInfo PatSelector Maybe Text forall a. Monoid a => a mempty ((Name () -> Text) -> Maybe (Name ()) -> Maybe Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Name () -> Text fromName_ Maybe (Name ()) p) (Name () -> Text fromName_ Name () c) toSymbol :: Symbol -> N.Symbol toSymbol :: Symbol -> Symbol toSymbol Symbol s = case Getting SymbolInfo Symbol SymbolInfo -> Symbol -> SymbolInfo forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting SymbolInfo Symbol SymbolInfo Lens' Symbol SymbolInfo symbolInfo Symbol s of Function Maybe Text _ -> ModuleName () -> Name () -> Symbol N.Value ModuleName () m Name () n Method Maybe Text _ Text p -> ModuleName () -> Name () -> Name () -> Symbol N.Method ModuleName () m Name () n (Text -> Name () toName_ Text p) Selector Maybe Text _ Text p [Text] cs -> ModuleName () -> Name () -> Name () -> [Name ()] -> Symbol N.Selector ModuleName () m Name () n (Text -> Name () toName_ Text p) ((Text -> Name ()) -> [Text] -> [Name ()] forall a b. (a -> b) -> [a] -> [b] map Text -> Name () toName_ [Text] cs) Constructor [Text] _ Text p -> ModuleName () -> Name () -> Name () -> Symbol N.Constructor ModuleName () m Name () n (Text -> Name () toName_ Text p) Type [Text] _ [Text] _ -> ModuleName () -> Name () -> Symbol N.Type ModuleName () m Name () n NewType [Text] _ [Text] _ -> ModuleName () -> Name () -> Symbol N.NewType ModuleName () m Name () n Data [Text] _ [Text] _ -> ModuleName () -> Name () -> Symbol N.Data ModuleName () m Name () n Class [Text] _ [Text] _ -> ModuleName () -> Name () -> Symbol N.Class ModuleName () m Name () n TypeFam [Text] _ [Text] _ Maybe Text a -> ModuleName () -> Name () -> Maybe (Name ()) -> Symbol N.TypeFam ModuleName () m Name () n ((Text -> Name ()) -> Maybe Text -> Maybe (Name ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Name () toName_ Maybe Text a) DataFam [Text] _ [Text] _ Maybe Text a -> ModuleName () -> Name () -> Maybe (Name ()) -> Symbol N.DataFam ModuleName () m Name () n ((Text -> Name ()) -> Maybe Text -> Maybe (Name ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Name () toName_ Maybe Text a) PatConstructor [Text] _ Maybe Text p -> ModuleName () -> Name () -> Maybe (Name ()) -> Symbol N.PatternConstructor ModuleName () m Name () n ((Text -> Name ()) -> Maybe Text -> Maybe (Name ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Name () toName_ Maybe Text p) PatSelector Maybe Text _ Maybe Text p Text c -> ModuleName () -> Name () -> Maybe (Name ()) -> Name () -> Symbol N.PatternSelector ModuleName () m Name () n ((Text -> Name ()) -> Maybe Text -> Maybe (Name ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Name () toName_ Maybe Text p) (Text -> Name () toName_ Text c) where m :: ModuleName () m = Text -> ModuleName () toModuleName_ (Text -> ModuleName ()) -> Text -> ModuleName () forall a b. (a -> b) -> a -> b $ Getting Text Symbol Text -> Symbol -> Text forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Text Symbol Text forall a. Sourced a => Lens' a Text sourcedModuleName Symbol s n :: Name () n = Text -> Name () toName_ (Text -> Name ()) -> Text -> Name () forall a b. (a -> b) -> a -> b $ Getting Text Symbol Text -> Symbol -> Text forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a view Getting Text Symbol Text forall a. Sourced a => Lens' a Text sourcedName Symbol s