module Descript.Misc.Build.Read.File.Scope ( AbsScope (..) , RelScope (..) , baseScope , undefinedScope , anchorScopeSib , anchorScopeParent , scopeRelToSib , scopeRelToParent , globalizeRelScope , scopeFilepath ) where import Descript.Misc.Summary import Data.List import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NonEmpty import qualified Core.Data.List.NonEmpty as NonEmpty import System.FilePath import Core.System.FilePath -- | The name of the module\/file where an identifier is located. -- If the identifier is imported from another module, the imported -- reducers should automatically alter between the old and new module -- scopes. newtype AbsScope = AbsScope { absScopePath :: NonEmpty String -- ^ The path - \outermost element first\. } deriving (Eq, Ord, Read, Show) -- | The scope of a module\/file relative to another module\/file. data RelScope = RelScope { relScopePath :: NonEmpty String -- ^ Path elements prepended to the anchor path. , relScopeUps :: Int -- ^ Path elements removed from the head of the anchor path. } deriving (Eq, Ord, Read, Show) instance Summary AbsScope where summary (AbsScope path) = pathSummary path instance Summary RelScope where summary (RelScope path ups) = upsSummary ups ++ pathSummary path -- | The scope containing the most primitive imports, such as code -- blocks. baseScope :: AbsScope baseScope = AbsScope $ "Base" :| [] -- | The scope for unresolved symbols. undefinedScope :: AbsScope undefinedScope = AbsScope $ "{undefined}" :| [] -- | The given relative scope made absolute "relative to" the given -- sibling. -- The semantics are a bit confusing, also see -- 'anchorScopeParent', here are some examples: -- -- >>> "Foo>Bar>Baz" `anchorScopeSib` "Qux" -- "Foo>Bar>Qux" -- >>> "Foo>Bar>Baz" `anchorScopeSib` "Qux" -- >>> "Foo>Bar" `anchorScopeSib` "Baz>Qux" -- "Foo>Baz>Qux" anchorScopeSib :: AbsScope -> RelScope -> AbsScope anchorScopeSib (AbsScope basePath) (RelScope relPath relUps) = AbsScope { absScopePath = NonEmpty.dropEnd (relUps + 1) basePath NonEmpty.|+ relPath } -- | The given relative scope made absolute "relative to" the given -- parent. -- The semantics are a bit confusing, also see -- 'anchorScopeSib', here are some examples: -- -- >>> "Foo>Bar>Baz" `anchorScopeParent` "Qux" -- "Foo>Bar>Baz>Qux" -- >>> "Foo>Bar>Baz" `anchorScopeParent` "Bar>Qux" -- >>> "Foo>Bar" `anchorScopeParent` "Baz>Qux" -- "Foo>Bar>Baz>Qux" anchorScopeParent :: AbsScope -> RelScope -> AbsScope anchorScopeParent (AbsScope basePath) (RelScope relPath relUps) = AbsScope { absScopePath = NonEmpty.dropEnd relUps basePath NonEmpty.|+ relPath } -- | The first absolute scope made "relative to" the second scope -- (anchor), so that it's an immediate scope if the anchor is its -- sibling (e.g. in the same directory). -- The semantics are a bit confusing, also see 'scopeRelToParent', -- here are some examples: -- -- >>> "Foo>Bar>Baz" `scopeRelToSib` "Foo>Bar>Qux" -- "Baz" -- >>> "Foo>Bar>Baz" `scopeRelToSib` "Foo>Qux" -- "Bar>Baz" -- >>> "Foo>Bar" `scopeRelToSib` "Foo>Baz>Qux" -- ">> "Foo>Bar>Baz" `scopeRelToSib` "Foo>Qux>Abc" -- "Baz" -- >>> "Foo>Bar>Baz" `scopeRelToSib` "Foo>Bar>Baz" -- "Baz" -- >>> "Foo>Bar>Baz" `scopeRelToSib` "Foo>Bar" -- "Bar>Baz" -- >>> "Foo>Bar>Baz" `scopeRelToSib` "Foo>Bar>Baz>Qux" -- "" scopeRelToSib :: AbsScope -> AbsScope -> RelScope AbsScope tpath `scopeRelToSib` AbsScope apath = tpath `subpathRelTo` NonEmpty.init apath -- | The first absolute scope made "relative to" the second scope -- (anchor), so that it's an immediate scope if the anchor is its -- parent (e.g. in the parent directory, with the same name as the -- child directory). -- The semantics are a bit confusing, also see 'scopeRelToSib', here are -- some examples: -- -- >>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Bar>Qux" -- ">> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Qux" -- "Baz" -- >>> "Foo>Bar" `scopeRelToParent` "Foo>Baz>Qux" -- "<>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Qux>Abc" -- "<Baz" -- >>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Bar>Baz" -- ">> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Bar" -- "Baz" -- >>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Bar>Baz>Qux" -- "< AbsScope -> RelScope AbsScope tpath `scopeRelToParent` AbsScope apath = tpath `subpathRelTo` NonEmpty.toList apath -- | The first path relative to the second path as a parent. subpathRelTo :: NonEmpty String -> [String] -> RelScope xs `subpathRelTo` [] = RelScope { relScopePath = xs , relScopeUps = 0 } (x :| xs) `subpathRelTo` (y : ys) | x /= y || xs == [] = RelScope { relScopePath = x :| xs , relScopeUps = length $ y : ys } | otherwise = NonEmpty.fromList xs `subpathRelTo` ys -- | Gets rid of 'relScopeUps'. globalizeRelScope :: RelScope -> RelScope globalizeRelScope (RelScope path _) = RelScope path 0 -- | The path to get to the file/module at the scope, given the path to -- the base scope, used by the local dependency resolver. -- -- >>> scopeFilepath "foo/Bar" "Baz" -- foo/Bar/Baz.dscr -- >>> scopeFilepath "foo/Bar" "Qux" -- foo/Baz/Qux.dscr scopeFilepath :: FilePath -> RelScope -> FilePath scopeFilepath basePath (RelScope relPath relUps) = takeDirectoryN relUps basePath intercalate [pathSeparator] (NonEmpty.toList relPath) <.> "dscr" upsSummary :: Int -> String upsSummary ups = replicate ups '<' pathSummary :: NonEmpty String -> String pathSummary = intercalate ">" . NonEmpty.toList