{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
module Hpack.Render (
-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
-- other tools.  It is not meant for general use by end users.  The following
-- caveats apply:
--
-- * The API is undocumented, consult the source instead.
--
-- * The exposed types and functions primarily serve Hpack's own needs, not
-- that of a public API.  Breaking changes can happen as Hpack evolves.
--
-- As an Hpack user you either want to use the @hpack@ executable or a build
-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@).

  renderPackage
, renderPackageWith
, defaultRenderSettings
, RenderSettings(..)
, Alignment(..)
, CommaStyle(..)
#ifdef TEST
, renderConditional
, renderDependencies
, renderLibraryFields
, renderExecutableFields
, renderFlag
, renderSourceRepository
, renderDirectories
, formatDescription
#endif
) where

import           Imports

import           Data.Char
import           Data.Maybe
import           Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map

import           Hpack.Util
import           Hpack.Config
import           Hpack.Render.Hints
import           Hpack.Render.Dsl

renderPackage :: [String] -> Package -> String
renderPackage :: [String] -> Package -> String
renderPackage [String]
oldCabalFile = RenderSettings
-> Alignment
-> [String]
-> [(String, [String])]
-> Package
-> String
renderPackageWith RenderSettings
settings Alignment
alignment [String]
formattingHintsFieldOrder [(String, [String])]
formattingHintsSectionsFieldOrder
  where
    FormattingHints{[String]
[(String, [String])]
Maybe Alignment
RenderSettings
formattingHintsRenderSettings :: FormattingHints -> RenderSettings
formattingHintsAlignment :: FormattingHints -> Maybe Alignment
formattingHintsSectionsFieldOrder :: FormattingHints -> [(String, [String])]
formattingHintsFieldOrder :: FormattingHints -> [String]
formattingHintsRenderSettings :: RenderSettings
formattingHintsAlignment :: Maybe Alignment
formattingHintsSectionsFieldOrder :: [(String, [String])]
formattingHintsFieldOrder :: [String]
..} = [String] -> FormattingHints
sniffFormattingHints [String]
oldCabalFile
    alignment :: Alignment
alignment = Alignment -> Maybe Alignment -> Alignment
forall a. a -> Maybe a -> a
fromMaybe Alignment
16 Maybe Alignment
formattingHintsAlignment
    settings :: RenderSettings
settings = RenderSettings
formattingHintsRenderSettings

renderPackageWith :: RenderSettings -> Alignment -> [String] -> [(String, [String])] -> Package -> String
renderPackageWith :: RenderSettings
-> Alignment
-> [String]
-> [(String, [String])]
-> Package
-> String
renderPackageWith RenderSettings
settings Alignment
headerFieldsAlignment [String]
existingFieldOrder [(String, [String])]
sectionsFieldOrder Package{String
[String]
[Path]
[Flag]
[Verbatim]
Maybe String
Maybe SourceRepository
Maybe (Section Library)
Maybe CustomSetup
Map String (Section Executable)
Map String (Section Library)
BuildType
packageVerbatim :: Package -> [Verbatim]
packageBenchmarks :: Package -> Map String (Section Executable)
packageTests :: Package -> Map String (Section Executable)
packageExecutables :: Package -> Map String (Section Executable)
packageInternalLibraries :: Package -> Map String (Section Library)
packageLibrary :: Package -> Maybe (Section Library)
packageCustomSetup :: Package -> Maybe CustomSetup
packageSourceRepository :: Package -> Maybe SourceRepository
packageDataDir :: Package -> Maybe String
packageDataFiles :: Package -> [Path]
packageExtraDocFiles :: Package -> [Path]
packageExtraSourceFiles :: Package -> [Path]
packageFlags :: Package -> [Flag]
packageTestedWith :: Package -> [String]
packageLicenseFile :: Package -> [String]
packageLicense :: Package -> Maybe String
packageBuildType :: Package -> BuildType
packageCopyright :: Package -> [String]
packageMaintainer :: Package -> [String]
packageAuthor :: Package -> [String]
packageStability :: Package -> Maybe String
packageCategory :: Package -> Maybe String
packageBugReports :: Package -> Maybe String
packageHomepage :: Package -> Maybe String
packageDescription :: Package -> Maybe String
packageSynopsis :: Package -> Maybe String
packageVersion :: Package -> String
packageName :: Package -> String
packageVerbatim :: [Verbatim]
packageBenchmarks :: Map String (Section Executable)
packageTests :: Map String (Section Executable)
packageExecutables :: Map String (Section Executable)
packageInternalLibraries :: Map String (Section Library)
packageLibrary :: Maybe (Section Library)
packageCustomSetup :: Maybe CustomSetup
packageSourceRepository :: Maybe SourceRepository
packageDataDir :: Maybe String
packageDataFiles :: [Path]
packageExtraDocFiles :: [Path]
packageExtraSourceFiles :: [Path]
packageFlags :: [Flag]
packageTestedWith :: [String]
packageLicenseFile :: [String]
packageLicense :: Maybe String
packageBuildType :: BuildType
packageCopyright :: [String]
packageMaintainer :: [String]
packageAuthor :: [String]
packageStability :: Maybe String
packageCategory :: Maybe String
packageBugReports :: Maybe String
packageHomepage :: Maybe String
packageDescription :: Maybe String
packageSynopsis :: Maybe String
packageVersion :: String
packageName :: String
..} = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String
unlines [String]
header String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
chunks)
  where
    chunks :: [String]
    chunks :: [String]
chunks = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines ([[String]] -> [String])
-> ([Element] -> [[String]]) -> [Element] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[String]] -> [[String]])
-> ([Element] -> [[String]]) -> [Element] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> [String]) -> [Element] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (RenderSettings -> Nesting -> Element -> [String]
render RenderSettings
settings Nesting
0) ([Element] -> [String]) -> [Element] -> [String]
forall a b. (a -> b) -> a -> b
$ [(String, [String])] -> [Element] -> [Element]
sortStanzaFields [(String, [String])]
sectionsFieldOrder [Element]
stanzas

    header :: [String]
    header :: [String]
header = (Element -> [String]) -> [Element] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RenderSettings -> Nesting -> Element -> [String]
render RenderSettings
settings {renderSettingsFieldAlignment :: Alignment
renderSettingsFieldAlignment = Alignment
headerFieldsAlignment} Nesting
0) [Element]
packageFields

    packageFields :: [Element]
    packageFields :: [Element]
packageFields = [Verbatim] -> [Element] -> [Element]
addVerbatim [Verbatim]
packageVerbatim ([Element] -> [Element])
-> ([Element] -> [Element]) -> [Element] -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Element] -> [Element]
sortFieldsBy [String]
existingFieldOrder ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$
      [Element]
headerFields [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [
        String -> Value -> Element
Field String
"tested-with" (Value -> Element) -> Value -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Value
CommaSeparatedList [String]
packageTestedWith
      , String -> Value -> Element
Field String
"extra-source-files" ([Path] -> Value
renderPaths [Path]
packageExtraSourceFiles)
      , String -> Value -> Element
Field String
"extra-doc-files" ([Path] -> Value
renderPaths [Path]
packageExtraDocFiles)
      , String -> Value -> Element
Field String
"data-files" ([Path] -> Value
renderPaths [Path]
packageDataFiles)
      ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element])
-> (String -> Element) -> String -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Element
Field String
"data-dir" (Value -> Element) -> (String -> Value) -> String -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal) Maybe String
packageDataDir

    sourceRepository :: [Element]
    sourceRepository :: [Element]
sourceRepository = [Element]
-> (SourceRepository -> [Element])
-> Maybe SourceRepository
-> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element])
-> (SourceRepository -> Element) -> SourceRepository -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRepository -> Element
renderSourceRepository) Maybe SourceRepository
packageSourceRepository

    customSetup :: [Element]
    customSetup :: [Element]
customSetup = [Element]
-> (CustomSetup -> [Element]) -> Maybe CustomSetup -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element])
-> (CustomSetup -> Element) -> CustomSetup -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomSetup -> Element
renderCustomSetup) Maybe CustomSetup
packageCustomSetup

    library :: [Element]
    library :: [Element]
library = [Element]
-> (Section Library -> [Element])
-> Maybe (Section Library)
-> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element])
-> (Section Library -> Element) -> Section Library -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section Library -> Element
renderLibrary) Maybe (Section Library)
packageLibrary

    stanzas :: [Element]
    stanzas :: [Element]
stanzas = [[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        [Element]
sourceRepository
      , [Element]
customSetup
      , (Flag -> Element) -> [Flag] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Flag -> Element
renderFlag [Flag]
packageFlags
      , [Element]
library
      , Map String (Section Library) -> [Element]
renderInternalLibraries Map String (Section Library)
packageInternalLibraries
      , Map String (Section Executable) -> [Element]
renderExecutables Map String (Section Executable)
packageExecutables
      , Map String (Section Executable) -> [Element]
renderTests Map String (Section Executable)
packageTests
      , Map String (Section Executable) -> [Element]
renderBenchmarks Map String (Section Executable)
packageBenchmarks
      ]

    headerFields :: [Element]
    headerFields :: [Element]
headerFields = ((String, Maybe String) -> Maybe Element)
-> [(String, Maybe String)] -> [Element]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(String
name, Maybe String
value) -> String -> Value -> Element
Field String
name (Value -> Element) -> (String -> Value) -> String -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal (String -> Element) -> Maybe String -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
value) ([(String, Maybe String)] -> [Element])
-> [(String, Maybe String)] -> [Element]
forall a b. (a -> b) -> a -> b
$ [
        (String
"name", String -> Maybe String
forall a. a -> Maybe a
Just String
packageName)
      , (String
"version", String -> Maybe String
forall a. a -> Maybe a
Just String
packageVersion)
      , (String
"synopsis", Maybe String
packageSynopsis)
      , (String
"description", (Alignment -> String -> String
formatDescription Alignment
headerFieldsAlignment (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
packageDescription))
      , (String
"category", Maybe String
packageCategory)
      , (String
"stability", Maybe String
packageStability)
      , (String
"homepage", Maybe String
packageHomepage)
      , (String
"bug-reports", Maybe String
packageBugReports)
      , (String
"author", [String] -> Maybe String
formatList [String]
packageAuthor)
      , (String
"maintainer", [String] -> Maybe String
formatList [String]
packageMaintainer)
      , (String
"copyright", [String] -> Maybe String
formatList [String]
packageCopyright)
      , (String
"license", Maybe String
packageLicense)
      , case [String]
packageLicenseFile of
          [String
file] -> (String
"license-file", String -> Maybe String
forall a. a -> Maybe a
Just String
file)
          [String]
files  -> (String
"license-files", [String] -> Maybe String
formatList [String]
files)
      , (String
"build-type", String -> Maybe String
forall a. a -> Maybe a
Just (BuildType -> String
forall a. Show a => a -> String
show BuildType
packageBuildType))
      ]

    formatList :: [String] -> Maybe String
    formatList :: [String] -> Maybe String
formatList [String]
xs = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs) Maybe () -> Maybe String -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
separator [String]
xs)
      where
        separator :: String
separator = let Alignment Int
n = Alignment
headerFieldsAlignment in String
",\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '

sortStanzaFields :: [(String, [String])] -> [Element] -> [Element]
sortStanzaFields :: [(String, [String])] -> [Element] -> [Element]
sortStanzaFields [(String, [String])]
sectionsFieldOrder = [Element] -> [Element]
go
  where
    go :: [Element] -> [Element]
go [Element]
sections = case [Element]
sections of
      [] -> []
      Stanza String
name [Element]
fields : [Element]
xs | Just [String]
fieldOrder <- String -> [(String, [String])] -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, [String])]
sectionsFieldOrder -> String -> [Element] -> Element
Stanza String
name ([String] -> [Element] -> [Element]
sortFieldsBy [String]
fieldOrder [Element]
fields) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element] -> [Element]
go [Element]
xs
      Element
x : [Element]
xs -> Element
x Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element] -> [Element]
go [Element]
xs

formatDescription :: Alignment -> String -> String
formatDescription :: Alignment -> String -> String
formatDescription (Alignment Int
alignment) String
description = case (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
emptyLineToDot ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
description of
  String
x : [String]
xs -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
indentation String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
xs)
  [] -> String
""
  where
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
alignment (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String
"description: " :: String))
    indentation :: String
indentation = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '

    emptyLineToDot :: String -> String
emptyLineToDot String
xs
      | String -> Bool
isEmptyLine String
xs = String
"."
      | Bool
otherwise = String
xs

    isEmptyLine :: String -> Bool
isEmptyLine = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace

renderSourceRepository :: SourceRepository -> Element
renderSourceRepository :: SourceRepository -> Element
renderSourceRepository SourceRepository{String
Maybe String
sourceRepositorySubdir :: SourceRepository -> Maybe String
sourceRepositoryUrl :: SourceRepository -> String
sourceRepositorySubdir :: Maybe String
sourceRepositoryUrl :: String
..} = String -> [Element] -> Element
Stanza String
"source-repository head" [
    String -> Value -> Element
Field String
"type" Value
"git"
  , String -> Value -> Element
Field String
"location" (String -> Value
Literal String
sourceRepositoryUrl)
  , String -> Value -> Element
Field String
"subdir" (Value -> (String -> Value) -> Maybe String -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
"" String -> Value
Literal Maybe String
sourceRepositorySubdir)
  ]

renderFlag :: Flag -> Element
renderFlag :: Flag -> Element
renderFlag Flag {Bool
String
Maybe String
flagDefault :: Flag -> Bool
flagManual :: Flag -> Bool
flagDescription :: Flag -> Maybe String
flagName :: Flag -> String
flagDefault :: Bool
flagManual :: Bool
flagDescription :: Maybe String
flagName :: String
..} = String -> [Element] -> Element
Stanza (String
"flag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flagName) ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element]
description [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [
    String -> Value -> Element
Field String
"manual" (String -> Value
Literal (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
flagManual)
  , String -> Value -> Element
Field String
"default" (String -> Value
Literal (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
flagDefault)
  ]
  where
    description :: [Element]
description = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element])
-> (String -> Element) -> String -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Element
Field String
"description" (Value -> Element) -> (String -> Value) -> String -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal) Maybe String
flagDescription

renderInternalLibraries :: Map String (Section Library) -> [Element]
renderInternalLibraries :: Map String (Section Library) -> [Element]
renderInternalLibraries = ((String, Section Library) -> Element)
-> [(String, Section Library)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, Section Library) -> Element
renderInternalLibrary ([(String, Section Library)] -> [Element])
-> (Map String (Section Library) -> [(String, Section Library)])
-> Map String (Section Library)
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Section Library) -> [(String, Section Library)]
forall k a. Map k a -> [(k, a)]
Map.toList

renderInternalLibrary :: (String, Section Library) -> Element
renderInternalLibrary :: (String, Section Library) -> Element
renderInternalLibrary (String
name, Section Library
sect) =
  String -> [Element] -> Element
Stanza (String
"library " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) (Section Library -> [Element]
renderLibrarySection Section Library
sect)

renderExecutables :: Map String (Section Executable) -> [Element]
renderExecutables :: Map String (Section Executable) -> [Element]
renderExecutables = ((String, Section Executable) -> Element)
-> [(String, Section Executable)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, Section Executable) -> Element
renderExecutable ([(String, Section Executable)] -> [Element])
-> (Map String (Section Executable)
    -> [(String, Section Executable)])
-> Map String (Section Executable)
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Section Executable) -> [(String, Section Executable)]
forall k a. Map k a -> [(k, a)]
Map.toList

renderExecutable :: (String, Section Executable) -> Element
renderExecutable :: (String, Section Executable) -> Element
renderExecutable (String
name, Section Executable
sect) =
  String -> [Element] -> Element
Stanza (String
"executable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) ([Element] -> Section Executable -> [Element]
renderExecutableSection [] Section Executable
sect)

renderTests :: Map String (Section Executable) -> [Element]
renderTests :: Map String (Section Executable) -> [Element]
renderTests = ((String, Section Executable) -> Element)
-> [(String, Section Executable)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, Section Executable) -> Element
renderTest ([(String, Section Executable)] -> [Element])
-> (Map String (Section Executable)
    -> [(String, Section Executable)])
-> Map String (Section Executable)
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Section Executable) -> [(String, Section Executable)]
forall k a. Map k a -> [(k, a)]
Map.toList

renderTest :: (String, Section Executable) -> Element
renderTest :: (String, Section Executable) -> Element
renderTest (String
name, Section Executable
sect) =
  String -> [Element] -> Element
Stanza (String
"test-suite " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
    ([Element] -> Section Executable -> [Element]
renderExecutableSection [String -> Value -> Element
Field String
"type" Value
"exitcode-stdio-1.0"] Section Executable
sect)

renderBenchmarks :: Map String (Section Executable) -> [Element]
renderBenchmarks :: Map String (Section Executable) -> [Element]
renderBenchmarks = ((String, Section Executable) -> Element)
-> [(String, Section Executable)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, Section Executable) -> Element
renderBenchmark ([(String, Section Executable)] -> [Element])
-> (Map String (Section Executable)
    -> [(String, Section Executable)])
-> Map String (Section Executable)
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Section Executable) -> [(String, Section Executable)]
forall k a. Map k a -> [(k, a)]
Map.toList

renderBenchmark :: (String, Section Executable) -> Element
renderBenchmark :: (String, Section Executable) -> Element
renderBenchmark (String
name, Section Executable
sect) =
  String -> [Element] -> Element
Stanza (String
"benchmark " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
    ([Element] -> Section Executable -> [Element]
renderExecutableSection [String -> Value -> Element
Field String
"type" Value
"exitcode-stdio-1.0"] Section Executable
sect)

renderExecutableSection :: [Element] -> Section Executable -> [Element]
renderExecutableSection :: [Element] -> Section Executable -> [Element]
renderExecutableSection [Element]
extraFields = (Executable -> [Element])
-> [Element] -> [Element] -> Section Executable -> [Element]
forall a.
(a -> [Element])
-> [Element] -> [Element] -> Section a -> [Element]
renderSection Executable -> [Element]
renderExecutableFields [Element]
extraFields [Element
defaultLanguage]

renderExecutableFields :: Executable -> [Element]
renderExecutableFields :: Executable -> [Element]
renderExecutableFields Executable{[Module]
Maybe String
executableGeneratedModules :: Executable -> [Module]
executableOtherModules :: Executable -> [Module]
executableMain :: Executable -> Maybe String
executableGeneratedModules :: [Module]
executableOtherModules :: [Module]
executableMain :: Maybe String
..} = [Element]
mainIs [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element
otherModules, Element
generatedModules]
  where
    mainIs :: [Element]
mainIs = [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element])
-> (String -> Element) -> String -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Element
Field String
"main-is" (Value -> Element) -> (String -> Value) -> String -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal) Maybe String
executableMain
    otherModules :: Element
otherModules = [Module] -> Element
renderOtherModules [Module]
executableOtherModules
    generatedModules :: Element
generatedModules = [Module] -> Element
renderGeneratedModules [Module]
executableGeneratedModules

renderCustomSetup :: CustomSetup -> Element
renderCustomSetup :: CustomSetup -> Element
renderCustomSetup CustomSetup{Dependencies
customSetupDependencies :: CustomSetup -> Dependencies
customSetupDependencies :: Dependencies
..} =
  String -> [Element] -> Element
Stanza String
"custom-setup" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ String -> Dependencies -> [Element]
renderDependencies String
"setup-depends" Dependencies
customSetupDependencies

renderLibrary :: Section Library -> Element
renderLibrary :: Section Library -> Element
renderLibrary Section Library
sect = String -> [Element] -> Element
Stanza String
"library" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ Section Library -> [Element]
renderLibrarySection Section Library
sect

renderLibrarySection :: Section Library -> [Element]
renderLibrarySection :: Section Library -> [Element]
renderLibrarySection = (Library -> [Element])
-> [Element] -> [Element] -> Section Library -> [Element]
forall a.
(a -> [Element])
-> [Element] -> [Element] -> Section a -> [Element]
renderSection Library -> [Element]
renderLibraryFields [] [Element
defaultLanguage]

renderLibraryFields :: Library -> [Element]
renderLibraryFields :: Library -> [Element]
renderLibraryFields Library{[String]
[Module]
Maybe Bool
Maybe String
librarySignatures :: Library -> [String]
libraryReexportedModules :: Library -> [String]
libraryGeneratedModules :: Library -> [Module]
libraryOtherModules :: Library -> [Module]
libraryExposedModules :: Library -> [Module]
libraryVisibility :: Library -> Maybe String
libraryExposed :: Library -> Maybe Bool
librarySignatures :: [String]
libraryReexportedModules :: [String]
libraryGeneratedModules :: [Module]
libraryOtherModules :: [Module]
libraryExposedModules :: [Module]
libraryVisibility :: Maybe String
libraryExposed :: Maybe Bool
..} =
  [Element] -> (Bool -> [Element]) -> Maybe Bool -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element]) -> (Bool -> Element) -> Bool -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Element
renderExposed) Maybe Bool
libraryExposed [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
  [Element] -> (String -> [Element]) -> Maybe String -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element])
-> (String -> Element) -> String -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element
renderVisibility) Maybe String
libraryVisibility [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [
    [Module] -> Element
renderExposedModules [Module]
libraryExposedModules
  , [Module] -> Element
renderOtherModules [Module]
libraryOtherModules
  , [Module] -> Element
renderGeneratedModules [Module]
libraryGeneratedModules
  , [String] -> Element
renderReexportedModules [String]
libraryReexportedModules
  , [String] -> Element
renderSignatures [String]
librarySignatures
  ]

renderExposed :: Bool -> Element
renderExposed :: Bool -> Element
renderExposed = String -> Value -> Element
Field String
"exposed" (Value -> Element) -> (Bool -> Value) -> Bool -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal (String -> Value) -> (Bool -> String) -> Bool -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show

renderVisibility :: String -> Element
renderVisibility :: String -> Element
renderVisibility = String -> Value -> Element
Field String
"visibility" (Value -> Element) -> (String -> Value) -> String -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal

renderSection :: (a -> [Element]) -> [Element] -> [Element] -> Section a -> [Element]
renderSection :: (a -> [Element])
-> [Element] -> [Element] -> Section a -> [Element]
renderSection a -> [Element]
renderSectionData [Element]
extraFieldsStart [Element]
extraFieldsEnd Section{a
[String]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionVerbatim :: forall a. Section a -> [Verbatim]
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionLdOptions :: forall a. Section a -> [String]
sectionInstallIncludes :: forall a. Section a -> [String]
sectionIncludeDirs :: forall a. Section a -> [String]
sectionFrameworks :: forall a. Section a -> [String]
sectionExtraFrameworksDirs :: forall a. Section a -> [String]
sectionExtraLibraries :: forall a. Section a -> [String]
sectionExtraLibDirs :: forall a. Section a -> [String]
sectionJsSources :: forall a. Section a -> [Path]
sectionCxxSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [String]
sectionCSources :: forall a. Section a -> [Path]
sectionCcOptions :: forall a. Section a -> [String]
sectionCppOptions :: forall a. Section a -> [String]
sectionGhcjsOptions :: forall a. Section a -> [String]
sectionGhcProfOptions :: forall a. Section a -> [String]
sectionGhcOptions :: forall a. Section a -> [String]
sectionOtherExtensions :: forall a. Section a -> [String]
sectionDefaultExtensions :: forall a. Section a -> [String]
sectionPkgConfigDependencies :: forall a. Section a -> [String]
sectionDependencies :: forall a. Section a -> Dependencies
sectionSourceDirs :: forall a. Section a -> [String]
sectionData :: forall a. Section a -> a
sectionVerbatim :: [Verbatim]
sectionSystemBuildTools :: SystemBuildTools
sectionBuildTools :: Map BuildTool DependencyVersion
sectionConditionals :: [Conditional (Section a)]
sectionBuildable :: Maybe Bool
sectionLdOptions :: [String]
sectionInstallIncludes :: [String]
sectionIncludeDirs :: [String]
sectionFrameworks :: [String]
sectionExtraFrameworksDirs :: [String]
sectionExtraLibraries :: [String]
sectionExtraLibDirs :: [String]
sectionJsSources :: [Path]
sectionCxxSources :: [Path]
sectionCxxOptions :: [String]
sectionCSources :: [Path]
sectionCcOptions :: [String]
sectionCppOptions :: [String]
sectionGhcjsOptions :: [String]
sectionGhcProfOptions :: [String]
sectionGhcOptions :: [String]
sectionOtherExtensions :: [String]
sectionDefaultExtensions :: [String]
sectionPkgConfigDependencies :: [String]
sectionDependencies :: Dependencies
sectionSourceDirs :: [String]
sectionData :: a
..} = [Verbatim] -> [Element] -> [Element]
addVerbatim [Verbatim]
sectionVerbatim ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$
     [Element]
extraFieldsStart
  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ a -> [Element]
renderSectionData a
sectionData [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [
    String -> [String] -> Element
renderDirectories String
"hs-source-dirs" [String]
sectionSourceDirs
  , [String] -> Element
renderDefaultExtensions [String]
sectionDefaultExtensions
  , [String] -> Element
renderOtherExtensions [String]
sectionOtherExtensions
  , [String] -> Element
renderGhcOptions [String]
sectionGhcOptions
  , [String] -> Element
renderGhcProfOptions [String]
sectionGhcProfOptions
  , [String] -> Element
renderGhcjsOptions [String]
sectionGhcjsOptions
  , [String] -> Element
renderCppOptions [String]
sectionCppOptions
  , [String] -> Element
renderCcOptions [String]
sectionCcOptions
  , [String] -> Element
renderCxxOptions [String]
sectionCxxOptions
  , String -> [String] -> Element
renderDirectories String
"include-dirs" [String]
sectionIncludeDirs
  , String -> Value -> Element
Field String
"install-includes" ([String] -> Value
LineSeparatedList [String]
sectionInstallIncludes)
  , String -> Value -> Element
Field String
"c-sources" ([Path] -> Value
renderPaths [Path]
sectionCSources)
  , String -> Value -> Element
Field String
"cxx-sources" ([Path] -> Value
renderPaths [Path]
sectionCxxSources)
  , String -> Value -> Element
Field String
"js-sources" ([Path] -> Value
renderPaths [Path]
sectionJsSources)
  , String -> [String] -> Element
renderDirectories String
"extra-lib-dirs" [String]
sectionExtraLibDirs
  , String -> Value -> Element
Field String
"extra-libraries" ([String] -> Value
LineSeparatedList [String]
sectionExtraLibraries)
  , String -> [String] -> Element
renderDirectories String
"extra-frameworks-dirs" [String]
sectionExtraFrameworksDirs
  , String -> Value -> Element
Field String
"frameworks" ([String] -> Value
LineSeparatedList [String]
sectionFrameworks)
  , [String] -> Element
renderLdOptions [String]
sectionLdOptions
  , String -> Value -> Element
Field String
"pkgconfig-depends" ([String] -> Value
CommaSeparatedList [String]
sectionPkgConfigDependencies)
  ]
  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ Map BuildTool DependencyVersion -> SystemBuildTools -> [Element]
renderBuildTools Map BuildTool DependencyVersion
sectionBuildTools SystemBuildTools
sectionSystemBuildTools
  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ String -> Dependencies -> [Element]
renderDependencies String
"build-depends" Dependencies
sectionDependencies
  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element] -> (Bool -> [Element]) -> Maybe Bool -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Element -> [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> [Element]) -> (Bool -> Element) -> Bool -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Element
renderBuildable) Maybe Bool
sectionBuildable
  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ (Conditional (Section a) -> Element)
-> [Conditional (Section a)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> [Element]) -> Conditional (Section a) -> Element
forall a. (a -> [Element]) -> Conditional (Section a) -> Element
renderConditional a -> [Element]
renderSectionData) [Conditional (Section a)]
sectionConditionals
  [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
extraFieldsEnd

addVerbatim :: [Verbatim] -> [Element] -> [Element]
addVerbatim :: [Verbatim] -> [Element] -> [Element]
addVerbatim [Verbatim]
verbatim [Element]
fields = [Verbatim] -> [Element] -> [Element]
filterVerbatim [Verbatim]
verbatim [Element]
fields [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Verbatim] -> [Element]
renderVerbatim [Verbatim]
verbatim

filterVerbatim :: [Verbatim] -> [Element] -> [Element]
filterVerbatim :: [Verbatim] -> [Element] -> [Element]
filterVerbatim [Verbatim]
verbatim = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter Element -> Bool
p
  where
    p :: Element -> Bool
    p :: Element -> Bool
p = \ case
      Field String
name Value
_ -> String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
fields
      Element
_ -> Bool
True
    fields :: [String]
fields = (Verbatim -> [String]) -> [Verbatim] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Verbatim -> [String]
verbatimFieldNames [Verbatim]
verbatim

verbatimFieldNames :: Verbatim -> [String]
verbatimFieldNames :: Verbatim -> [String]
verbatimFieldNames Verbatim
verbatim = case Verbatim
verbatim of
  VerbatimLiteral String
_ -> []
  VerbatimObject Map String VerbatimValue
o -> Map String VerbatimValue -> [String]
forall k a. Map k a -> [k]
Map.keys Map String VerbatimValue
o

renderVerbatim :: [Verbatim] -> [Element]
renderVerbatim :: [Verbatim] -> [Element]
renderVerbatim = (Verbatim -> [Element]) -> [Verbatim] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Verbatim -> [Element]) -> [Verbatim] -> [Element])
-> (Verbatim -> [Element]) -> [Verbatim] -> [Element]
forall a b. (a -> b) -> a -> b
$ \ case
  VerbatimLiteral String
s -> [String -> Element
Verbatim String
s]
  VerbatimObject Map String VerbatimValue
o -> Map String VerbatimValue -> [Element]
renderVerbatimObject Map String VerbatimValue
o

renderVerbatimObject :: Map String VerbatimValue -> [Element]
renderVerbatimObject :: Map String VerbatimValue -> [Element]
renderVerbatimObject = ((String, VerbatimValue) -> Element)
-> [(String, VerbatimValue)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, VerbatimValue) -> Element
renderPair ([(String, VerbatimValue)] -> [Element])
-> (Map String VerbatimValue -> [(String, VerbatimValue)])
-> Map String VerbatimValue
-> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String VerbatimValue -> [(String, VerbatimValue)]
forall k a. Map k a -> [(k, a)]
Map.toList
  where
    renderPair :: (String, VerbatimValue) -> Element
renderPair (String
key, VerbatimValue
value) = case String -> [String]
lines (VerbatimValue -> String
verbatimValueToString VerbatimValue
value) of
      [String
x] -> String -> Value -> Element
Field String
key (String -> Value
Literal String
x)
      [String]
xs -> String -> Value -> Element
Field String
key ([String] -> Value
LineSeparatedList [String]
xs)

renderConditional :: (a -> [Element]) -> Conditional (Section a) -> Element
renderConditional :: (a -> [Element]) -> Conditional (Section a) -> Element
renderConditional a -> [Element]
renderSectionData (Conditional Cond
condition Section a
sect Maybe (Section a)
mElse) = case Maybe (Section a)
mElse of
  Maybe (Section a)
Nothing -> Element
if_
  Just Section a
else_ -> Element -> Element -> Element
Group Element
if_ (String -> [Element] -> Element
Stanza String
"else" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (a -> [Element])
-> [Element] -> [Element] -> Section a -> [Element]
forall a.
(a -> [Element])
-> [Element] -> [Element] -> Section a -> [Element]
renderSection a -> [Element]
renderSectionData [] [] Section a
else_)
  where
    if_ :: Element
if_ = String -> [Element] -> Element
Stanza (String
"if " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cond -> String
renderCond Cond
condition) ((a -> [Element])
-> [Element] -> [Element] -> Section a -> [Element]
forall a.
(a -> [Element])
-> [Element] -> [Element] -> Section a -> [Element]
renderSection a -> [Element]
renderSectionData [] [] Section a
sect)

renderCond :: Cond -> String
renderCond :: Cond -> String
renderCond = \ case
  CondExpression String
c -> String
c
  CondBool Bool
True -> String
"true"
  CondBool Bool
False -> String
"false"

defaultLanguage :: Element
defaultLanguage :: Element
defaultLanguage = String -> Value -> Element
Field String
"default-language" Value
"Haskell2010"

renderDirectories :: String -> [String] -> Element
renderDirectories :: String -> [String] -> Element
renderDirectories String
name = String -> Value -> Element
Field String
name (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList ([String] -> Value) -> ([String] -> [String]) -> [String] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
replaceDots
  where
    replaceDots :: [String] -> [String]
replaceDots = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall p. (Eq p, IsString p) => p -> p
replaceDot
    replaceDot :: p -> p
replaceDot p
xs = case p
xs of
      p
"." -> p
"./"
      p
_ -> p
xs

renderExposedModules :: [Module] -> Element
renderExposedModules :: [Module] -> Element
renderExposedModules = String -> Value -> Element
Field String
"exposed-modules" (Value -> Element) -> ([Module] -> Value) -> [Module] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList ([String] -> Value) -> ([Module] -> [String]) -> [Module] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module -> String) -> [Module] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Module -> String
unModule

renderOtherModules :: [Module] -> Element
renderOtherModules :: [Module] -> Element
renderOtherModules = String -> Value -> Element
Field String
"other-modules" (Value -> Element) -> ([Module] -> Value) -> [Module] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList ([String] -> Value) -> ([Module] -> [String]) -> [Module] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module -> String) -> [Module] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Module -> String
unModule

renderGeneratedModules :: [Module] -> Element
renderGeneratedModules :: [Module] -> Element
renderGeneratedModules = String -> Value -> Element
Field String
"autogen-modules" (Value -> Element) -> ([Module] -> Value) -> [Module] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList ([String] -> Value) -> ([Module] -> [String]) -> [Module] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module -> String) -> [Module] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Module -> String
unModule

renderReexportedModules :: [String] -> Element
renderReexportedModules :: [String] -> Element
renderReexportedModules = String -> Value -> Element
Field String
"reexported-modules" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
CommaSeparatedList

renderSignatures :: [String] -> Element
renderSignatures :: [String] -> Element
renderSignatures = String -> Value -> Element
Field String
"signatures" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
CommaSeparatedList

renderDependencies :: String -> Dependencies -> [Element]
renderDependencies :: String -> Dependencies -> [Element]
renderDependencies String
name Dependencies
deps = [
    String -> Value -> Element
Field String
name ([String] -> Value
CommaSeparatedList [String]
renderedDeps)
  , String -> Value -> Element
Field String
"mixins" ([String] -> Value
CommaSeparatedList ([String] -> Value) -> [String] -> Value
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
mixins)
  ]
  where
    ([String]
renderedDeps, [[String]]
mixins) = [(String, [String])] -> ([String], [[String]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, [String])] -> ([String], [[String]]))
-> (Map String DependencyInfo -> [(String, [String])])
-> Map String DependencyInfo
-> ([String], [[String]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, DependencyInfo) -> (String, [String]))
-> [(String, DependencyInfo)] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (String, DependencyInfo) -> (String, [String])
renderDependency ([(String, DependencyInfo)] -> [(String, [String])])
-> (Map String DependencyInfo -> [(String, DependencyInfo)])
-> Map String DependencyInfo
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String DependencyInfo -> [(String, DependencyInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String DependencyInfo -> ([String], [[String]]))
-> Map String DependencyInfo -> ([String], [[String]])
forall a b. (a -> b) -> a -> b
$ Dependencies -> Map String DependencyInfo
unDependencies Dependencies
deps

renderDependency :: (String, DependencyInfo) -> (String, [String])
renderDependency :: (String, DependencyInfo) -> (String, [String])
renderDependency (String
name, DependencyInfo [String]
mixins DependencyVersion
version) = (
      String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ DependencyVersion -> String
renderVersion DependencyVersion
version
    , [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mixin | String
mixin <- [String]
mixins ]
    )

renderVersion :: DependencyVersion -> String
renderVersion :: DependencyVersion -> String
renderVersion (DependencyVersion Maybe SourceDependency
_ VersionConstraint
c) = VersionConstraint -> String
renderVersionConstraint VersionConstraint
c

renderVersionConstraint :: VersionConstraint -> String
renderVersionConstraint :: VersionConstraint -> String
renderVersionConstraint VersionConstraint
version = case VersionConstraint
version of
  VersionConstraint
AnyVersion -> String
""
  VersionRange String
x -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x

renderBuildTools :: Map BuildTool DependencyVersion -> SystemBuildTools -> [Element]
renderBuildTools :: Map BuildTool DependencyVersion -> SystemBuildTools -> [Element]
renderBuildTools (((BuildTool, DependencyVersion) -> RenderBuildTool)
-> [(BuildTool, DependencyVersion)] -> [RenderBuildTool]
forall a b. (a -> b) -> [a] -> [b]
map (BuildTool, DependencyVersion) -> RenderBuildTool
renderBuildTool ([(BuildTool, DependencyVersion)] -> [RenderBuildTool])
-> (Map BuildTool DependencyVersion
    -> [(BuildTool, DependencyVersion)])
-> Map BuildTool DependencyVersion
-> [RenderBuildTool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map BuildTool DependencyVersion -> [(BuildTool, DependencyVersion)]
forall k a. Map k a -> [(k, a)]
Map.toList -> [RenderBuildTool]
xs) SystemBuildTools
systemBuildTools = [
    String -> Value -> Element
Field String
"build-tools" ([String] -> Value
CommaSeparatedList ([String] -> Value) -> [String] -> Value
forall a b. (a -> b) -> a -> b
$ [String
x | BuildTools String
x <- [RenderBuildTool]
xs] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ SystemBuildTools -> [String]
renderSystemBuildTools SystemBuildTools
systemBuildTools)
  , String -> Value -> Element
Field String
"build-tool-depends" ([String] -> Value
CommaSeparatedList [String
x | BuildToolDepends String
x <- [RenderBuildTool]
xs])
  ]

data RenderBuildTool = BuildTools String | BuildToolDepends String

renderBuildTool :: (BuildTool,  DependencyVersion) -> RenderBuildTool
renderBuildTool :: (BuildTool, DependencyVersion) -> RenderBuildTool
renderBuildTool (BuildTool
buildTool, DependencyVersion -> String
renderVersion -> String
version) = case BuildTool
buildTool of
  LocalBuildTool String
executable -> String -> RenderBuildTool
BuildTools (String
executable String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version)
  BuildTool String
pkg String
executable
    | String
pkg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
executable Bool -> Bool -> Bool
&& String
executable String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
knownBuildTools -> String -> RenderBuildTool
BuildTools (String
executable String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version)
    | Bool
otherwise -> String -> RenderBuildTool
BuildToolDepends (String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
executable String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version)
  where
    knownBuildTools :: [String]
    knownBuildTools :: [String]
knownBuildTools = [
        String
"alex"
      , String
"c2hs"
      , String
"cpphs"
      , String
"greencard"
      , String
"haddock"
      , String
"happy"
      , String
"hsc2hs"
      , String
"hscolour"
      ]

renderSystemBuildTools :: SystemBuildTools -> [String]
renderSystemBuildTools :: SystemBuildTools -> [String]
renderSystemBuildTools = ((String, VersionConstraint) -> String)
-> [(String, VersionConstraint)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, VersionConstraint) -> String
renderSystemBuildTool ([(String, VersionConstraint)] -> [String])
-> (SystemBuildTools -> [(String, VersionConstraint)])
-> SystemBuildTools
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String VersionConstraint -> [(String, VersionConstraint)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String VersionConstraint -> [(String, VersionConstraint)])
-> (SystemBuildTools -> Map String VersionConstraint)
-> SystemBuildTools
-> [(String, VersionConstraint)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemBuildTools -> Map String VersionConstraint
unSystemBuildTools

renderSystemBuildTool :: (String, VersionConstraint) -> String
renderSystemBuildTool :: (String, VersionConstraint) -> String
renderSystemBuildTool (String
name, VersionConstraint
constraint) = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ VersionConstraint -> String
renderVersionConstraint VersionConstraint
constraint

renderGhcOptions :: [GhcOption] -> Element
renderGhcOptions :: [String] -> Element
renderGhcOptions = String -> Value -> Element
Field String
"ghc-options" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
WordList

renderGhcProfOptions :: [GhcProfOption] -> Element
renderGhcProfOptions :: [String] -> Element
renderGhcProfOptions = String -> Value -> Element
Field String
"ghc-prof-options" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
WordList

renderGhcjsOptions :: [GhcjsOption] -> Element
renderGhcjsOptions :: [String] -> Element
renderGhcjsOptions = String -> Value -> Element
Field String
"ghcjs-options" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
WordList

renderCppOptions :: [CppOption] -> Element
renderCppOptions :: [String] -> Element
renderCppOptions = String -> Value -> Element
Field String
"cpp-options" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
WordList

renderCcOptions :: [CcOption] -> Element
renderCcOptions :: [String] -> Element
renderCcOptions = String -> Value -> Element
Field String
"cc-options" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
WordList

renderCxxOptions :: [CxxOption] -> Element
renderCxxOptions :: [String] -> Element
renderCxxOptions = String -> Value -> Element
Field String
"cxx-options" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
WordList

renderLdOptions :: [LdOption] -> Element
renderLdOptions :: [String] -> Element
renderLdOptions = String -> Value -> Element
Field String
"ld-options" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
WordList

renderBuildable :: Bool -> Element
renderBuildable :: Bool -> Element
renderBuildable = String -> Value -> Element
Field String
"buildable" (Value -> Element) -> (Bool -> Value) -> Bool -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal (String -> Value) -> (Bool -> String) -> Bool -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show

renderDefaultExtensions :: [String] -> Element
renderDefaultExtensions :: [String] -> Element
renderDefaultExtensions = String -> Value -> Element
Field String
"default-extensions" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList

renderOtherExtensions :: [String] -> Element
renderOtherExtensions :: [String] -> Element
renderOtherExtensions = String -> Value -> Element
Field String
"other-extensions" (Value -> Element) -> ([String] -> Value) -> [String] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList

renderPaths :: [Path] -> Value
renderPaths :: [Path] -> Value
renderPaths = [String] -> Value
LineSeparatedList ([String] -> Value) -> ([Path] -> [String]) -> [Path] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> String) -> [Path] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Path -> String
renderPath
  where
    renderPath :: Path -> FilePath
    renderPath :: Path -> String
renderPath (Path String
path)
      | String -> Bool
needsQuoting String
path = String -> String
forall a. Show a => a -> String
show String
path
      | Bool
otherwise = String
path

    needsQuoting :: FilePath -> Bool
    needsQuoting :: String -> Bool
needsQuoting = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
x -> Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')