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)