Hie.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Integrations.Toolchain.Hie
  ( syncHie,
  )
where

import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object)
import qualified Data.Map as M
import HWM.Core.Common (Name)
import HWM.Core.Formatting (Format (..))
import HWM.Core.Options (Options (..), askOptions)
import HWM.Core.Pkg (Pkg (..), PkgName, pkgFile, pkgYamlPath)
import HWM.Domain.ConfigT (ConfigT, askPackages)
import HWM.Integrations.Toolchain.Lib (Libraries, Library (..))
import HWM.Integrations.Toolchain.Package (Package (..))
import HWM.Runtime.Files (readYaml, rewrite_)
import Relude

data Component = Component
  { path :: FilePath,
    component :: Name
  }
  deriving
    ( ToJSON,
      FromJSON,
      Generic,
      Show
    )

data Components = Components
  { stackYaml :: FilePath,
    components :: [Component]
  }
  deriving
    ( ToJSON,
      FromJSON,
      Generic,
      Show
    )

packHie :: Components -> Value
packHie value = object [("cradle", object [("stack", toJSON value)])]

(<:>) :: (Semigroup a, IsString a) => a -> a -> a
(<:>) name tag = name <> ":" <> tag

genComponents :: Pkg -> ConfigT [Component]
genComponents path = do
  Package {..} <- readYaml (pkgYamlPath path)
  pure
    $ comp name "lib" library
    <> compGroup name "test" tests
    <> compGroup name "exe" executables
    <> compGroup name "bench" benchmarks
  where
    compGroup :: PkgName -> Text -> Maybe Libraries -> [Component]
    compGroup name tag = concatMap mkComp . concatMap M.toList . maybeToList
      where
        mkComp (k, lib) = comp name (tag <:> k) (Just lib)
    comp :: PkgName -> Text -> Maybe Library -> [Component]
    comp name tag (Just Library {sourceDirs}) =
      [ Component
          { path = "./" <> pkgFile path (toString sourceDirs),
            component = format name <:> tag
          }
      ]
    comp _ _ _ = []

syncHie :: ConfigT ()
syncHie = do
  Options {..} <- askOptions
  components <- concat <$> (askPackages >>= traverse genComponents)
  rewrite_ hie (const $ pure $ packHie Components {stackYaml = stack, components})