module Hix.Component where 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, reldir, stripProperPrefix) import qualified Hix.Data.ComponentConfig import Hix.Data.ComponentConfig ( ComponentConfig, PackageConfig (PackageConfig), PackageName (PackageName), PackagesConfig, SourceDir (SourceDir), Target (Target), TargetOrDefault (DefaultTarget, ExplicitTarget, NoDefaultTarget), ) import Hix.Data.Error (Error (EnvError), pathText) import Hix.Monad (M, noteEnv, throwM) import qualified Hix.Options as Options import Hix.Options ( ComponentCoords, ComponentSpec (ComponentSpec), PackageSpec (PackageSpec), TargetSpec (TargetForComponent, TargetForFile), ) import Hix.Path (rootDir) data ResolvedPackage = ResolvedPackage Bool PackageConfig | NoPackage Text deriving stock (ResolvedPackage -> ResolvedPackage -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ResolvedPackage -> ResolvedPackage -> Bool $c/= :: ResolvedPackage -> ResolvedPackage -> Bool == :: ResolvedPackage -> ResolvedPackage -> Bool $c== :: ResolvedPackage -> ResolvedPackage -> Bool Eq, Int -> ResolvedPackage -> ShowS [ResolvedPackage] -> ShowS ResolvedPackage -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ResolvedPackage] -> ShowS $cshowList :: [ResolvedPackage] -> ShowS show :: ResolvedPackage -> String $cshow :: ResolvedPackage -> String showsPrec :: Int -> ResolvedPackage -> ShowS $cshowsPrec :: Int -> ResolvedPackage -> ShowS Show, forall x. Rep ResolvedPackage x -> ResolvedPackage forall x. ResolvedPackage -> Rep ResolvedPackage x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep ResolvedPackage x -> ResolvedPackage $cfrom :: forall x. ResolvedPackage -> Rep ResolvedPackage x Generic) 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) packageDefault :: PackagesConfig -> ResolvedPackage packageDefault :: PackagesConfig -> ResolvedPackage packageDefault = \case [(PackageName _, PackageConfig pkg)] -> Bool -> PackageConfig -> ResolvedPackage ResolvedPackage Bool False PackageConfig pkg PackagesConfig _ -> Text -> ResolvedPackage NoPackage Text "Project has more than one package, specify -p or -f." packageForSpec :: Path Abs Dir -> PackagesConfig -> PackageSpec -> M PackageConfig packageForSpec :: Path Abs Dir -> PackagesConfig -> PackageSpec -> M PackageConfig packageForSpec Path Abs Dir root PackagesConfig config = \case PackageSpec PackageName _ (Just (Abs Path Abs Dir dir)) -> do 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 packageForSpecOrDefault :: Path Abs Dir -> PackagesConfig -> Maybe PackageSpec -> M ResolvedPackage packageForSpecOrDefault :: Path Abs Dir -> PackagesConfig -> Maybe PackageSpec -> M ResolvedPackage packageForSpecOrDefault Path Abs Dir root PackagesConfig config = \case Just PackageSpec pkg -> Bool -> PackageConfig -> ResolvedPackage ResolvedPackage Bool True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Path Abs Dir -> PackagesConfig -> PackageSpec -> M PackageConfig packageForSpec Path Abs Dir root PackagesConfig config PackageSpec pkg Maybe PackageSpec Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure (PackagesConfig -> ResolvedPackage packageDefault PackagesConfig config) 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 undecidableComponentError :: PackageName -> Text undecidableComponentError :: PackageName -> Text undecidableComponentError PackageName pname = [exon|Please specify a component name or source dir with -c for the package '##{pname}'|] testComponent :: ComponentSpec testComponent :: ComponentSpec testComponent = ComponentName -> Maybe SourceDir -> ComponentSpec ComponentSpec ComponentName "test" (forall a. a -> Maybe a Just (Path Rel Dir -> SourceDir SourceDir [reldir|test|])) defaultComponent :: PackageConfig -> Either Text Target defaultComponent :: PackageConfig -> Either Text Target defaultComponent PackageConfig package = do ComponentConfig component <- forall l r. l -> Maybe r -> Either l r maybeToRight (PackageName -> Text undecidableComponentError PackageConfig package.name) (forall {k}. Ord k => Map k ComponentConfig -> Maybe ComponentConfig selectComponent 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 selectComponent :: Map k ComponentConfig -> Maybe ComponentConfig selectComponent [(k _, ComponentConfig comp)] = forall a. a -> Maybe a Just ComponentConfig comp selectComponent (forall k a. Map k a -> [a] Map.elems -> [ComponentConfig] comps) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find (ComponentSpec -> ComponentConfig -> Bool match ComponentSpec testComponent) [ComponentConfig] comps match :: ComponentSpec -> ComponentConfig -> Bool match = forall a b c. (a -> b -> c) -> b -> a -> c flip ComponentConfig -> ComponentSpec -> Bool matchComponent targetInPackage :: ResolvedPackage -> Maybe ComponentSpec -> M TargetOrDefault targetInPackage :: ResolvedPackage -> Maybe ComponentSpec -> M TargetOrDefault targetInPackage (ResolvedPackage Bool _ PackageConfig package) (Just ComponentSpec comp) = do ComponentConfig component <- forall a. Text -> Maybe a -> M a noteEnv (PackageName -> ComponentSpec -> Text componentError PackageConfig package.name ComponentSpec comp) (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 -> TargetOrDefault ExplicitTarget (Target {$sel:sourceDir:Target :: Maybe SourceDir sourceDir = forall a. Maybe a Nothing, PackageConfig ComponentConfig component :: ComponentConfig package :: PackageConfig $sel:component:Target :: ComponentConfig $sel:package:Target :: PackageConfig ..})) where match :: ComponentConfig -> Bool match ComponentConfig cand = ComponentConfig -> ComponentSpec -> Bool matchComponent ComponentConfig cand ComponentSpec comp targetInPackage (ResolvedPackage Bool True PackageConfig package) Maybe ComponentSpec Nothing = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (forall a. Error -> M a throwM forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Error EnvError) forall (f :: * -> *) a. Applicative f => a -> f a pure (Target -> TargetOrDefault ExplicitTarget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> PackageConfig -> Either Text Target defaultComponent PackageConfig package) targetInPackage (ResolvedPackage Bool False PackageConfig package) Maybe ComponentSpec Nothing = do forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> TargetOrDefault NoDefaultTarget) forall (f :: * -> *) a. Applicative f => a -> f a pure (Target -> TargetOrDefault DefaultTarget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> PackageConfig -> Either Text Target defaultComponent PackageConfig package) targetInPackage (NoPackage Text err) Maybe ComponentSpec _ = forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> TargetOrDefault NoDefaultTarget Text err) targetForComponent :: Path Abs Dir -> PackagesConfig -> ComponentCoords -> M TargetOrDefault targetForComponent :: Path Abs Dir -> PackagesConfig -> ComponentCoords -> M TargetOrDefault targetForComponent Path Abs Dir root PackagesConfig config ComponentCoords spec = do ResolvedPackage package <- Path Abs Dir -> PackagesConfig -> Maybe PackageSpec -> M ResolvedPackage packageForSpecOrDefault Path Abs Dir root PackagesConfig config ComponentCoords spec.package ResolvedPackage -> Maybe ComponentSpec -> M TargetOrDefault targetInPackage ResolvedPackage package ComponentCoords spec.component targetForFile :: Path Abs Dir -> PackagesConfig -> Path Abs File -> M Target targetForFile :: Path Abs Dir -> PackagesConfig -> Path Abs File -> M Target targetForFile Path Abs Dir root PackagesConfig config Path Abs File file = do 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" targetComponentIn :: Path Abs Dir -> PackagesConfig -> TargetSpec -> M TargetOrDefault targetComponentIn :: Path Abs Dir -> PackagesConfig -> TargetSpec -> M TargetOrDefault targetComponentIn Path Abs Dir root PackagesConfig config = \case TargetForComponent ComponentCoords spec -> Path Abs Dir -> PackagesConfig -> ComponentCoords -> M TargetOrDefault targetForComponent Path Abs Dir root PackagesConfig config ComponentCoords spec TargetForFile Path Abs File spec -> Target -> TargetOrDefault ExplicitTarget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Path Abs Dir -> PackagesConfig -> Path Abs File -> M Target targetForFile Path Abs Dir root PackagesConfig config Path Abs File spec targetComponent :: Maybe (Path Abs Dir) -> PackagesConfig -> TargetSpec -> M TargetOrDefault targetComponent :: Maybe (Path Abs Dir) -> PackagesConfig -> TargetSpec -> M TargetOrDefault targetComponent Maybe (Path Abs Dir) cliRoot PackagesConfig config TargetSpec spec = do Path Abs Dir root <- Maybe (Path Abs Dir) -> M (Path Abs Dir) rootDir Maybe (Path Abs Dir) cliRoot Path Abs Dir -> PackagesConfig -> TargetSpec -> M TargetOrDefault targetComponentIn Path Abs Dir root PackagesConfig config TargetSpec spec targetComponentOrError :: Maybe (Path Abs Dir) -> PackagesConfig -> TargetSpec -> M Target targetComponentOrError :: Maybe (Path Abs Dir) -> PackagesConfig -> TargetSpec -> M Target targetComponentOrError Maybe (Path Abs Dir) cliRoot PackagesConfig config TargetSpec spec = Maybe (Path Abs Dir) -> PackagesConfig -> TargetSpec -> M TargetOrDefault targetComponent Maybe (Path Abs Dir) cliRoot PackagesConfig config TargetSpec spec forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case ExplicitTarget Target t -> forall (f :: * -> *) a. Applicative f => a -> f a pure Target t DefaultTarget Target t -> forall (f :: * -> *) a. Applicative f => a -> f a pure Target t NoDefaultTarget Text err -> forall a. Error -> M a throwM (Text -> Error EnvError Text err)