{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Stack.Types.Project
  ( Project (..)
  ) where

import           Data.Aeson.Types ( ToJSON (..), (.=), object )
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Stack.Prelude
import           Stack.Types.Curator ( Curator )

-- | A project is a collection of packages. We can have multiple stack.yaml

-- files, but only one of them may contain project information.

data Project = Project
  { Project -> Maybe String
projectUserMsg :: !(Maybe String)
    -- ^ A warning message to display to the user when the auto generated

    -- config may have issues.

  , Project -> [RelFilePath]
projectPackages :: ![RelFilePath]
    -- ^ Packages which are actually part of the project (as opposed

    -- to dependencies).

  , Project -> [RawPackageLocation]
projectDependencies :: ![RawPackageLocation]
    -- ^ Dependencies defined within the stack.yaml file, to be applied on top

    -- of the snapshot.

  , Project -> Map PackageName (Map FlagName Bool)
projectFlags :: !(Map PackageName (Map FlagName Bool))
    -- ^ Flags to be applied on top of the snapshot flags.

  , Project -> RawSnapshotLocation
projectResolver :: !RawSnapshotLocation
    -- ^ How we resolve which @Snapshot@ to use

  , Project -> Maybe WantedCompiler
projectCompiler :: !(Maybe WantedCompiler)
    -- ^ Override the compiler in 'projectResolver'

  , Project -> [String]
projectExtraPackageDBs :: ![FilePath]
  , Project -> Maybe Curator
projectCurator :: !(Maybe Curator)
    -- ^ Extra configuration intended exclusively for usage by the curator tool.

    -- In other words, this is /not/ part of the documented and exposed Stack

    -- API. SUBJECT TO CHANGE.

  , Project -> Set PackageName
projectDropPackages :: !(Set PackageName)
    -- ^ Packages to drop from the 'projectResolver'.

  }
  deriving Int -> Project -> ShowS
[Project] -> ShowS
Project -> String
(Int -> Project -> ShowS)
-> (Project -> String) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Project -> ShowS
showsPrec :: Int -> Project -> ShowS
$cshow :: Project -> String
show :: Project -> String
$cshowList :: [Project] -> ShowS
showList :: [Project] -> ShowS
Show

instance ToJSON Project where
  -- Expanding the constructor fully to ensure we don't miss any fields.

  toJSON :: Project -> Value
toJSON (Project Maybe String
userMsg [RelFilePath]
packages [RawPackageLocation]
extraDeps Map PackageName (Map FlagName Bool)
flags RawSnapshotLocation
resolver Maybe WantedCompiler
mcompiler [String]
extraPackageDBs Maybe Curator
mcurator Set PackageName
drops) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Pair]
-> (WantedCompiler -> [Pair]) -> Maybe WantedCompiler -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\WantedCompiler
cv -> [Key
"compiler" Key -> WantedCompiler -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WantedCompiler
cv]) Maybe WantedCompiler
mcompiler
    , [Pair] -> (String -> [Pair]) -> Maybe String -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
msg -> [Key
"user-message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
msg]) Maybe String
userMsg
    , [ Key
"extra-package-dbs" Key -> [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [String]
extraPackageDBs | Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
extraPackageDBs) ]
    , [ Key
"extra-deps" Key -> [RawPackageLocation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [RawPackageLocation]
extraDeps | Bool -> Bool
not ([RawPackageLocation] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RawPackageLocation]
extraDeps) ]
    , [ Key
"flags" Key
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
-> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Map FlagName Bool -> Map (CabalString FlagName) Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
-> Map (CabalString PackageName) (Map (CabalString FlagName) Bool)
forall a b.
(a -> b)
-> Map (CabalString PackageName) a
-> Map (CabalString PackageName) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map FlagName Bool -> Map (CabalString FlagName) Bool
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap (Map PackageName (Map FlagName Bool)
-> Map (CabalString PackageName) (Map FlagName Bool)
forall a v. Map a v -> Map (CabalString a) v
toCabalStringMap Map PackageName (Map FlagName Bool)
flags)
      | Bool -> Bool
not (Map PackageName (Map FlagName Bool) -> Bool
forall k a. Map k a -> Bool
Map.null Map PackageName (Map FlagName Bool)
flags)
      ]
    , [Key
"packages" Key -> [RelFilePath] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [RelFilePath]
packages]
    , [Key
"resolver" Key -> RawSnapshotLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RawSnapshotLocation
resolver]
    , [Pair] -> (Curator -> [Pair]) -> Maybe Curator -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Curator
c -> [Key
"curator" Key -> Curator -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Curator
c]) Maybe Curator
mcurator
    , [ Key
"drop-packages" Key -> Set (CabalString PackageName) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (PackageName -> CabalString PackageName)
-> Set PackageName -> Set (CabalString PackageName)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PackageName -> CabalString PackageName
forall a. a -> CabalString a
CabalString Set PackageName
drops | Bool -> Bool
not (Set PackageName -> Bool
forall a. Set a -> Bool
Set.null Set PackageName
drops) ]
    ]