{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Cabal2nix
  ( main, cabal2nix, cabal2nix', cabal2nixWithDB, parseArgs
  , Options(..)
  )
  where

import Control.Exception ( bracket )
import Control.Lens
import Control.Monad
import Data.List ( intercalate, isPrefixOf )
import Data.List.Split
import Data.Maybe ( fromMaybe, isJust, listToMaybe )
import qualified Data.Set as Set
import Data.String
import Data.Time
import Distribution.Compiler
import Distribution.Nixpkgs.Fetch
import Distribution.Nixpkgs.Haskell
import Distribution.Nixpkgs.Haskell.FromCabal
import Distribution.Nixpkgs.Haskell.FromCabal.Flags
import qualified Distribution.Nixpkgs.Haskell.FromCabal.PostProcess as PP (pkg)
import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
import Distribution.Nixpkgs.Haskell.OrphanInstances ( )
import Distribution.Nixpkgs.Haskell.PackageSourceSpec
import Distribution.Nixpkgs.Meta
import Distribution.Package ( packageId )
import Distribution.PackageDescription ( mkFlagName, mkFlagAssignment, FlagAssignment )
import Distribution.Parsec as P
import Distribution.Simple.Utils ( lowercase )
import Distribution.System
import Language.Nix
import Options.Applicative
import Paths_cabal2nix ( version )
import System.Environment ( getArgs )
import System.IO ( hFlush, hPutStrLn, stdout, stderr )
import qualified Text.PrettyPrint.ANSI.Leijen as P2
import Text.PrettyPrint.HughesPJClass ( Doc, Pretty(..), text, vcat, hcat, semi, render, prettyShow )

{-# ANN module ("HLint: ignore Use Just" :: String) #-}

data Options = Options
  { Options -> Maybe String
optSha256 :: Maybe String
  , Options -> [String]
optMaintainer :: [String]
--, optPlatform :: [String]       -- TODO: fix command line handling of platforms
  , Options -> Bool
optHaddock :: Bool
  , Options -> HpackUse
optHpack :: HpackUse
  , Options -> Bool
optDoCheck :: Bool
  , Options -> Bool
optJailbreak :: Bool
  , Options -> Bool
optDoBenchmark :: Bool
  , Options -> Maybe String
optRevision :: Maybe String
  , Options -> Bool
optHyperlinkSource :: Bool
  , Options -> Bool
optEnableLibraryProfiling :: Bool
  , Options -> Bool
optEnableExecutableProfiling :: Bool
  , Options -> Maybe Bool
optEnableProfiling :: Maybe Bool
  , Options -> [String]
optExtraArgs :: [String]
  , Options -> Maybe String
optHackageDb :: Maybe FilePath
  , Options -> Bool
optNixShellOutput :: Bool
  , Options -> [String]
optFlags :: [String]
  , Options -> CompilerId
optCompiler :: CompilerId
  , Options -> Platform
optSystem :: Platform
  , Options -> Maybe String
optSubpath :: Maybe FilePath
  , Options -> Maybe UTCTime
optHackageSnapshot :: Maybe UTCTime
  , Options -> NixpkgsResolver
optNixpkgsIdentifier :: NixpkgsResolver
  , Options -> String
optUrl :: String
  , Options -> Bool
optFetchSubmodules :: Bool
  }

options :: Parser Options
options :: Parser Options
options = Maybe String
-> [String]
-> Bool
-> HpackUse
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Bool
-> Bool
-> Bool
-> Maybe Bool
-> [String]
-> Maybe String
-> Bool
-> [String]
-> CompilerId
-> Platform
-> Maybe String
-> Maybe UTCTime
-> NixpkgsResolver
-> String
-> Bool
-> Options
Options
          (Maybe String
 -> [String]
 -> Bool
 -> HpackUse
 -> Bool
 -> Bool
 -> Bool
 -> Maybe String
 -> Bool
 -> Bool
 -> Bool
 -> Maybe Bool
 -> [String]
 -> Maybe String
 -> Bool
 -> [String]
 -> CompilerId
 -> Platform
 -> Maybe String
 -> Maybe UTCTime
 -> NixpkgsResolver
 -> String
 -> Bool
 -> Options)
-> Parser (Maybe String)
-> Parser
     ([String]
      -> Bool
      -> HpackUse
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sha256" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HASH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"sha256 hash of source tarball")
          Parser
  ([String]
   -> Bool
   -> HpackUse
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser [String]
-> Parser
     (Bool
      -> HpackUse
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"maintainer" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MAINTAINER" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"maintainer of this package (may be specified multiple times)")
--        <*> many (strOption $ long "platform" <> metavar "PLATFORM" <> help "supported build platforms (may be specified multiple times)")
          Parser
  (Bool
   -> HpackUse
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Bool
-> Parser
     (HpackUse
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-haddock" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't run Haddock when building this package")
          Parser
  (HpackUse
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser HpackUse
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
          (
            HpackUse -> Mod FlagFields HpackUse -> Parser HpackUse
forall a. a -> Mod FlagFields a -> Parser a
flag' HpackUse
ForceHpack (String -> Mod FlagFields HpackUse
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hpack" Mod FlagFields HpackUse
-> Mod FlagFields HpackUse -> Mod FlagFields HpackUse
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields HpackUse
forall (f :: * -> *) a. String -> Mod f a
help String
"run hpack before configuring this package (only non-hackage packages)")
            Parser HpackUse -> Parser HpackUse -> Parser HpackUse
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            HpackUse -> Mod FlagFields HpackUse -> Parser HpackUse
forall a. a -> Mod FlagFields a -> Parser a
flag' HpackUse
NoHpack (String -> Mod FlagFields HpackUse
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-hpack" Mod FlagFields HpackUse
-> Mod FlagFields HpackUse -> Mod FlagFields HpackUse
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields HpackUse
forall (f :: * -> *) a. String -> Mod f a
help String
"disable hpack run and use only cabal disregarding package.yaml existence")
            Parser HpackUse -> Parser HpackUse -> Parser HpackUse
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            HpackUse -> Parser HpackUse
forall (f :: * -> *) a. Applicative f => a -> f a
pure HpackUse
PackageYamlHpack
          )
          Parser
  (Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-check" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't run regression test suites of this package")
          Parser
  (Bool
   -> Bool
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Bool
-> Parser
     (Bool
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"jailbreak" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"disregard version restrictions on build inputs")
          Parser
  (Bool
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Bool
-> Parser
     (Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"benchmark" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"enable benchmarks for this package")
          Parser
  (Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser (Maybe String)
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"revision" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"revision to use when fetching from VCS")
          Parser
  (Bool
   -> Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-hyperlink-source" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"don't generate pretty-printed source code for the documentation")
          Parser
  (Bool
   -> Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Bool
-> Parser
     (Bool
      -> Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"enable-library-profiling" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"enable library profiling in the generated build")
          Parser
  (Bool
   -> Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Bool
-> Parser
     (Maybe Bool
      -> [String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"enable-executable-profiling" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"enable executable profiling in the generated build")
          Parser
  (Maybe Bool
   -> [String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser (Maybe Bool)
-> Parser
     ([String]
      -> Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"enable-profiling" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"enable both library and executable profiling in the generated build"))
          Parser
  ([String]
   -> Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser [String]
-> Parser
     (Maybe String
      -> Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra-arguments" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"extra parameters required for the function body")
          Parser
  (Maybe String
   -> Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser (Maybe String)
-> Parser
     (Bool
      -> [String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hackage-db" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"path to the local hackage db in tar format")
          Parser
  (Bool
   -> [String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Bool
-> Parser
     ([String]
      -> CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"shell" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"generate output suitable for nix-shell")
          Parser
  ([String]
   -> CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser [String]
-> Parser
     (CompilerId
      -> Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"flag" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Cabal flag (may be specified multiple times)")
          Parser
  (CompilerId
   -> Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser CompilerId
-> Parser
     (Platform
      -> Maybe String
      -> Maybe UTCTime
      -> NixpkgsResolver
      -> String
      -> Bool
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM CompilerId
-> Mod OptionFields CompilerId -> Parser CompilerId
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM CompilerId
forall a. Parsec a => ReadM a
parseCabal (String -> Mod OptionFields CompilerId
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"compiler" Mod OptionFields CompilerId
-> Mod OptionFields CompilerId -> Mod OptionFields CompilerId
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields CompilerId
forall (f :: * -> *) a. String -> Mod f a
help String
"compiler to use when evaluating the Cabal file" Mod OptionFields CompilerId
-> Mod OptionFields CompilerId -> Mod OptionFields CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId -> Mod OptionFields CompilerId
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value CompilerId
buildCompilerId Mod OptionFields CompilerId
-> Mod OptionFields CompilerId -> Mod OptionFields CompilerId
forall a. Semigroup a => a -> a -> a
<> (CompilerId -> String) -> Mod OptionFields CompilerId
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith CompilerId -> String
forall a. Pretty a => a -> String
prettyShow)
          Parser
  (Platform
   -> Maybe String
   -> Maybe UTCTime
   -> NixpkgsResolver
   -> String
   -> Bool
   -> Options)
-> Parser Platform
-> Parser
     (Maybe String
      -> Maybe UTCTime -> NixpkgsResolver -> String -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Platform -> Mod OptionFields Platform -> Parser Platform
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Maybe Platform) -> ReadM Platform
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe Platform
parsePlatform) (String -> Mod OptionFields Platform
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"system" Mod OptionFields Platform
-> Mod OptionFields Platform -> Mod OptionFields Platform
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Platform
forall (f :: * -> *) a. String -> Mod f a
help String
"host system (in either short Nix format or full LLVM style) to use when evaluating the Cabal file" Mod OptionFields Platform
-> Mod OptionFields Platform -> Mod OptionFields Platform
forall a. Semigroup a => a -> a -> a
<> Platform -> Mod OptionFields Platform
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Platform
buildPlatform Mod OptionFields Platform
-> Mod OptionFields Platform -> Mod OptionFields Platform
forall a. Semigroup a => a -> a -> a
<> (Platform -> String) -> Mod OptionFields Platform
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith Platform -> String
forall a. Pretty a => a -> String
prettyShow)
          Parser
  (Maybe String
   -> Maybe UTCTime -> NixpkgsResolver -> String -> Bool -> Options)
-> Parser (Maybe String)
-> Parser
     (Maybe UTCTime -> NixpkgsResolver -> String -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"subpath" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to Cabal file's directory relative to the URI (default is root directory)")
          Parser
  (Maybe UTCTime -> NixpkgsResolver -> String -> Bool -> Options)
-> Parser (Maybe UTCTime)
-> Parser (NixpkgsResolver -> String -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UTCTime -> Parser (Maybe UTCTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM UTCTime -> Mod OptionFields UTCTime -> Parser UTCTime
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM UTCTime
utcTimeReader (String -> Mod OptionFields UTCTime
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hackage-snapshot" Mod OptionFields UTCTime
-> Mod OptionFields UTCTime -> Mod OptionFields UTCTime
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields UTCTime
forall (f :: * -> *) a. String -> Mod f a
help String
"hackage snapshot time, ISO format"))
          Parser (NixpkgsResolver -> String -> Bool -> Options)
-> Parser NixpkgsResolver -> Parser (String -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NixpkgsResolver -> Parser NixpkgsResolver
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Identifier
i -> Binding -> Maybe Binding
forall a. a -> Maybe a
Just (Tagged (Identifier, Path) (Identity (Identifier, Path))
-> Tagged Binding (Identity Binding)
Iso' Binding (Identifier, Path)
binding (Tagged (Identifier, Path) (Identity (Identifier, Path))
 -> Tagged Binding (Identity Binding))
-> (Identifier, Path) -> Binding
forall t b. AReview t b -> b -> t
# (Identifier
i, Tagged [Identifier] (Identity [Identifier])
-> Tagged Path (Identity Path)
Iso' Path [Identifier]
path (Tagged [Identifier] (Identity [Identifier])
 -> Tagged Path (Identity Path))
-> [Identifier] -> Path
forall t b. AReview t b -> b -> t
# [Tagged String (Identity String)
-> Tagged Identifier (Identity Identifier)
Iso' Identifier String
ident (Tagged String (Identity String)
 -> Tagged Identifier (Identity Identifier))
-> String -> Identifier
forall t b. AReview t b -> b -> t
# String
"pkgs", Identifier
i])))
          Parser (String -> Bool -> Options)
-> Parser String -> Parser (Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"URI")
          Parser (Bool -> Options) -> Parser Bool -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dont-fetch-submodules" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"do not fetch git submodules from git sources")

-- | A parser for the date. Hackage updates happen maybe once or twice a month.
-- Example: parseTime defaultTimeLocale "%FT%T%QZ" "2017-11-20T12:18:35Z" :: Maybe UTCTime
utcTimeReader :: ReadM UTCTime
utcTimeReader :: ReadM UTCTime
utcTimeReader = (String -> Either String UTCTime) -> ReadM UTCTime
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String UTCTime) -> ReadM UTCTime)
-> (String -> Either String UTCTime) -> ReadM UTCTime
forall a b. (a -> b) -> a -> b
$ \String
arg ->
    case Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%FT%T%QZ" String
arg of
        Maybe UTCTime
Nothing      -> String -> Either String UTCTime
forall a b. a -> Either a b
Left (String -> Either String UTCTime)
-> String -> Either String UTCTime
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse date, ISO format used ('2017-11-20T12:18:35Z'): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg
        Just UTCTime
utcTime -> UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right UTCTime
utcTime

parseCabal :: Parsec a => ReadM a
parseCabal :: ReadM a
parseCabal = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String a
forall a. Parsec a => String -> Either String a
eitherParsec

-- | Replicate the normalization performed by GHC_CONVERT_CPU in GHC's aclocal.m4
-- since the output of that is what Cabal parses.
ghcConvertArch :: String -> String
ghcConvertArch :: String -> String
ghcConvertArch String
arch = case String
arch of
  String
"i486"  -> String
"i386"
  String
"i586"  -> String
"i386"
  String
"i686"  -> String
"i386"
  String
"amd64" -> String
"x86_64"
  String
_ -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
arch (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe
    [String
prefix | String
prefix <- [String]
archPrefixes, String
prefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
arch]
  where archPrefixes :: [String]
archPrefixes =
          [ String
"aarch64", String
"alpha", String
"arm", String
"hppa1_1", String
"hppa", String
"m68k", String
"mipseb"
          , String
"mipsel", String
"mips", String
"powerpc64le", String
"powerpc64", String
"powerpc", String
"s390x"
          , String
"sparc64", String
"sparc"
          ]

-- | Replicate the normalization performed by GHC_CONVERT_OS in GHC's aclocal.m4
-- since the output of that is what Cabal parses.
ghcConvertOS :: String -> String
ghcConvertOS :: String -> String
ghcConvertOS String
os = case String
os of
  String
"watchos"       -> String
"ios"
  String
"tvos"          -> String
"ios"
  String
"linux-android" -> String
"linux-android"
  String
"linux-androideabi" -> String
"linux-androideabi"
  String
_ | String
"linux-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
os -> String
"linux"
  String
_ -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
os (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe
    [String
prefix | String
prefix <- [String]
osPrefixes, String
prefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
os]
  where osPrefixes :: [String]
osPrefixes =
          [ String
"gnu", String
"openbsd", String
"aix", String
"darwin", String
"solaris2", String
"freebsd", String
"nto-qnx"]

parseArch :: String -> Arch
parseArch :: String -> Arch
parseArch = ClassificationStrictness -> String -> Arch
classifyArch ClassificationStrictness
Permissive (String -> Arch) -> (String -> String) -> String -> Arch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
ghcConvertArch

parseOS :: String -> OS
parseOS :: String -> OS
parseOS = ClassificationStrictness -> String -> OS
classifyOS ClassificationStrictness
Permissive (String -> OS) -> (String -> String) -> String -> OS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
ghcConvertOS

parsePlatform :: String -> Maybe Platform
parsePlatform :: String -> Maybe Platform
parsePlatform = [String] -> Maybe Platform
parsePlatformParts ([String] -> Maybe Platform)
-> (String -> [String]) -> String -> Maybe Platform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"-"

parsePlatformParts :: [String] -> Maybe Platform
parsePlatformParts :: [String] -> Maybe Platform
parsePlatformParts = \case
  [String
arch, String
os] ->
    Platform -> Maybe Platform
forall a. a -> Maybe a
Just (Platform -> Maybe Platform) -> Platform -> Maybe Platform
forall a b. (a -> b) -> a -> b
$ Arch -> OS -> Platform
Platform (String -> Arch
parseArch String
arch) (String -> OS
parseOS String
os)
  (String
arch : String
_ : [String]
osParts) ->
    Platform -> Maybe Platform
forall a. a -> Maybe a
Just (Platform -> Maybe Platform) -> Platform -> Maybe Platform
forall a b. (a -> b) -> a -> b
$ Arch -> OS -> Platform
Platform (String -> Arch
parseArch String
arch) (OS -> Platform) -> OS -> Platform
forall a b. (a -> b) -> a -> b
$ String -> OS
parseOS (String -> OS) -> String -> OS
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String]
osParts
  [String]
_ -> Maybe Platform
forall a. Maybe a
Nothing

pinfo :: ParserInfo Options
pinfo :: ParserInfo Options
pinfo = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (   Parser ((Options -> Options) -> Options -> Options)
forall a. Parser (a -> a)
helper
        Parser ((Options -> Options) -> Options -> Options)
-> Parser (Options -> Options) -> Parser (Options -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> Mod OptionFields (Options -> Options)
-> Parser (Options -> Options)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (String
"cabal2nix " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
version) (String -> Mod OptionFields (Options -> Options)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (Options -> Options)
-> Mod OptionFields (Options -> Options)
-> Mod OptionFields (Options -> Options)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Options -> Options)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version number")
        Parser (Options -> Options) -> Parser Options -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
options
        )
        (  InfoMod Options
forall a. InfoMod a
fullDesc
        InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Options
forall a. String -> InfoMod a
header String
"cabal2nix converts Cabal files into build instructions for Nix."
        InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod Options
forall a. Maybe Doc -> InfoMod a
progDescDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just ([Doc] -> Doc
P2.vcat
                     [ String -> Doc
P2.text String
""
                     , String -> Doc
P2.text String
"Recognized URI schemes:"
                     , String -> Doc
P2.text String
""
                     , String -> Doc
P2.text String
"  cabal://pkgname-pkgversion     download the specified package from Hackage"
                     , String -> Doc
P2.text String
"  cabal://pkgname                download latest version of this package from Hackage"
                     , String -> Doc
P2.text String
"  file:///local/path             load the Cabal file from the local disk"
                     , String -> Doc
P2.text String
"  /local/path                    abbreviated version of file URI"
                     , String -> Doc
P2.text String
"  <git/svn/bzr/hg URL>           download the source from the specified repository"
                     , String -> Doc
P2.text String
""
                     , [Doc] -> Doc
P2.fillSep ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
P2.text (String -> [String]
words (  String
"If the URI refers to a cabal file, information for building the package "
                                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"will be retrieved from that file, but hackage will be used as a source "
                                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"for the derivation. Otherwise, the supplied URI will be used to as the "
                                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"source for the derivation and the information is taken from the cabal file "
                                                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"at the root of the downloaded source."
                                                      )))
                     ]))
        )

main :: IO ()
main :: IO ()
main = IO () -> (() -> IO ()) -> (() -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\() -> Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stderr) ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \() ->
  [String] -> IO ()
cabal2nix ([String] -> IO ()) -> IO [String] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs

hpackOverrides :: Derivation -> Derivation
hpackOverrides :: Derivation -> Derivation
hpackOverrides = ASetter Derivation Derivation String String
-> (String -> String) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Derivation Derivation String String
Lens' Derivation String
phaseOverrides (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"prePatch = \"hpack\";")
               (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Derivation Derivation Bool Bool
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens' Derivation BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Bool -> Identity Bool) -> BuildInfo -> Identity BuildInfo)
-> ASetter Derivation Derivation Bool Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
tool ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> ((Bool -> Identity Bool)
    -> Set Binding -> Identity (Set Binding))
-> (Bool -> Identity Bool)
-> BuildInfo
-> Identity BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
PP.pkg Identifier
"hpack")) Bool
True

cabal2nix' :: Options -> IO (Either Doc Derivation)
cabal2nix' :: Options -> IO (Either Doc Derivation)
cabal2nix' opts :: Options
opts@Options{Bool
String
[String]
Maybe Bool
Maybe String
Maybe UTCTime
CompilerId
Platform
HpackUse
NixpkgsResolver
optFetchSubmodules :: Bool
optUrl :: String
optNixpkgsIdentifier :: NixpkgsResolver
optHackageSnapshot :: Maybe UTCTime
optSubpath :: Maybe String
optSystem :: Platform
optCompiler :: CompilerId
optFlags :: [String]
optNixShellOutput :: Bool
optHackageDb :: Maybe String
optExtraArgs :: [String]
optEnableProfiling :: Maybe Bool
optEnableExecutableProfiling :: Bool
optEnableLibraryProfiling :: Bool
optHyperlinkSource :: Bool
optRevision :: Maybe String
optDoBenchmark :: Bool
optJailbreak :: Bool
optDoCheck :: Bool
optHpack :: HpackUse
optHaddock :: Bool
optMaintainer :: [String]
optSha256 :: Maybe String
optFetchSubmodules :: Options -> Bool
optUrl :: Options -> String
optNixpkgsIdentifier :: Options -> NixpkgsResolver
optHackageSnapshot :: Options -> Maybe UTCTime
optSubpath :: Options -> Maybe String
optSystem :: Options -> Platform
optCompiler :: Options -> CompilerId
optFlags :: Options -> [String]
optNixShellOutput :: Options -> Bool
optHackageDb :: Options -> Maybe String
optExtraArgs :: Options -> [String]
optEnableProfiling :: Options -> Maybe Bool
optEnableExecutableProfiling :: Options -> Bool
optEnableLibraryProfiling :: Options -> Bool
optHyperlinkSource :: Options -> Bool
optRevision :: Options -> Maybe String
optDoBenchmark :: Options -> Bool
optJailbreak :: Options -> Bool
optDoCheck :: Options -> Bool
optHpack :: Options -> HpackUse
optHaddock :: Options -> Bool
optMaintainer :: Options -> [String]
optSha256 :: Options -> Maybe String
..} = do
  Package
pkg <- HpackUse
-> Bool -> Maybe String -> Maybe UTCTime -> Source -> IO Package
getPackage HpackUse
optHpack Bool
optFetchSubmodules Maybe String
optHackageDb Maybe UTCTime
optHackageSnapshot (Source -> IO Package) -> Source -> IO Package
forall a b. (a -> b) -> a -> b
$
         String -> String -> Hash -> String -> Source
Source String
optUrl (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
optRevision) (Hash -> (String -> Hash) -> Maybe String -> Hash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Hash
UnknownHash String -> Hash
Guess Maybe String
optSha256) (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
optSubpath)
  Options -> Package -> IO (Either Doc Derivation)
processPackage Options
opts Package
pkg

cabal2nixWithDB :: DB.HackageDB -> Options -> IO (Either Doc Derivation)
cabal2nixWithDB :: HackageDB -> Options -> IO (Either Doc Derivation)
cabal2nixWithDB HackageDB
db opts :: Options
opts@Options{Bool
String
[String]
Maybe Bool
Maybe String
Maybe UTCTime
CompilerId
Platform
HpackUse
NixpkgsResolver
optFetchSubmodules :: Bool
optUrl :: String
optNixpkgsIdentifier :: NixpkgsResolver
optHackageSnapshot :: Maybe UTCTime
optSubpath :: Maybe String
optSystem :: Platform
optCompiler :: CompilerId
optFlags :: [String]
optNixShellOutput :: Bool
optHackageDb :: Maybe String
optExtraArgs :: [String]
optEnableProfiling :: Maybe Bool
optEnableExecutableProfiling :: Bool
optEnableLibraryProfiling :: Bool
optHyperlinkSource :: Bool
optRevision :: Maybe String
optDoBenchmark :: Bool
optJailbreak :: Bool
optDoCheck :: Bool
optHpack :: HpackUse
optHaddock :: Bool
optMaintainer :: [String]
optSha256 :: Maybe String
optFetchSubmodules :: Options -> Bool
optUrl :: Options -> String
optNixpkgsIdentifier :: Options -> NixpkgsResolver
optHackageSnapshot :: Options -> Maybe UTCTime
optSubpath :: Options -> Maybe String
optSystem :: Options -> Platform
optCompiler :: Options -> CompilerId
optFlags :: Options -> [String]
optNixShellOutput :: Options -> Bool
optHackageDb :: Options -> Maybe String
optExtraArgs :: Options -> [String]
optEnableProfiling :: Options -> Maybe Bool
optEnableExecutableProfiling :: Options -> Bool
optEnableLibraryProfiling :: Options -> Bool
optHyperlinkSource :: Options -> Bool
optRevision :: Options -> Maybe String
optDoBenchmark :: Options -> Bool
optJailbreak :: Options -> Bool
optDoCheck :: Options -> Bool
optHpack :: Options -> HpackUse
optHaddock :: Options -> Bool
optMaintainer :: Options -> [String]
optSha256 :: Options -> Maybe String
..} = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
optHackageDb) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"WARN: HackageDB provided directly; ignoring --hackage-db"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isJust Maybe UTCTime
optHackageSnapshot) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"WARN: HackageDB provided directly; ignoring --hackage-snapshot"
  Package
pkg <- HpackUse -> Bool -> IO HackageDB -> Source -> IO Package
getPackage' HpackUse
optHpack Bool
optFetchSubmodules (HackageDB -> IO HackageDB
forall (m :: * -> *) a. Monad m => a -> m a
return HackageDB
db) (Source -> IO Package) -> Source -> IO Package
forall a b. (a -> b) -> a -> b
$
         String -> String -> Hash -> String -> Source
Source String
optUrl (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
optRevision) (Hash -> (String -> Hash) -> Maybe String -> Hash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Hash
UnknownHash String -> Hash
Guess Maybe String
optSha256) (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
optSubpath)
  Options -> Package -> IO (Either Doc Derivation)
processPackage Options
opts Package
pkg

processPackage :: Options -> Package -> IO (Either Doc Derivation)
processPackage :: Options -> Package -> IO (Either Doc Derivation)
processPackage Options{Bool
String
[String]
Maybe Bool
Maybe String
Maybe UTCTime
CompilerId
Platform
HpackUse
NixpkgsResolver
optFetchSubmodules :: Bool
optUrl :: String
optNixpkgsIdentifier :: NixpkgsResolver
optHackageSnapshot :: Maybe UTCTime
optSubpath :: Maybe String
optSystem :: Platform
optCompiler :: CompilerId
optFlags :: [String]
optNixShellOutput :: Bool
optHackageDb :: Maybe String
optExtraArgs :: [String]
optEnableProfiling :: Maybe Bool
optEnableExecutableProfiling :: Bool
optEnableLibraryProfiling :: Bool
optHyperlinkSource :: Bool
optRevision :: Maybe String
optDoBenchmark :: Bool
optJailbreak :: Bool
optDoCheck :: Bool
optHpack :: HpackUse
optHaddock :: Bool
optMaintainer :: [String]
optSha256 :: Maybe String
optFetchSubmodules :: Options -> Bool
optUrl :: Options -> String
optNixpkgsIdentifier :: Options -> NixpkgsResolver
optHackageSnapshot :: Options -> Maybe UTCTime
optSubpath :: Options -> Maybe String
optSystem :: Options -> Platform
optCompiler :: Options -> CompilerId
optFlags :: Options -> [String]
optNixShellOutput :: Options -> Bool
optHackageDb :: Options -> Maybe String
optExtraArgs :: Options -> [String]
optEnableProfiling :: Options -> Maybe Bool
optEnableExecutableProfiling :: Options -> Bool
optEnableLibraryProfiling :: Options -> Bool
optHyperlinkSource :: Options -> Bool
optRevision :: Options -> Maybe String
optDoBenchmark :: Options -> Bool
optJailbreak :: Options -> Bool
optDoCheck :: Options -> Bool
optHpack :: Options -> HpackUse
optHaddock :: Options -> Bool
optMaintainer :: Options -> [String]
optSha256 :: Options -> Maybe String
..} Package
pkg = do
  let
      withHpackOverrides :: Derivation -> Derivation
      withHpackOverrides :: Derivation -> Derivation
withHpackOverrides = if Package -> Bool
pkgRanHpack Package
pkg then Derivation -> Derivation
hpackOverrides else Derivation -> Derivation
forall a. a -> a
id

      flags :: FlagAssignment
      flags :: FlagAssignment
flags = PackageIdentifier -> FlagAssignment
configureCabalFlags (GenericPackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId (Package -> GenericPackageDescription
pkgCabal Package
pkg)) FlagAssignment -> FlagAssignment -> FlagAssignment
forall a. Monoid a => a -> a -> a
`mappend` [String] -> FlagAssignment
readFlagList [String]
optFlags

      deriv :: Derivation
      deriv :: Derivation
deriv = Derivation -> Derivation
withHpackOverrides (Derivation -> Derivation) -> Derivation -> Derivation
forall a b. (a -> b) -> a -> b
$ HaskellResolver
-> NixpkgsResolver
-> Platform
-> CompilerInfo
-> FlagAssignment
-> [Constraint]
-> GenericPackageDescription
-> Derivation
fromGenericPackageDescription (Bool -> HaskellResolver
forall a b. a -> b -> a
const Bool
True)
                                            NixpkgsResolver
optNixpkgsIdentifier
                                            Platform
optSystem
                                            (CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo CompilerId
optCompiler AbiTag
NoAbiTag)
                                            FlagAssignment
flags
                                            []
                                            (Package -> GenericPackageDescription
pkgCabal Package
pkg)
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& (DerivationSource -> Identity DerivationSource)
-> Derivation -> Identity Derivation
Lens' Derivation DerivationSource
src ((DerivationSource -> Identity DerivationSource)
 -> Derivation -> Identity Derivation)
-> DerivationSource -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Package -> DerivationSource
pkgSource Package
pkg
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation String String
Lens' Derivation String
subpath ASetter Derivation Derivation String String
-> String -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." Maybe String
optSubpath
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation Bool Bool
Lens' Derivation Bool
runHaddock ASetter Derivation Derivation Bool Bool
-> (Bool -> Bool) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Bool
optHaddock Bool -> Bool -> Bool
&&)
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation Bool Bool
Lens' Derivation Bool
jailbreak ASetter Derivation Derivation Bool Bool
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
optJailbreak
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation Bool Bool
Lens' Derivation Bool
hyperlinkSource ASetter Derivation Derivation Bool Bool
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
optHyperlinkSource
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation Bool Bool
Lens' Derivation Bool
enableLibraryProfiling ASetter Derivation Derivation Bool Bool
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
optEnableProfiling Bool -> Bool -> Bool
|| Bool
optEnableLibraryProfiling)
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation Bool Bool
Lens' Derivation Bool
enableExecutableProfiling ASetter Derivation Derivation Bool Bool
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
optEnableProfiling Bool -> Bool -> Bool
|| Bool
optEnableExecutableProfiling)
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& (Meta -> Identity Meta) -> Derivation -> Identity Derivation
Lens' Derivation Meta
metaSection((Meta -> Identity Meta) -> Derivation -> Identity Derivation)
-> ((Set Identifier -> Identity (Set Identifier))
    -> Meta -> Identity Meta)
-> (Set Identifier -> Identity (Set Identifier))
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set Identifier -> Identity (Set Identifier))
-> Meta -> Identity Meta
Lens' Meta (Set Identifier)
maintainers ((Set Identifier -> Identity (Set Identifier))
 -> Derivation -> Identity Derivation)
-> Set Identifier -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
Set.fromList ((String -> Identifier) -> [String] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Tagged String (Identity String)
 -> Tagged Identifier (Identity Identifier))
-> String -> Identifier
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Tagged String (Identity String)
-> Tagged Identifier (Identity Identifier)
Iso' Identifier String
ident) [String]
optMaintainer)
--            & metaSection.platforms .~ Set.fromList optPlatform
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation Bool Bool
Lens' Derivation Bool
doCheck ASetter Derivation Derivation Bool Bool
-> Bool -> Derivation -> Derivation
forall s t. ASetter s t Bool Bool -> Bool -> s -> t
&&~ Bool
optDoCheck
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation Bool Bool
Lens' Derivation Bool
doBenchmark ASetter Derivation Derivation Bool Bool
-> Bool -> Derivation -> Derivation
forall s t. ASetter s t Bool Bool -> Bool -> s -> t
||~ Bool
optDoBenchmark
              Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& (Set Binding -> Identity (Set Binding))
-> Derivation -> Identity Derivation
Lens' Derivation (Set Binding)
extraFunctionArgs ((Set Binding -> Identity (Set Binding))
 -> Derivation -> Identity Derivation)
-> (Set Binding -> Set Binding) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Set Binding -> Set Binding -> Set Binding
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Binding] -> Set Binding
forall a. Ord a => [a] -> Set a
Set.fromList (Binding
"inherit lib"Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
:(String -> Binding) -> [String] -> [Binding]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Binding
forall a. IsString a => String -> a
fromString (String -> Binding) -> (String -> String) -> String -> Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"inherit " String -> String -> String
forall a. [a] -> [a] -> [a]
++)) [String]
optExtraArgs))

      shell :: Doc
      shell :: Doc
shell = [Doc] -> Doc
vcat
              [ String -> Doc
text String
"{ nixpkgs ? import <nixpkgs> {}, compiler ? \"default\", doBenchmark ? false }:"
              , String -> Doc
text String
""
              , String -> Doc
text String
"let"
              , String -> Doc
text String
""
              , String -> Doc
text String
"  inherit (nixpkgs) pkgs;"
              , String -> Doc
text String
""
              , [Doc] -> Doc
hcat [ String -> Doc
text String
"  f = ", Derivation -> Doc
forall a. Pretty a => a -> Doc
pPrint Derivation
deriv, Doc
semi ]
              , String -> Doc
text String
""
              , String -> Doc
text String
"  haskellPackages = if compiler == \"default\""
              , String -> Doc
text String
"                       then pkgs.haskellPackages"
              , String -> Doc
text String
"                       else pkgs.haskell.packages.${compiler};"
              , String -> Doc
text String
""
              , String -> Doc
text String
"  variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;"
              , String -> Doc
text String
""
              , String -> Doc
text String
"  drv = variant (haskellPackages.callPackage f {});"
              , String -> Doc
text String
""
              , String -> Doc
text String
"in"
              , String -> Doc
text String
""
              , String -> Doc
text String
"  if pkgs.lib.inNixShell then drv.env else drv"
              ]
  Either Doc Derivation -> IO (Either Doc Derivation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Doc Derivation -> IO (Either Doc Derivation))
-> Either Doc Derivation -> IO (Either Doc Derivation)
forall a b. (a -> b) -> a -> b
$ if Bool
optNixShellOutput then Doc -> Either Doc Derivation
forall a b. a -> Either a b
Left Doc
shell else Derivation -> Either Doc Derivation
forall a b. b -> Either a b
Right Derivation
deriv

cabal2nix :: [String] -> IO ()
cabal2nix :: [String] -> IO ()
cabal2nix = [String] -> IO Options
parseArgs ([String] -> IO Options) -> (Options -> IO ()) -> [String] -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Options -> IO (Either Doc Derivation)
cabal2nix' (Options -> IO (Either Doc Derivation))
-> (Either Doc Derivation -> IO ()) -> Options -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> IO ()
putStrLn (String -> IO ())
-> (Either Doc Derivation -> String)
-> Either Doc Derivation
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> String)
-> (Derivation -> String) -> Either Doc Derivation -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Doc -> String
render Derivation -> String
forall a. Pretty a => a -> String
prettyShow

parseArgs :: [String] -> IO Options
parseArgs :: [String] -> IO Options
parseArgs = ParserResult Options -> IO Options
forall a. ParserResult a -> IO a
handleParseResult (ParserResult Options -> IO Options)
-> ([String] -> ParserResult Options) -> [String] -> IO Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs
-> ParserInfo Options -> [String] -> ParserResult Options
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure ParserPrefs
defaultPrefs ParserInfo Options
pinfo

-- Utils

readFlagList :: [String] -> FlagAssignment
readFlagList :: [String] -> FlagAssignment
readFlagList = [(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment ([(FlagName, Bool)] -> FlagAssignment)
-> ([String] -> [(FlagName, Bool)]) -> [String] -> FlagAssignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (FlagName, Bool)) -> [String] -> [(FlagName, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (FlagName, Bool)
tagWithValue
  where tagWithValue :: String -> (FlagName, Bool)
tagWithValue (Char
'-':String
fname) = (String -> FlagName
mkFlagName (String -> String
lowercase String
fname), Bool
False)
        tagWithValue String
fname       = (String -> FlagName
mkFlagName (String -> String
lowercase String
fname), Bool
True)