{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}

{- |
   A representation of the @meta@ section used in Nix expressions. A
   detailed description can be found in section 4, \"Meta-attributes\",
   of the Nixpkgs manual at <http://nixos.org/nixpkgs/docs.html>.
 -}

module Distribution.Nixpkgs.Meta
  ( -- * Representation of the Nixpkgs Meta Set
    Meta, nullMeta
    -- ** Lenses for 'Meta'
  , homepage, description, license, platforms, badPlatforms, hydraPlatforms, mainProgram, maintainers, broken
    -- * Representation of Nixpkgs Platform Descriptions
  , NixpkgsPlatform (..)
  , nixpkgsPlatformFromString
  ) where

-- Avoid name clash with Prelude.<> exported by post-SMP versions of base.
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ( (<>) )
#endif
import Control.Applicative ( (<|>) )
import Control.DeepSeq
import Control.Lens hiding ( Strict )
import Data.List ( stripPrefix )
import Data.Set ( Set )
import qualified Data.Set as Set
import Distribution.Nixpkgs.License
import qualified Distribution.Pretty as CabalPretty
import Distribution.System
import GHC.Generics ( Generic )
import Language.Nix.Identifier
import Language.Nix.Path ( path )
import Language.Nix.PrettyPrinting

-- | Representation of platform(s) as supported by nixpkgs:
--
--     * 'NixpkgsPlatformGroup' represents the name of a platform
--       list as found in @lib.platforms@. For example, at the
--       time of writing @NixpkgsPlatformGroup "darwin"@ would
--       represent the platform tuples @x86_64-darwin@, @aarch64-darwin@,
--       @i686-darwin@ and @armv7a-darwin@. Naturally, this is
--       subject to change as nixpkgs updates @lib.platforms@.
--     * 'NixpkgsPlatformSingle' indicates a single platform tuple
--       represented using Cabal's 'Platform'.
--
--   The former is useful to express related groups of
--   platforms which have similar properties. The latter
--   can be used to, for example, exclude a single, specific
--   platform.
--
--   @hackage2nix@ has used the latter approach historically
--   and is being extended to support nixpkgs' platform
--   groups as well for increased maintainer convenience.
--
--   The 'Pretty' instance allows for converting a 'NixpkgsPlatform'
--   into a Nix expression compatible with @meta.platforms@:
--
--   >>> pPrint $ NixpkgsPlatformSingle $ Platform X86_64 NetBSD
--   "x86_64-netbsd"
--
--   For 'NixpkgsPlatformGroup' we assume that the @lib@ attribute set is in
--   scope:
--
--   >>> pPrint $ NixpkgsPlatformGroup $ ident # "riscv"
--   lib.platforms.riscv
data NixpkgsPlatform
  = NixpkgsPlatformSingle Platform
  -- ^ Single platform represented as a Cabal platform. Can be understood as
  -- equivalent to Nix's system strings and will be converted to one usually.
  | NixpkgsPlatformGroup Identifier
  -- ^ 'Identifier' of the attribute name of a platform
  --   group in nixpkgs' @lib.platforms@.
  deriving (Int -> NixpkgsPlatform -> ShowS
[NixpkgsPlatform] -> ShowS
NixpkgsPlatform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixpkgsPlatform] -> ShowS
$cshowList :: [NixpkgsPlatform] -> ShowS
show :: NixpkgsPlatform -> String
$cshow :: NixpkgsPlatform -> String
showsPrec :: Int -> NixpkgsPlatform -> ShowS
$cshowsPrec :: Int -> NixpkgsPlatform -> ShowS
Show, NixpkgsPlatform -> NixpkgsPlatform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
$c/= :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
== :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
$c== :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
Eq, Eq NixpkgsPlatform
NixpkgsPlatform -> NixpkgsPlatform -> Bool
NixpkgsPlatform -> NixpkgsPlatform -> Ordering
NixpkgsPlatform -> NixpkgsPlatform -> NixpkgsPlatform
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NixpkgsPlatform -> NixpkgsPlatform -> NixpkgsPlatform
$cmin :: NixpkgsPlatform -> NixpkgsPlatform -> NixpkgsPlatform
max :: NixpkgsPlatform -> NixpkgsPlatform -> NixpkgsPlatform
$cmax :: NixpkgsPlatform -> NixpkgsPlatform -> NixpkgsPlatform
>= :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
$c>= :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
> :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
$c> :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
<= :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
$c<= :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
< :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
$c< :: NixpkgsPlatform -> NixpkgsPlatform -> Bool
compare :: NixpkgsPlatform -> NixpkgsPlatform -> Ordering
$ccompare :: NixpkgsPlatform -> NixpkgsPlatform -> Ordering
Ord, forall x. Rep NixpkgsPlatform x -> NixpkgsPlatform
forall x. NixpkgsPlatform -> Rep NixpkgsPlatform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NixpkgsPlatform x -> NixpkgsPlatform
$cfrom :: forall x. NixpkgsPlatform -> Rep NixpkgsPlatform x
Generic)

nixpkgsPlatformFromCabal :: Platform -> String
nixpkgsPlatformFromCabal :: Platform -> String
nixpkgsPlatformFromCabal (Platform Arch
arch OS
os) = String
"\"" forall a. [a] -> [a] -> [a]
++ String
nixArch forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ String
nixOs forall a. [a] -> [a] -> [a]
++ String
"\""
  where nixArch :: String
nixArch =
          case Arch
arch of
            Arch
I386 -> String
"i686" -- rendered as i386 by default
            Arch
PPC -> String
"powerpc" -- rendered as ppc by default
            Arch
PPC64 -> String
"powerpc64" -- rendered as ppc64 by default
            Arch
JavaScript -> String
"js" -- rendered as javascript by default
            Arch
_    -> forall a. Pretty a => a -> String
CabalPretty.prettyShow Arch
arch
        nixOs :: String
nixOs =
          case OS
os of
            OS
OSX -> String
"darwin" -- rendered as osx by default
            OS
_   -> forall a. Pretty a => a -> String
CabalPretty.prettyShow OS
os

-- | Obtain a 'NixpkgsPlatform' from a string representation intended for config
--   files.
--
--   * Every string starting with @lib.platforms.@ or @platforms.@ is
--     parsed into 'NixpkgsPlatformGroup'.
--   * All other strings are attempted to be interpreted as a nix(pkgs) style
--     system tuple and parsed into 'NixpkgsPlatformSingle'.
--
--   If none of these formats match the input 'String', 'Nothing' is returned.
--   A 'Just' result thus only indicates that the format of the platform is
--   sound — 'nixpkgsPlatformFromString' does /not/ check if the parsed platform
--   actually exists.
--
--   'NixpkgsPlatformSingle' is parsed from system tuples as understood by Nix
--   and nixpkgs. System tuples are derived from autoconf's
--   [target triplets](https://www.gnu.org/savannah-checkouts/gnu/autoconf/manual/autoconf-2.70/autoconf.html#Manual-Configuration),
--   dropping the vendor part. They have the form @cpu-os@ where @os@ can either
--   be a single component or of the form @kernel-system@ (system is an autoconf
--   term here, not a Nix system). Note that three component systems are very
--   rare. The two main candidates @x86_64-linux-musl@ and @x86_64-linux-gnu@
--   are [prohibited for historical reasons](https://github.com/NixOS/nix/blob/ec07a70979a86cc436de7e46e03789b4606d25ab/configure.ac#L26-L28)
--   and represented as plain @x86_64-linux@ instead.
--
--   Note that 'nixpkgsPlatformFromString' expects to receive a /valid/ system
--   tuple, i.e. it will accept all system tuples that have a sound format
--   (with the caveat that it will accept n-tuples for @n >= 4@ even though
--   they are technically invalid). This is done because the ambiguity of
--   system tuples requires knowledge over its legal contents in order to check
--   their validity properly. Since @lib.systems.elaborate@ from nixpkgs is the
--   source of truth in this case, we want to avoid the need to continuously
--   update @distribution-nixpkgs@ to reflect its inner workings.
--
--   'nixpkgsPlatformFromString' does, however, some conversions to alleviate some
--   discrepancies between Cabal and nixpkgs. Parsing and rendering system tuples
--   using 'nixpkgsPlatformFromString' and rendering them via the 'Pretty'
--   instance of 'NixpkgsPlatform' should not change the system tuple
--   for tuples accepted by nixpkgs. This has been tested for all known tuples
--   (from @lib.platforms@ and @lib.systems.examples@) as of 2022-05-08.
--   Please open an issue if any newly added ones are not recognized properly.
--
--   __Warning__: 'nixpkgsPlatformFromString' consequently tries to preserve all
--   information of the passed system tuple. This means that it distinguishes
--   between things that Cabal wouldn't, e.g. `powerpc64` and `powerpc64le`. If
--   you use this function to obtain a 'Platform' that is later used to evaluate
--   a @.cabal@ file, it will behave unexpectedly in some situation. It is
--   recommended to use Cabal's own facilities or
--   @Distribution.Nixpkgs.Haskell.Platform@, provided by @cabal2nix@, instead.
--
--   'nixpkgsPlatformFromString' is also /not/ the inverse operation for
--   'NixpkgsPlatform'\'s 'Pretty' instance. It is not intended for parsing Nix
--   expressions.
--
--   >>> nixpkgsPlatformFromString "x86_64-netbsd"
--   Just (NixpkgsPlatformSingle (Platform X86_64 NetBSD))
--   >>> nixpkgsPlatformFromString "platforms.riscv"
--   Just (NixpkgsPlatformGroup (Identifier "riscv"))
--   >>> nixpkgsPlatformFromString "garbage"
--   Nothing
nixpkgsPlatformFromString :: String -> Maybe NixpkgsPlatform
nixpkgsPlatformFromString :: String -> Maybe NixpkgsPlatform
nixpkgsPlatformFromString String
s = Maybe NixpkgsPlatform
platformGroup forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe NixpkgsPlatform
singlePlatform
  where platformGroup :: Maybe NixpkgsPlatform
platformGroup = do
          -- also accept "platform." as prefix to save some typing
          String
name <- forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"lib.platforms." String
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"platforms." String
s
          forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
name)

        singlePlatform :: Maybe NixpkgsPlatform
singlePlatform = Platform -> NixpkgsPlatform
NixpkgsPlatformSingle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Platform
cabalPlatformFromSystem String
s

-- | Parse a system tuple as understood by Nix and nixpkgs to a Cabal 'Platform'.
--   Used internally by 'nixpkgsPlatformFromString'.
--
--   >>> cabalPlatformFromSystem "x86_64-linux"
--   Just (Platform X86_64 Linux)
--   >>> cabalPlatformFromSystem "x86_64-linux-musl"
--   Just (Platform X86_64 (OtherOS "linux-musl"))
--   >>> cabalPlatformFromSystem "powerpc-darwin"
--   Just (Platform PPC OSX)
--   >>> cabalPlatformFromSystem "powerpc64le-linux"
--   Just (Platform (OtherArch "powerpc64le") Linux)
--   >>> cabalPlatformFromSystem "js-ghcjs"
--   Just (Platform JavaScript Ghcjs)
cabalPlatformFromSystem :: String -> Maybe Platform
cabalPlatformFromSystem :: String -> Maybe Platform
cabalPlatformFromSystem String
s =
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'-') String
s of
    (String
arch, Char
'-':String
os) ->
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
arch Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
os
      then forall a. Maybe a
Nothing
      else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Arch -> OS -> Platform
Platform (String -> Arch
parseArch String
arch) (String -> OS
parseOS String
os)
    (String, String)
_ -> forall a. Maybe a
Nothing
  where -- Use permissive classification to also recognize autoconf / nixpkgs
        -- style OS strings, e.g. "darwin" where Cabal would expect "osx".
        --
        -- Note that we don't reimplement GHC_CONVERT_OS from GHC's configure
        -- file here at the moment. Our goal is to recognize all /well formed/
        -- nixpkgs system strings, nothing more. That this works correctly for
        -- nixpkgs systems currently in use is confirmed by the test suite.
        parseOS :: String -> OS
parseOS = ClassificationStrictness -> String -> OS
classifyOS ClassificationStrictness
Permissive

        -- Use Strict for arch classification and add specific guards for cases
        -- where Cabal's naming expectations (which seems to be LLVM oriented)
        -- clash with what nixpkgs / autoconf use (e.g. Cabal uses "ppc" instead
        -- of "powerpc"). Using Permissive is not possible because Cabal is a bit
        -- overzealous in arch recognition: For example, it ignores endianess in
        -- the case of the POWER architectures, parsing "powerpcle" to "ppc" and
        -- "powerpc64le" to "ppc64" when they are clearly different platforms.
        --
        -- We also don't implement GHC_CONVERT_ARCH here, for the reasons stated
        -- above.
        parseArch :: String -> Arch
parseArch String
as =
          case ClassificationStrictness -> String -> Arch
classifyArch ClassificationStrictness
Strict String
as of
            OtherArch String
"i686" -> Arch
I386
            OtherArch String
"js" -> Arch
JavaScript
            OtherArch String
"powerpc" -> Arch
PPC
            OtherArch String
"powerpc64" -> Arch
PPC64
            Arch
a -> Arch
a

instance Pretty NixpkgsPlatform where
  pPrint :: NixpkgsPlatform -> Doc
pPrint (NixpkgsPlatformSingle Platform
p) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ Platform -> String
nixpkgsPlatformFromCabal Platform
p
  pPrint (NixpkgsPlatformGroup Identifier
p)  = forall a. Pretty a => a -> Doc
pPrint
    forall a b. (a -> b) -> a -> b
$ Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [ Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"lib", Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"platforms", Identifier
p ]

instance NFData NixpkgsPlatform

-- | A representation of the @meta@ section used in Nix expressions.
--
-- >>> :set -XOverloadedStrings
-- >>> :{
--   let meta = nullMeta
--         & homepage .~ "http://example.org"
--         & description .~ "An example package"
--         & license .~ Unknown Nothing
--         & platforms .~ Just (Set.singleton (NixpkgsPlatformSingle (Platform X86_64 Linux)))
--         & badPlatforms .~ Nothing
--         & hydraPlatforms .~ Just Set.empty
--         & mainProgram .~ Just "example-binary"
--         & maintainers .~ Set.fromList ["joe", "jane"]
--         & broken .~ True
--   in print $ pPrint meta
-- :}
-- homepage = "http://example.org";
-- description = "An example package";
-- license = "unknown";
-- platforms = [ "x86_64-linux" ];
-- hydraPlatforms = lib.platforms.none;
-- mainProgram = "example-binary";
-- maintainers = [ lib.maintainers.jane lib.maintainers.joe ];
-- broken = true;
data Meta = Meta
  { Meta -> String
_homepage       :: String
  -- ^ URL of the package homepage
  , Meta -> String
_description    :: String
  -- ^ short description of the package
  , Meta -> License
_license        :: License
  -- ^ licensing terms
  , Meta -> Maybe (Set NixpkgsPlatform)
_platforms      :: Maybe (Set NixpkgsPlatform)
  -- ^ List of platforms that are supported by the package.
  --   'Nothing' prevents the attribute from being rendered.
  --   See 'NixpkgsPlatform' on the precise representation of platforms.
  , Meta -> Maybe (Set NixpkgsPlatform)
_badPlatforms   :: Maybe (Set NixpkgsPlatform)
  -- ^ List of platforms that are known to be unsupported. This is semantically
  --   equivalent to setting the following:
  --
  --   @
  --     platforms = lib.subtractLists
  --       (initialMeta.badPlatforms or []);
  --       (initialMeta.platforms or lib.platforms.all)
  --   @
  --
  --   'Nothing' prevents the attribute from being rendered.
  --   See 'NixpkgsPlatform' on the precise representation of platforms.
  , Meta -> Maybe (Set NixpkgsPlatform)
_hydraPlatforms :: Maybe (Set NixpkgsPlatform)
  -- ^ Platforms for which the package should be tested, built and added to the
  --   binary cache by Hydra. 'Nothing' prevents the attribute from being rendered.
  --  See 'NixpkgsPlatform' on the precise representation of platforms.
  , Meta -> Maybe String
_mainProgram    :: Maybe String
  -- ^ Filename (as in basename) of the main executable provided by the described
  --   package. @Nothing@ if it is a library or no obvious default can be chosen.
  , Meta -> Set Identifier
_maintainers    :: Set Identifier
  -- ^ list of maintainers from @pkgs\/lib\/maintainers.nix@
  , Meta -> Bool
_broken         :: Bool
  -- ^ set to @true@ if the build is known to fail
  }
  deriving (Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta] -> ShowS
$cshowList :: [Meta] -> ShowS
show :: Meta -> String
$cshow :: Meta -> String
showsPrec :: Int -> Meta -> ShowS
$cshowsPrec :: Int -> Meta -> ShowS
Show, Meta -> Meta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meta -> Meta -> Bool
$c/= :: Meta -> Meta -> Bool
== :: Meta -> Meta -> Bool
$c== :: Meta -> Meta -> Bool
Eq, Eq Meta
Meta -> Meta -> Bool
Meta -> Meta -> Ordering
Meta -> Meta -> Meta
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Meta -> Meta -> Meta
$cmin :: Meta -> Meta -> Meta
max :: Meta -> Meta -> Meta
$cmax :: Meta -> Meta -> Meta
>= :: Meta -> Meta -> Bool
$c>= :: Meta -> Meta -> Bool
> :: Meta -> Meta -> Bool
$c> :: Meta -> Meta -> Bool
<= :: Meta -> Meta -> Bool
$c<= :: Meta -> Meta -> Bool
< :: Meta -> Meta -> Bool
$c< :: Meta -> Meta -> Bool
compare :: Meta -> Meta -> Ordering
$ccompare :: Meta -> Meta -> Ordering
Ord, forall x. Rep Meta x -> Meta
forall x. Meta -> Rep Meta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Meta x -> Meta
$cfrom :: forall x. Meta -> Rep Meta x
Generic)

makeLenses ''Meta

instance NFData Meta

instance Pretty Meta where
  pPrint :: Meta -> Doc
pPrint Meta {Bool
String
Maybe String
Maybe (Set NixpkgsPlatform)
Set Identifier
License
_broken :: Bool
_maintainers :: Set Identifier
_mainProgram :: Maybe String
_hydraPlatforms :: Maybe (Set NixpkgsPlatform)
_badPlatforms :: Maybe (Set NixpkgsPlatform)
_platforms :: Maybe (Set NixpkgsPlatform)
_license :: License
_description :: String
_homepage :: String
_broken :: Meta -> Bool
_maintainers :: Meta -> Set Identifier
_mainProgram :: Meta -> Maybe String
_hydraPlatforms :: Meta -> Maybe (Set NixpkgsPlatform)
_badPlatforms :: Meta -> Maybe (Set NixpkgsPlatform)
_platforms :: Meta -> Maybe (Set NixpkgsPlatform)
_license :: Meta -> License
_description :: Meta -> String
_homepage :: Meta -> String
..} = [Doc] -> Doc
vcat
    [ Bool -> Doc -> Doc
onlyIf (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
_homepage)) forall a b. (a -> b) -> a -> b
$ String -> Doc -> Doc
attr String
"homepage" forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
_homepage
    , Bool -> Doc -> Doc
onlyIf (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
_description)) forall a b. (a -> b) -> a -> b
$ String -> Doc -> Doc
attr String
"description" forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
_description
    , String -> Doc -> Doc
attr String
"license" forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pPrint License
_license
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (String -> Set NixpkgsPlatform -> Doc
renderPlatforms String
"platforms") Maybe (Set NixpkgsPlatform)
_platforms
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (String -> Set NixpkgsPlatform -> Doc
renderPlatforms String
"badPlatforms") Maybe (Set NixpkgsPlatform)
_badPlatforms
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (String -> Set NixpkgsPlatform -> Doc
renderPlatforms String
"hydraPlatforms") Maybe (Set NixpkgsPlatform)
_hydraPlatforms
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (String -> Doc -> Doc
attr String
"mainProgram" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
string) Maybe String
_mainProgram
    , String -> Doc -> [Doc] -> Doc
listattrDoc String
"maintainers" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ Set Identifier -> [Doc]
renderMaintainers Set Identifier
_maintainers
    , String -> Bool -> Bool -> Doc
boolattr String
"broken" Bool
_broken Bool
_broken
    ]

-- | This function renders an Nix attribute binding suitable for use in
--   an attribute set representing the given set of 'NixpkgsPlatform's.
--
--   The @field@ argument is the name of the binding, usually either
--   @platforms@, @hydraPlatforms@ or @badPlatforms@.
--
--   Platforms are rendered in the following way:
--
--   * If the given 'Set' is empty, the binding's value is @lib.platforms.none@.
--     This has been preserved for “backwards compatibility” since changing this
--     would generate a huge diff for nixpkgs' @hackage-packages.nix@ file.
--
--   * First we render all 'NixpkgsPlatformSingle' values. This is done by
--     printing a Nix list containing Nix system strings. If there are no
--     platform groups, but the 'Set' is not empty, an empty list (@[ ]@) is
--     rendered.
--
--   * Finally we render all 'NixpkgsPlatformGroup's. Since these are lists, we
--     need to append them to the (cabal) platform list via the @++@ operator.
--     For each group we render @++ lib.platforms.<group name>@.
--
--   For example:
--
--   >>> :{
--     renderPlatforms "badPlatforms"
--       $ Set.fromList [
--         NixpkgsPlatformSingle (Platform (OtherArch "armv7l") Linux),
--         NixpkgsPlatformGroup (ident # "darwin"),
--         NixpkgsPlatformGroup (ident # "windows")
--       ]
--   :}
--   badPlatforms = [
--     "armv7l-linux"
--   ] ++ lib.platforms.darwin
--     ++ lib.platforms.windows;
--
--   >>> :{
--     renderPlatforms "platforms"
--       $ Set.fromList [
--         NixpkgsPlatformGroup (ident # "x86"),
--         NixpkgsPlatformGroup (ident # "riscv"),
--         NixpkgsPlatformGroup (ident # "freebsd")
--       ]
--   :}
--   platforms =
--        lib.platforms.freebsd
--     ++ lib.platforms.riscv
--     ++ lib.platforms.x86;
--
--   >>> :{
--     renderPlatforms "platforms"
--       $ Set.fromList [
--         NixpkgsPlatformGroup (ident # "x86")
--       ]
--   :}
--   platforms = lib.platforms.x86;
--
--   >>> :{
--     renderPlatforms "platforms"
--       $ Set.fromList [
--         NixpkgsPlatformSingle (Platform I386 Linux),
--         NixpkgsPlatformSingle (Platform X86_64 Linux),
--         NixpkgsPlatformSingle (Platform AArch64 Linux),
--         NixpkgsPlatformSingle (Platform X86_64 OSX),
--         NixpkgsPlatformSingle (Platform AArch64 OSX)
--       ]
--   :}
--   platforms = [
--     "i686-linux" "x86_64-linux" "x86_64-darwin" "aarch64-linux"
--     "aarch64-darwin"
--   ];
--
--   >>> :{
--     renderPlatforms "platforms"
--       $ Set.fromList [
--         NixpkgsPlatformSingle (Platform I386 Linux),
--         NixpkgsPlatformSingle (Platform X86_64 Linux),
--         NixpkgsPlatformSingle (Platform AArch64 Linux),
--         NixpkgsPlatformSingle (Platform X86_64 OSX),
--         NixpkgsPlatformSingle (Platform AArch64 OSX),
--         NixpkgsPlatformGroup (ident # "riscv"),
--         NixpkgsPlatformGroup (ident # "arm")
--       ]
--   :}
--   platforms = [
--     "i686-linux" "x86_64-linux" "x86_64-darwin" "aarch64-linux"
--     "aarch64-darwin"
--   ] ++ lib.platforms.arm
--     ++ lib.platforms.riscv;
renderPlatforms :: String -> Set NixpkgsPlatform -> Doc
renderPlatforms :: String -> Set NixpkgsPlatform -> Doc
renderPlatforms String
field Set NixpkgsPlatform
ps
  -- preserve old behavior: no platforms -> lib.platforms.none
  | forall a. Set a -> Bool
Set.null Set NixpkgsPlatform
ps = [Doc] -> Doc
sep [ String -> Doc
text String
field Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> String -> Doc
text String
"lib.platforms.none" Doc -> Doc -> Doc
<> Doc
semi ]
  | Bool
otherwise =
    [Doc] -> Doc
sep [ String -> Doc
text String
field Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> forall {p}. Monoid p => Bool -> p -> p
unless (forall a. Set a -> Bool
Set.null Set NixpkgsPlatform
cabalPs) Doc
lbrack
        , forall {p}. Monoid p => Bool -> p -> p
unless (forall a. Set a -> Bool
Set.null Set NixpkgsPlatform
cabalPs) (Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep [Doc]
renderedCabalPs)
        , forall {p}. Monoid p => Bool -> p -> p
unless (forall a. Set a -> Bool
Set.null Set NixpkgsPlatform
cabalPs) Doc
rbrack
        , forall {p}. Monoid p => Bool -> p -> p
unless (forall a. Set a -> Bool
Set.null Set NixpkgsPlatform
nixpkgsPs) (Int -> Doc -> Doc
nest Int
2 Doc
renderedNixpkgsPs)
        ]
    Doc -> Doc -> Doc
<> Doc
semi
  where -- render nixpkgs platforms and cabal platform tuples separately
        -- since the former represents multiple platforms and meta doesn't
        -- support nested lists.
        (Set NixpkgsPlatform
cabalPs, Set NixpkgsPlatform
nixpkgsPs) = forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition NixpkgsPlatform -> Bool
isSinglePlatform Set NixpkgsPlatform
ps
        isSinglePlatform :: NixpkgsPlatform -> Bool
isSinglePlatform (NixpkgsPlatformSingle Platform
_) = Bool
True
        isSinglePlatform NixpkgsPlatform
_ = Bool
False

        renderedCabalPs :: [Doc]
renderedCabalPs = forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pPrint forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toAscList Set NixpkgsPlatform
cabalPs

        -- append lib.platforms list via nix's ++ at the end
        -- if there is no cabal platforms list, don't emit leading ++
        appendNixpkgsP :: Doc -> a -> Doc
appendNixpkgsP Doc
acc a
elem = Doc
acc Doc -> Doc -> Doc
$$
          if Doc -> Bool
isEmpty Doc
acc Bool -> Bool -> Bool
&& forall a. Set a -> Bool
Set.null Set NixpkgsPlatform
cabalPs
          then Int -> Doc -> Doc
nest Int
3 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pPrint a
elem
          else String -> Doc
text String
"++" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pPrint a
elem
        renderedNixpkgsPs :: Doc
renderedNixpkgsPs = forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' forall {a}. Pretty a => Doc -> a -> Doc
appendNixpkgsP forall a. Monoid a => a
mempty Set NixpkgsPlatform
nixpkgsPs

        -- Helper function, roughly the inverse of nixpkgs' optionals
        unless :: Bool -> p -> p
unless Bool
False p
x = p
x
        unless Bool
True p
_  = forall a. Monoid a => a
mempty

renderMaintainers :: Set Identifier -> [Doc]
renderMaintainers :: Set Identifier -> [Doc]
renderMaintainers = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
pPrint forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Path
toPath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> String) -> Set a -> [a]
toAscListSortedOn (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' Identifier String
ident)
  where toPath :: Identifier -> Path
toPath Identifier
m = Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [ Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"lib", Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"maintainers", Identifier
m]

-- | 'Meta' record with no field set, i.e. evaluating any will throw:
--
--   >>> nullMeta ^. homepage
--   "*** Exception: undefined Meta.homepage
--   ...
nullMeta :: Meta
nullMeta :: Meta
nullMeta = Meta
  { _homepage :: String
_homepage = forall a. HasCallStack => String -> a
error String
"undefined Meta.homepage"
  , _description :: String
_description = forall a. HasCallStack => String -> a
error String
"undefined Meta.description"
  , _license :: License
_license = forall a. HasCallStack => String -> a
error String
"undefined Meta.license"
  , _platforms :: Maybe (Set NixpkgsPlatform)
_platforms = forall a. HasCallStack => String -> a
error String
"undefined Meta.platforms"
  , _badPlatforms :: Maybe (Set NixpkgsPlatform)
_badPlatforms = forall a. HasCallStack => String -> a
error String
"undefined Meta.badPlatforms"
  , _hydraPlatforms :: Maybe (Set NixpkgsPlatform)
_hydraPlatforms = forall a. HasCallStack => String -> a
error String
"undefined Meta.hydraPlatforms"
  , _mainProgram :: Maybe String
_mainProgram = forall a. HasCallStack => String -> a
error String
"undefined Meta.mainProgram"
  , _maintainers :: Set Identifier
_maintainers = forall a. HasCallStack => String -> a
error String
"undefined Meta.maintainers"
  , _broken :: Bool
_broken = forall a. HasCallStack => String -> a
error String
"undefined Meta.broken"
  }