{-# 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 hiding (sortFieldsBy)
import qualified Hpack.Render.Dsl as 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 = 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
..} = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String
unlines [String]
header forall a. a -> [a] -> [a]
: [String]
chunks)
  where
    chunks :: [String]
    chunks :: [String]
chunks = forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (RenderSettings -> Nesting -> Element -> [String]
render RenderSettings
settings Nesting
0) forall a b. (a -> b) -> a -> b
$ [(String, [String])] -> [Element] -> [Element]
sortStanzaFields [(String, [String])]
sectionsFieldOrder [Element]
stanzas

    header :: [String]
    header :: [String]
header = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Element] -> [Element]
sortFieldsBy [String]
existingFieldOrder forall a b. (a -> b) -> a -> b
$
      [Element]
headerFields forall a. [a] -> [a] -> [a]
++ [
        String -> Value -> Element
Field String
"tested-with" 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)
      ] forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Element
Field String
"data-dir" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal) Maybe String
packageDataDir

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

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

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

    stanzas :: [Element]
    stanzas :: [Element]
stanzas = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        [Element]
sourceRepository
      , [Element]
customSetup
      , 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(String
name, Maybe String
value) -> String -> Value -> Element
Field String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
value) forall a b. (a -> b) -> a -> b
$ [
        (String
"name", forall a. a -> Maybe a
Just String
packageName)
      , (String
"version", forall a. a -> Maybe a
Just String
packageVersion)
      , (String
"synopsis", Maybe String
packageSynopsis)
      , (String
"description", (Alignment -> String -> String
formatDescription Alignment
headerFieldsAlignment 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", forall a. a -> Maybe a
Just String
file)
          [String]
files  -> (String
"license-files", [String] -> Maybe String
formatList [String]
files)
      , (String
"build-type", forall a. a -> Maybe a
Just (forall a. Show a => a -> String
show BuildType
packageBuildType))
      ]

    formatList :: [String] -> Maybe String
    formatList :: [String] -> Maybe String
formatList [String]
xs = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
separator [String]
xs)
      where
        separator :: String
separator = let Alignment Int
n = Alignment
headerFieldsAlignment in String
",\n" forall a. [a] -> [a] -> [a]
++ 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 <- 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) forall a. a -> [a] -> [a]
: [Element] -> [Element]
go [Element]
xs
      Element
x : [Element]
xs -> Element
x 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 forall a b. (a -> b) -> [a] -> [b]
map String -> String
emptyLineToDot forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
description of
  String
x : [String]
xs -> forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (String
x forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (String
indentation forall a. [a] -> [a] -> [a]
++) [String]
xs)
  [] -> String
""
  where
    n :: Int
n = forall a. Ord a => a -> a -> a
max Int
alignment (forall (t :: * -> *) a. Foldable t => t a -> Int
length (String
"description: " :: String))
    indentation :: String
indentation = 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 = 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" (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 " forall a. [a] -> [a] -> [a]
++ String
flagName) forall a b. (a -> b) -> a -> b
$ [Element]
description forall a. [a] -> [a] -> [a]
++ [
    String -> Value -> Element
Field String
"manual" (String -> Value
Literal forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Bool
flagManual)
  , String -> Value -> Element
Field String
"default" (String -> Value
Literal forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Bool
flagDefault)
  ]
  where
    description :: [Element]
description = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Element
Field String
"description" 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 = forall a b. (a -> b) -> [a] -> [b]
map (String, Section Library) -> Element
renderInternalLibrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 " 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 = forall a b. (a -> b) -> [a] -> [b]
map (String, Section Executable) -> Element
renderExecutable forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 " 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 = forall a b. (a -> b) -> [a] -> [b]
map (String, Section Executable) -> Element
renderTest forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 " 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 = forall a b. (a -> b) -> [a] -> [b]
map (String, Section Executable) -> Element
renderBenchmark forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 " 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 = forall a. (a -> [Element]) -> [Element] -> Section a -> [Element]
renderSection Executable -> [Element]
renderExecutableFields [Element]
extraFields

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 forall a. [a] -> [a] -> [a]
++ [Element
otherModules, Element
generatedModules]
  where
    mainIs :: [Element]
mainIs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Element
Field String
"main-is" 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" 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" forall a b. (a -> b) -> a -> b
$ Section Library -> [Element]
renderLibrarySection Section Library
sect

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

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
..} =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Element
renderExposed) Maybe Bool
libraryExposed forall a. [a] -> [a] -> [a]
++
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element
renderVisibility) Maybe String
libraryVisibility 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

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

renderSection :: (a -> [Element]) -> [Element] -> Section a -> [Element]
renderSection :: forall a. (a -> [Element]) -> [Element] -> Section a -> [Element]
renderSection a -> [Element]
renderSectionData [Element]
extraFieldsStart Section{a
[String]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Maybe Language
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]
sectionGhcSharedOptions :: forall a. Section a -> [String]
sectionGhcProfOptions :: forall a. Section a -> [String]
sectionGhcOptions :: forall a. Section a -> [String]
sectionLanguage :: forall a. Section a -> Maybe Language
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]
sectionGhcSharedOptions :: [String]
sectionGhcProfOptions :: [String]
sectionGhcOptions :: [String]
sectionLanguage :: Maybe Language
sectionOtherExtensions :: [String]
sectionDefaultExtensions :: [String]
sectionPkgConfigDependencies :: [String]
sectionDependencies :: Dependencies
sectionSourceDirs :: [String]
sectionData :: a
..} = [Verbatim] -> [Element] -> [Element]
addVerbatim [Verbatim]
sectionVerbatim forall a b. (a -> b) -> a -> b
$
     [Element]
extraFieldsStart
  forall a. [a] -> [a] -> [a]
++ a -> [Element]
renderSectionData a
sectionData 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
renderGhcSharedOptions [String]
sectionGhcSharedOptions
  , [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)
  ]
  forall a. [a] -> [a] -> [a]
++ Map BuildTool DependencyVersion -> SystemBuildTools -> [Element]
renderBuildTools Map BuildTool DependencyVersion
sectionBuildTools SystemBuildTools
sectionSystemBuildTools
  forall a. [a] -> [a] -> [a]
++ String -> Dependencies -> [Element]
renderDependencies String
"build-depends" Dependencies
sectionDependencies
  forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Element
renderBuildable) Maybe Bool
sectionBuildable
  forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Element
renderLanguage) Maybe Language
sectionLanguage
  forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> [Element]) -> Conditional (Section a) -> Element
renderConditional a -> [Element]
renderSectionData) [Conditional (Section a)]
sectionConditionals

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

filterVerbatim :: [Verbatim] -> [Element] -> [Element]
filterVerbatim :: [Verbatim] -> [Element] -> [Element]
filterVerbatim [Verbatim]
verbatim = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
fields
      Element
_ -> Bool
True
    fields :: [String]
fields = 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 -> forall k a. Map k a -> [k]
Map.keys Map String VerbatimValue
o

renderVerbatim :: [Verbatim] -> [Element]
renderVerbatim :: [Verbatim] -> [Element]
renderVerbatim = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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 = forall a b. (a -> b) -> [a] -> [b]
map (String, VerbatimValue) -> Element
renderPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (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" forall a b. (a -> b) -> a -> b
$ forall a. (a -> [Element]) -> [Element] -> Section a -> [Element]
renderSection a -> [Element]
renderSectionData [] Section a
else_)
  where
    if_ :: Element
if_ = String -> [Element] -> Element
Stanza (String
"if " forall a. [a] -> [a] -> [a]
++ Cond -> String
renderCond Cond
condition) (forall a. (a -> [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"

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

renderExposedModules :: [Module] -> Element
renderExposedModules :: [Module] -> Element
renderExposedModules = String -> Value -> Element
Field String
"exposed-modules" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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" 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" 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
mixins)
  ]
  where
    ([String]
renderedDeps, [[String]]
mixins) = forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String, DependencyInfo) -> (String, [String])
renderDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList 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 forall a. [a] -> [a] -> [a]
++ DependencyVersion -> String
renderVersion DependencyVersion
version
    , [ String
name forall a. [a] -> [a] -> [a]
++ 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
" " forall a. [a] -> [a] -> [a]
++ String
x

renderBuildTools :: Map BuildTool DependencyVersion -> SystemBuildTools -> [Element]
renderBuildTools :: Map BuildTool DependencyVersion -> SystemBuildTools -> [Element]
renderBuildTools (forall a b. (a -> b) -> [a] -> [b]
map (BuildTool, DependencyVersion) -> RenderBuildTool
renderBuildTool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList -> [RenderBuildTool]
xs) SystemBuildTools
systemBuildTools = [
    String -> Value -> Element
Field String
"build-tools" ([String] -> Value
CommaSeparatedList forall a b. (a -> b) -> a -> b
$ [String
x | BuildTools String
x <- [RenderBuildTool]
xs] 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 forall a. [a] -> [a] -> [a]
++ String
version)
  BuildTool String
pkg String
executable
    | String
pkg forall a. Eq a => a -> a -> Bool
== String
executable Bool -> Bool -> Bool
&& String
executable forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
knownBuildTools -> String -> RenderBuildTool
BuildTools (String
executable forall a. [a] -> [a] -> [a]
++ String
version)
    | Bool
otherwise -> String -> RenderBuildTool
BuildToolDepends (String
pkg forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ String
executable 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 = forall a b. (a -> b) -> [a] -> [b]
map (String, VersionConstraint) -> String
renderSystemBuildTool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList 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 forall a. [a] -> [a] -> [a]
++ VersionConstraint -> String
renderVersionConstraint VersionConstraint
constraint

renderLanguage :: Language -> Element
renderLanguage :: Language -> Element
renderLanguage (Language String
lang) = String -> Value -> Element
Field String
"default-language" (String -> Value
Literal String
lang)

renderGhcOptions :: [GhcOption] -> Element
renderGhcOptions :: [String] -> Element
renderGhcOptions = String -> Value -> Element
Field String
"ghc-options" 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
WordList

renderGhcSharedOptions :: [GhcOption] -> Element
renderGhcSharedOptions :: [String] -> Element
renderGhcSharedOptions = String -> Value -> Element
Field String
"ghc-shared-options" 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" 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" 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" 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" 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" 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
Literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

renderDefaultExtensions :: [String] -> Element
renderDefaultExtensions :: [String] -> Element
renderDefaultExtensions = String -> Value -> Element
Field String
"default-extensions" 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Value
LineSeparatedList

renderPaths :: [Path] -> Value
renderPaths :: [Path] -> Value
renderPaths = [String] -> Value
LineSeparatedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Show a => a -> String
show String
path
      | Bool
otherwise = String
path

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

sortFieldsBy :: [String] -> [Element] -> [Element]
sortFieldsBy :: [String] -> [Element] -> [Element]
sortFieldsBy [String]
existingFieldOrder = [String] -> [Element] -> [Element]
Dsl.sortFieldsBy (String
"import" forall a. a -> [a] -> [a]
: [String]
existingFieldOrder)