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