module HsDev.Symbols.Class (
	Sourced(..),
	sourcedModuleName,

	module HsDev.Symbols.Location
	) where

import Control.Lens (Lens', Traversal')
import Data.Text (Text)

import HsDev.Symbols.Location

class Sourced a where
	sourcedName :: Lens' a Text
	sourcedDocs :: Traversal' a Text
	sourcedModule :: Lens' a ModuleId
	sourcedLocation :: Traversal' a Position
	sourcedDocs Text -> f Text
_ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
	sourcedLocation Position -> f Position
_ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Sourced ModuleId where
	sourcedName :: (Text -> f Text) -> ModuleId -> f ModuleId
sourcedName = (Text -> f Text) -> ModuleId -> f ModuleId
Lens' ModuleId Text
moduleName
	sourcedModule :: (ModuleId -> f ModuleId) -> ModuleId -> f ModuleId
sourcedModule = (ModuleId -> f ModuleId) -> ModuleId -> f ModuleId
forall a. a -> a
id

instance Sourced SymbolId where
	sourcedName :: (Text -> f Text) -> SymbolId -> f SymbolId
sourcedName = (Text -> f Text) -> SymbolId -> f SymbolId
Lens' SymbolId Text
symbolName
	sourcedModule :: (ModuleId -> f ModuleId) -> SymbolId -> f SymbolId
sourcedModule = (ModuleId -> f ModuleId) -> SymbolId -> f SymbolId
Lens' SymbolId ModuleId
symbolModule

sourcedModuleName :: Sourced a => Lens' a Text
sourcedModuleName :: Lens' a Text
sourcedModuleName = (ModuleId -> f ModuleId) -> a -> f a
forall a. Sourced a => Lens' a ModuleId
sourcedModule ((ModuleId -> f ModuleId) -> a -> f a)
-> ((Text -> f Text) -> ModuleId -> f ModuleId)
-> (Text -> f Text)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> ModuleId -> f ModuleId
forall a. Sourced a => Lens' a Text
sourcedName