module Hix.Component where import Control.Monad.Trans.Reader (ask) import Data.List.Extra (firstJust) import qualified Data.Map.Strict as Map import Data.Map.Strict ((!?)) import qualified Data.Text as Text import Exon (exon) import Path (Abs, Dir, File, Path, Rel, SomeBase (Abs, Rel), isProperPrefixOf, stripProperPrefix) import Hix.Data.Error (pathText) import qualified Hix.Data.GhciConfig as GhciConfig import Hix.Data.GhciConfig ( ComponentConfig, PackageConfig (PackageConfig), PackageName (PackageName), PackagesConfig, SourceDir (SourceDir), Target (Target), ) import qualified Hix.Monad as Monad import Hix.Monad (Env (Env), M, noteEnv) import qualified Hix.Options as Options import Hix.Options ( ComponentCoords, ComponentSpec (ComponentSpec), PackageSpec (PackageSpec), TargetSpec (TargetForComponent, TargetForFile), ) tryPackageByDir :: PackagesConfig -> Path Rel Dir -> Maybe PackageConfig tryPackageByDir :: PackagesConfig -> Path Rel Dir -> Maybe PackageConfig tryPackageByDir PackagesConfig config Path Rel Dir dir = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find PackageConfig -> Bool match (forall k a. Map k a -> [a] Map.elems PackagesConfig config) where match :: PackageConfig -> Bool match PackageConfig pkg = PackageConfig pkg.src forall a. Eq a => a -> a -> Bool == Path Rel Dir dir packageByDir :: PackagesConfig -> Path Rel Dir -> M PackageConfig packageByDir :: PackagesConfig -> Path Rel Dir -> M PackageConfig packageByDir PackagesConfig config Path Rel Dir dir = forall a. Text -> Maybe a -> M a noteEnv [exon|No package at this directory: #{pathText dir}|] (PackagesConfig -> Path Rel Dir -> Maybe PackageConfig tryPackageByDir PackagesConfig config Path Rel Dir dir) packageForSpec :: PackagesConfig -> PackageSpec -> M PackageConfig packageForSpec :: PackagesConfig -> PackageSpec -> M PackageConfig packageForSpec PackagesConfig config = \case PackageSpec PackageName _ (Just (Abs Path Abs Dir dir)) -> do Env {Path Abs Dir $sel:root:Env :: Env -> Path Abs Dir root :: Path Abs Dir root} <- forall (m :: * -> *) r. Monad m => ReaderT r m r ask Path Rel Dir rel <- forall a. Text -> Maybe a -> M a noteEnv [exon|Path is not a subdirectory of the project root: #{pathText dir}|] (forall (m :: * -> *) b t. MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) stripProperPrefix Path Abs Dir root Path Abs Dir dir) PackagesConfig -> Path Rel Dir -> M PackageConfig packageByDir PackagesConfig config Path Rel Dir rel PackageSpec (PackageName Text name) (Just (Rel Path Rel Dir dir)) | Char -> Text -> Bool Text.elem Char '/' Text name -> PackagesConfig -> Path Rel Dir -> M PackageConfig packageByDir PackagesConfig config Path Rel Dir dir PackageSpec PackageName name Maybe (SomeBase Dir) dir -> forall a. Text -> Maybe a -> M a noteEnv [exon|No package matching '##{name}'|] (PackagesConfig config forall k a. Ord k => Map k a -> k -> Maybe a !? PackageName name forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (SomeBase Dir -> Maybe PackageConfig tryDir forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Maybe (SomeBase Dir) dir)) where tryDir :: SomeBase Dir -> Maybe PackageConfig tryDir = \case Abs Path Abs Dir _ -> forall a. Maybe a Nothing Rel Path Rel Dir rd -> PackagesConfig -> Path Rel Dir -> Maybe PackageConfig tryPackageByDir PackagesConfig config Path Rel Dir rd matchComponent :: ComponentConfig -> ComponentSpec -> Bool matchComponent :: ComponentConfig -> ComponentSpec -> Bool matchComponent ComponentConfig candidate (ComponentSpec ComponentName name Maybe SourceDir dir) = ComponentConfig candidate.name forall a. Eq a => a -> a -> Bool == ComponentName name Bool -> Bool -> Bool || forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (\ SourceDir d -> forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool elem @[] SourceDir d (coerce :: forall a b. Coercible a b => a -> b coerce ComponentConfig candidate.sourceDirs)) Maybe SourceDir dir componentError :: PackageName -> ComponentSpec -> Text componentError :: PackageName -> ComponentSpec -> Text componentError PackageName pname ComponentSpec spec = [exon|No component with name or source dir '##{name}' in the package '##{pname}'|] where name :: ComponentName name = ComponentSpec spec.name targetForComponent :: PackagesConfig -> ComponentCoords -> M Target targetForComponent :: PackagesConfig -> ComponentCoords -> M Target targetForComponent PackagesConfig config ComponentCoords spec = do PackageConfig package <- PackagesConfig -> PackageSpec -> M PackageConfig packageForSpec PackagesConfig config ComponentCoords spec.package ComponentConfig component <- forall a. Text -> Maybe a -> M a noteEnv (PackageName -> ComponentSpec -> Text componentError PackageConfig package.name ComponentCoords spec.component) (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find ComponentConfig -> Bool match (forall k a. Map k a -> [a] Map.elems PackageConfig package.components)) pure Target {$sel:sourceDir:Target :: Maybe SourceDir sourceDir = forall a. Maybe a Nothing, PackageConfig ComponentConfig $sel:component:Target :: ComponentConfig $sel:package:Target :: PackageConfig component :: ComponentConfig package :: PackageConfig ..} where match :: ComponentConfig -> Bool match = forall a b c. (a -> b -> c) -> b -> a -> c flip ComponentConfig -> ComponentSpec -> Bool matchComponent ComponentCoords spec.component targetForFile :: PackagesConfig -> Path Abs File -> M Target targetForFile :: PackagesConfig -> Path Abs File -> M Target targetForFile PackagesConfig config Path Abs File file = do Env {Path Abs Dir root :: Path Abs Dir $sel:root:Env :: Env -> Path Abs Dir root} <- forall (m :: * -> *) r. Monad m => ReaderT r m r ask Path Rel File fileRel <- forall (m :: * -> *) b t. MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) stripProperPrefix Path Abs Dir root Path Abs File file (PackageConfig package, Path Rel File subpath) <- forall {a}. Maybe a -> M a pkgError (forall a b. (a -> Maybe b) -> [a] -> Maybe b firstJust (forall {f :: * -> *} {t}. MonadThrow f => Path Rel t -> PackageConfig -> f (PackageConfig, Path Rel t) matchPackage Path Rel File fileRel) (forall k a. Map k a -> [a] Map.elems PackagesConfig config)) (ComponentConfig component, Maybe SourceDir sourceDir) <- forall {a}. Maybe a -> M a compError (forall a b. (a -> Maybe b) -> [a] -> Maybe b firstJust (forall {a} {a} {t}. (Coercible a [SourceDir], HasField "sourceDirs" a a) => Path Rel t -> a -> Maybe (a, Maybe SourceDir) matchSourceDir Path Rel File subpath) (forall k a. Map k a -> [a] Map.elems PackageConfig package.components)) forall (f :: * -> *) a. Applicative f => a -> f a pure Target {Maybe SourceDir PackageConfig ComponentConfig sourceDir :: Maybe SourceDir component :: ComponentConfig package :: PackageConfig $sel:component:Target :: ComponentConfig $sel:package:Target :: PackageConfig $sel:sourceDir:Target :: Maybe SourceDir ..} where matchPackage :: Path Rel t -> PackageConfig -> f (PackageConfig, Path Rel t) matchPackage Path Rel t fileRel package :: PackageConfig package@PackageConfig {Path Rel Dir $sel:src:PackageConfig :: PackageConfig -> Path Rel Dir src :: Path Rel Dir src} = do Path Rel t subpath <- forall (m :: * -> *) b t. MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) stripProperPrefix Path Rel Dir src Path Rel t fileRel pure (PackageConfig package, Path Rel t subpath) matchSourceDir :: Path Rel t -> a -> Maybe (a, Maybe SourceDir) matchSourceDir Path Rel t subpath a component = do let match :: SourceDir -> Maybe SourceDir match d :: SourceDir d@(SourceDir Path Rel Dir dir) = if forall b t. Path b Dir -> Path b t -> Bool isProperPrefixOf Path Rel Dir dir Path Rel t subpath then forall a. a -> Maybe a Just SourceDir d else forall a. Maybe a Nothing SourceDir dir <- forall a b. (a -> Maybe b) -> [a] -> Maybe b firstJust SourceDir -> Maybe SourceDir match (coerce :: forall a b. Coercible a b => a -> b coerce a component.sourceDirs) pure (a component, forall a. a -> Maybe a Just SourceDir dir) pkgError :: Maybe a -> M a pkgError = forall a. Text -> Maybe a -> M a noteEnv Text "No package contains this file" compError :: Maybe a -> M a compError = forall a. Text -> Maybe a -> M a noteEnv Text "No component source dir contains this file" targetComponent :: PackagesConfig -> TargetSpec -> M Target targetComponent :: PackagesConfig -> TargetSpec -> M Target targetComponent PackagesConfig config = \case TargetForComponent ComponentCoords spec -> PackagesConfig -> ComponentCoords -> M Target targetForComponent PackagesConfig config ComponentCoords spec TargetForFile Path Abs File spec -> PackagesConfig -> Path Abs File -> M Target targetForFile PackagesConfig config Path Abs File spec