{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Domain.Config
  ( Config (..),
    getRule,
    defaultScripts,
  )
where

import Control.Monad.Except (MonadError)
import Data.Aeson (FromJSON (..), ToJSON (toJSON), genericParseJSON, genericToJSON)
import qualified Data.Map as Map
import HWM.Core.Common (Check (..), Name)
import HWM.Core.Has (Has)
import HWM.Core.Pkg
import HWM.Core.Result (Issue)
import HWM.Core.Version (Version)
import HWM.Domain.Bounds (Bounds)
import HWM.Domain.Dependencies (Dependencies, getBounds)
import HWM.Domain.Matrix (Matrix (..))
import HWM.Domain.Workspace (PkgRegistry, WorkspaceGroup)
import HWM.Runtime.Cache (Cache)
import HWM.Runtime.Files (aesonYAMLOptions)
import Relude

data Config = Config
  { Config -> Name
name :: Name,
    Config -> Version
version :: Version,
    Config -> Bounds
bounds :: Bounds,
    Config -> [WorkspaceGroup]
workspace :: [WorkspaceGroup],
    Config -> Matrix
matrix :: Matrix,
    Config -> Dependencies
registry :: Dependencies,
    Config -> Map Name Name
scripts :: Map Name Text
  }
  deriving
    ( (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Config -> Rep Config x
from :: forall x. Config -> Rep Config x
$cto :: forall x. Rep Config x -> Config
to :: forall x. Rep Config x -> Config
Generic,
      Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show
    )

getRule :: (MonadError Issue m) => PkgName -> PkgRegistry -> Config -> m Bounds
getRule :: forall (m :: * -> *).
MonadError Issue m =>
PkgName -> PkgRegistry -> Config -> m Bounds
getRule PkgName
depName PkgRegistry
ps Config {[WorkspaceGroup]
Map Name Name
Name
Version
Bounds
Dependencies
Matrix
name :: Config -> Name
version :: Config -> Version
bounds :: Config -> Bounds
workspace :: Config -> [WorkspaceGroup]
matrix :: Config -> Matrix
registry :: Config -> Dependencies
scripts :: Config -> Map Name Name
name :: Name
version :: Version
bounds :: Bounds
workspace :: [WorkspaceGroup]
matrix :: Matrix
registry :: Dependencies
scripts :: Map Name Name
..}
  | PkgName -> PkgRegistry -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member PkgName
depName PkgRegistry
ps = Bounds -> m Bounds
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bounds
bounds
  | Bool
otherwise = PkgName -> Dependencies -> m Bounds
forall (m :: * -> *).
MonadError Issue m =>
PkgName -> Dependencies -> m Bounds
getBounds PkgName
depName Dependencies
registry

instance FromJSON Config where
  parseJSON :: Value -> Parser Config
parseJSON = Options -> Value -> Parser Config
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonYAMLOptions

instance ToJSON Config where
  toJSON :: Config -> Value
toJSON = Options -> Config -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonYAMLOptions

instance
  ( MonadError Issue m,
    MonadReader env m,
    Has env Cache,
    Has env [WorkspaceGroup],
    Has env Matrix,
    MonadIO m
  ) =>
  Check m Config
  where
  check :: Config -> m ()
check Config {[WorkspaceGroup]
Map Name Name
Name
Version
Bounds
Dependencies
Matrix
name :: Config -> Name
version :: Config -> Version
bounds :: Config -> Bounds
workspace :: Config -> [WorkspaceGroup]
matrix :: Config -> Matrix
registry :: Config -> Dependencies
scripts :: Config -> Map Name Name
name :: Name
version :: Version
bounds :: Bounds
workspace :: [WorkspaceGroup]
matrix :: Matrix
registry :: Dependencies
scripts :: Map Name Name
..} = Matrix -> m ()
forall (m :: * -> *) a. Check m a => a -> m ()
check Matrix
matrix

defaultScripts :: Map Name Text
defaultScripts :: Map Name Name
defaultScripts =
  [(Name, Name)] -> Map Name Name
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Name
"build", Name
"stack build --fast"),
      (Name
"test", Name
"stack test {TARGET} --fast"),
      (Name
"install", Name
"stack install"),
      (Name
"lint", Name
"curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s ."),
      (Name
"clean", Name
"find . -name \"*.cabal\" -exec rm -rf {} \\; && stack clean")
    ]