{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Distribution.Nixpkgs.Haskell.FromCabal.Configuration
  ( Configuration(..), readConfiguration, assertConsistency
  )
  where

import Prelude hiding ( fail )

import Control.DeepSeq
import Control.Exception ( throwIO )
import Control.Lens
import Control.Monad hiding ( fail )
import Control.Monad.Fail
import Data.Aeson
import Data.Map as Map
import Data.Set as Set
import Data.Text as T
import Data.Yaml
import Distribution.Compiler
import Distribution.Nixpkgs.Haskell.Constraint
import Distribution.Nixpkgs.Meta
import Distribution.Package
import Distribution.System
import GHC.Generics ( Generic )
import Language.Nix.Identifier

data Configuration = Configuration
  {
  -- |Target compiler. Used by 'finalizePackageDescription' to choose
  -- appropriate flags and dependencies.
    Configuration -> CompilerInfo
compilerInfo :: CompilerInfo

  -- |Compiler core packages that are also found on Hackage.
  , Configuration -> Set PackageIdentifier
corePackages :: Set PackageIdentifier

  -- |These packages replace the latest respective version during
  -- dependency resolution.
  , Configuration -> [Constraint]
defaultPackageOverrides :: [Constraint]

  -- |These packages are added to the generated set, but the play no
  -- role during dependency resolution.
  , Configuration -> [Constraint]
extraPackages :: [Constraint]

  -- |This information is used by the @hackage2nix@ utility to determine the
  -- 'maintainers' for a given Haskell package.
  , Configuration -> Map Identifier (Set PackageName)
packageMaintainers :: Map Identifier (Set PackageName)

  -- |These packages (necessarily) only support a certain list of platforms.
  , Configuration -> Map PackageName (Set NixpkgsPlatform)
supportedPlatforms :: Map PackageName (Set NixpkgsPlatform)

  -- |These packages (by design) don't support certain platforms.
  , Configuration -> Map PackageName (Set NixpkgsPlatform)
unsupportedPlatforms :: Map PackageName (Set NixpkgsPlatform)

  -- |These packages cannot be distributed by Hydra, i.e. because they have an
  -- unfree license or depend on other tools that cannot be distributed for
  -- some reason.
  , Configuration -> Set PackageName
dontDistributePackages :: Set PackageName

  -- |We know that these packages won't compile, so we mark them as broken and
  -- also disable their meta.hydraPlatforms attribute to avoid cluttering our
  -- Hydra job with lots of failure messages.
  , Configuration -> [Constraint]
brokenPackages :: [Constraint]
  }
  deriving (Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Configuration] -> ShowS
$cshowList :: [Configuration] -> ShowS
show :: Configuration -> String
$cshow :: Configuration -> String
showsPrec :: Int -> Configuration -> ShowS
$cshowsPrec :: Int -> Configuration -> ShowS
Show, forall x. Rep Configuration x -> Configuration
forall x. Configuration -> Rep Configuration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Configuration x -> Configuration
$cfrom :: forall x. Configuration -> Rep Configuration x
Generic)

instance NFData Configuration

instance Semigroup Configuration where
  Configuration
l <> :: Configuration -> Configuration -> Configuration
<> Configuration
r = Configuration { compilerInfo :: CompilerInfo
compilerInfo = Configuration -> CompilerInfo
compilerInfo Configuration
l
                         , corePackages :: Set PackageIdentifier
corePackages = Configuration -> Set PackageIdentifier
corePackages Configuration
l forall a. Semigroup a => a -> a -> a
<> Configuration -> Set PackageIdentifier
corePackages Configuration
r
                         , defaultPackageOverrides :: [Constraint]
defaultPackageOverrides = Configuration -> [Constraint]
defaultPackageOverrides Configuration
l forall a. Semigroup a => a -> a -> a
<> Configuration -> [Constraint]
defaultPackageOverrides Configuration
r
                         , extraPackages :: [Constraint]
extraPackages = Configuration -> [Constraint]
extraPackages Configuration
l forall a. Semigroup a => a -> a -> a
<> Configuration -> [Constraint]
extraPackages Configuration
r
                         , packageMaintainers :: Map Identifier (Set PackageName)
packageMaintainers = Configuration -> Map Identifier (Set PackageName)
packageMaintainers Configuration
l forall a. Semigroup a => a -> a -> a
<> Configuration -> Map Identifier (Set PackageName)
packageMaintainers Configuration
r
                         , supportedPlatforms :: Map PackageName (Set NixpkgsPlatform)
supportedPlatforms = Configuration -> Map PackageName (Set NixpkgsPlatform)
supportedPlatforms Configuration
l forall a. Semigroup a => a -> a -> a
<> Configuration -> Map PackageName (Set NixpkgsPlatform)
supportedPlatforms Configuration
r
                         , unsupportedPlatforms :: Map PackageName (Set NixpkgsPlatform)
unsupportedPlatforms = Configuration -> Map PackageName (Set NixpkgsPlatform)
unsupportedPlatforms Configuration
l forall a. Semigroup a => a -> a -> a
<> Configuration -> Map PackageName (Set NixpkgsPlatform)
unsupportedPlatforms Configuration
r
                         , dontDistributePackages :: Set PackageName
dontDistributePackages = Configuration -> Set PackageName
dontDistributePackages Configuration
l forall a. Semigroup a => a -> a -> a
<> Configuration -> Set PackageName
dontDistributePackages Configuration
r
                         , brokenPackages :: [Constraint]
brokenPackages = Configuration -> [Constraint]
brokenPackages Configuration
l forall a. Semigroup a => a -> a -> a
<> Configuration -> [Constraint]
brokenPackages Configuration
r
                         }

instance FromJSON Configuration where
  parseJSON :: Value -> Parser Configuration
parseJSON (Object Object
o) = CompilerInfo
-> Set PackageIdentifier
-> [Constraint]
-> [Constraint]
-> Map Identifier (Set PackageName)
-> Map PackageName (Set NixpkgsPlatform)
-> Map PackageName (Set NixpkgsPlatform)
-> Set PackageName
-> [Constraint]
-> Configuration
Configuration
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"compiler" forall a. Parser (Maybe a) -> a -> Parser a
.!= CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo CompilerId
buildCompilerId AbiTag
NoAbiTag
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"core-packages" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default-package-overrides" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extra-packages" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"package-maintainers" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"supported-platforms" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unsupported-platforms" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dont-distribute-packages" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"broken-packages" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
  parseJSON Value
_ = forall a. HasCallStack => String -> a
error String
"invalid Configuration"

instance FromJSON Identifier where
  parseJSON :: Value -> Parser Identifier
parseJSON (String Text
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' Identifier String
ident (Text -> String
T.unpack Text
s))
  parseJSON Value
s = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"parseJSON: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
s forall a. [a] -> [a] -> [a]
++ String
" is not a valid Nix identifier")

instance FromJSONKey Identifier where
  fromJSONKey :: FromJSONKeyFunction Identifier
fromJSONKey = forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText forall k. FromJSON k => Text -> k
parseKey

instance FromJSONKey PackageName where
  fromJSONKey :: FromJSONKeyFunction PackageName
fromJSONKey = forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText forall k. FromJSON k => Text -> k
parseKey

parseKey :: FromJSON k => Text -> k
parseKey :: forall k. FromJSON k => Text -> k
parseKey Text
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id (forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
s))

readConfiguration :: FilePath -> IO Configuration
readConfiguration :: String -> IO Configuration
readConfiguration String
path = forall a. FromJSON a => String -> IO (Either ParseException a)
decodeFileEither String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *).
MonadFail m =>
Configuration -> m Configuration
assertConsistency

assertConsistency :: MonadFail m => Configuration -> m Configuration
assertConsistency :: forall (m :: * -> *).
MonadFail m =>
Configuration -> m Configuration
assertConsistency cfg :: Configuration
cfg@Configuration {[Constraint]
CompilerInfo
Set PackageIdentifier
Set PackageName
Map PackageName (Set NixpkgsPlatform)
Map Identifier (Set PackageName)
brokenPackages :: [Constraint]
dontDistributePackages :: Set PackageName
unsupportedPlatforms :: Map PackageName (Set NixpkgsPlatform)
supportedPlatforms :: Map PackageName (Set NixpkgsPlatform)
packageMaintainers :: Map Identifier (Set PackageName)
extraPackages :: [Constraint]
defaultPackageOverrides :: [Constraint]
corePackages :: Set PackageIdentifier
compilerInfo :: CompilerInfo
brokenPackages :: Configuration -> [Constraint]
dontDistributePackages :: Configuration -> Set PackageName
unsupportedPlatforms :: Configuration -> Map PackageName (Set NixpkgsPlatform)
supportedPlatforms :: Configuration -> Map PackageName (Set NixpkgsPlatform)
packageMaintainers :: Configuration -> Map Identifier (Set PackageName)
extraPackages :: Configuration -> [Constraint]
defaultPackageOverrides :: Configuration -> [Constraint]
corePackages :: Configuration -> Set PackageIdentifier
compilerInfo :: Configuration -> CompilerInfo
..} = do
  let report :: String -> m a
report String
msg = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"*** configuration error: " forall a. [a] -> [a] -> [a]
++ String
msg)
      maintainedPackages :: Set PackageName
maintainedPackages = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (forall k a. Map k a -> [a]
Map.elems Map Identifier (Set PackageName)
packageMaintainers)
      disabledPackages :: Set PackageName
disabledPackages = Set PackageName
dontDistributePackages forall a. Ord a => Set a -> Set a -> Set a
`Set.union` forall a. Ord a => [a] -> Set a
Set.fromList (Constraint -> PackageName
constraintPkgName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Constraint]
brokenPackages)
      disabledMaintainedPackages :: Set PackageName
disabledMaintainedPackages = Set PackageName
maintainedPackages forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set PackageName
disabledPackages
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Set a -> Bool
Set.null Set PackageName
disabledMaintainedPackages) forall a b. (a -> b) -> a -> b
$
    forall {m :: * -> *} {a}. MonadFail m => String -> m a
report (String
"disabled packages that have a maintainer: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Set PackageName
disabledMaintainedPackages)

  forall (m :: * -> *) a. Monad m => a -> m a
return Configuration
cfg