Scope.hs

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>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` "<Qux"
-- "Foo>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"
-- "<Bar"
-- >>> "Foo>Bar>Baz" `scopeRelToSib` "Foo>Qux>Abc"
-- "<Bar>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"
-- "<Baz"
-- >>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Qux"
-- "<Bar>Baz"
-- >>> "Foo>Bar" `scopeRelToParent` "Foo>Baz>Qux"
-- "<<Bar"
-- >>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Qux>Abc"
-- "<<Bar>Baz"
-- >>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Bar>Baz"
-- "<Baz" -- Special case - scope needs to be 'NonEmpty'
-- >>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Bar"
-- "Baz"
-- >>> "Foo>Bar>Baz" `scopeRelToParent` "Foo>Bar>Baz>Qux"
-- "<<Bar" -- Special case - scope needs to be 'NonEmpty'
scopeRelToParent :: AbsScope -> 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" "<Baz>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