module Hix.Component where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (throwE)
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),
  )
import Hix.Data.Error (Error (EnvError), pathText)
import Hix.Monad (M, noteEnv)
import qualified Hix.Options as Options
import Hix.Options (
  ComponentCoords,
  ComponentSpec (ComponentSpec),
  PackageSpec (PackageSpec),
  TargetSpec (TargetForComponent, TargetForFile),
  )
import Hix.Path (rootDir)

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 -> M PackageConfig
packageDefault :: PackagesConfig -> M PackageConfig
packageDefault = \case
  [(PackageName
_, PackageConfig
pkg)] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageConfig
pkg
  PackagesConfig
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> Error
EnvError 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 PackageConfig
packageForSpecOrDefault :: Path Abs Dir
-> PackagesConfig -> Maybe PackageSpec -> M PackageConfig
packageForSpecOrDefault Path Abs Dir
root PackagesConfig
config = \case
  Just PackageSpec
pkg -> Path Abs Dir -> PackagesConfig -> PackageSpec -> M PackageConfig
packageForSpec Path Abs Dir
root PackagesConfig
config PackageSpec
pkg
  Maybe PackageSpec
Nothing -> PackagesConfig -> M PackageConfig
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|]))

targetInPackage ::
  PackageConfig ->
  Maybe ComponentSpec ->
  M Target
targetInPackage :: PackageConfig -> Maybe ComponentSpec -> M Target
targetInPackage PackageConfig
package = \case
  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 {$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 ComponentConfig
cand = ComponentConfig -> ComponentSpec -> Bool
matchComponent ComponentConfig
cand ComponentSpec
comp
  Maybe ComponentSpec
Nothing -> do
    ComponentConfig
component <- forall a. Text -> Maybe a -> M a
noteEnv (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
component :: ComponentConfig
$sel:component:Target :: ComponentConfig
$sel:package:Target :: PackageConfig
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

targetForComponent ::
  Path Abs Dir ->
  PackagesConfig ->
  ComponentCoords ->
  M Target
targetForComponent :: Path Abs Dir -> PackagesConfig -> ComponentCoords -> M Target
targetForComponent Path Abs Dir
root PackagesConfig
config ComponentCoords
spec = do
  PackageConfig
package <- Path Abs Dir
-> PackagesConfig -> Maybe PackageSpec -> M PackageConfig
packageForSpecOrDefault Path Abs Dir
root PackagesConfig
config ComponentCoords
spec.package
  PackageConfig -> Maybe ComponentSpec -> M Target
targetInPackage PackageConfig
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 Target
targetComponentIn :: Path Abs Dir -> PackagesConfig -> TargetSpec -> M Target
targetComponentIn Path Abs Dir
root PackagesConfig
config = \case
  TargetForComponent ComponentCoords
spec ->
    Path Abs Dir -> PackagesConfig -> ComponentCoords -> M Target
targetForComponent Path Abs Dir
root PackagesConfig
config ComponentCoords
spec
  TargetForFile Path Abs File
spec ->
    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 Target
targetComponent :: Maybe (Path Abs Dir) -> PackagesConfig -> TargetSpec -> M Target
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 Target
targetComponentIn Path Abs Dir
root PackagesConfig
config TargetSpec
spec