    {-# 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           Control.Monad
    import           Data.Char
    import           Data.Maybe
    import           Data.List
    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
    import           Hpack.Syntax.Dependencies

    renderPackage :: [String] -> Package -> String
    renderPackage oldCabalFile = renderPackageWith settings alignment formattingHintsFieldOrder formattingHintsSectionsFieldOrder
      where
        FormattingHints{..} = sniffFormattingHints oldCabalFile
        alignment = fromMaybe 16 formattingHintsAlignment
        settings = formattingHintsRenderSettings

    renderPackageWith :: RenderSettings -> Alignment -> [String] -> [(String, [String])] -> Package -> String
    renderPackageWith settings headerFieldsAlignment existingFieldOrder sectionsFieldOrder Package{..} = intercalate "\n" (unlines header : chunks)
      where
        chunks :: [String]
        chunks = map unlines . filter (not . null) . map (render settings 0) $ sortStanzaFields sectionsFieldOrder stanzas

        header :: [String]
        header = concatMap (render settings {renderSettingsFieldAlignment = headerFieldsAlignment} 0) packageFields

        packageFields :: [Element]
        packageFields = addVerbatim packageVerbatim . sortFieldsBy existingFieldOrder $
          headerFields ++ [
            Field "extra-source-files" (renderPaths packageExtraSourceFiles)
          , Field "extra-doc-files" (renderPaths packageExtraDocFiles)
          , Field "data-files" (renderPaths packageDataFiles)
          ] ++ maybe [] (return . Field "data-dir" . Literal) packageDataDir

        sourceRepository :: [Element]
        sourceRepository = maybe [] (return . renderSourceRepository) packageSourceRepository

        customSetup :: [Element]
        customSetup = maybe [] (return . renderCustomSetup) packageCustomSetup

        library :: [Element]
        library = maybe [] (return . renderLibrary) packageLibrary

        stanzas :: [Element]
        stanzas = concat [
            sourceRepository
          , customSetup
          , map renderFlag packageFlags
          , library
          , renderInternalLibraries packageInternalLibraries
          , renderExecutables packageExecutables
          , renderTests packageTests
          , renderBenchmarks packageBenchmarks
          ]

        headerFields :: [Element]
        headerFields = mapMaybe (\(name, value) -> Field name . Literal <$> value) $ [
            ("name", Just packageName)
          , ("version", Just packageVersion)
          , ("synopsis", packageSynopsis)
          , ("description", (formatDescription headerFieldsAlignment <$> packageDescription))
          , ("category", packageCategory)
          , ("stability", packageStability)
          , ("homepage", packageHomepage)
          , ("bug-reports", packageBugReports)
          , ("author", formatList packageAuthor)
          , ("maintainer", formatList packageMaintainer)
          , ("copyright", formatList packageCopyright)
          , ("license", packageLicense)
          , case packageLicenseFile of
              [file] -> ("license-file", Just file)
              files  -> ("license-files", formatList files)
          , ("tested-with", packageTestedWith)
          , ("build-type", Just (show packageBuildType))
          ]

        formatList :: [String] -> Maybe String
        formatList xs = guard (not $ null xs) >> (Just $ intercalate separator xs)
          where
            separator = let Alignment n = headerFieldsAlignment in ",\n" ++ replicate n ' '

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

    formatDescription :: Alignment -> String -> String
    formatDescription (Alignment alignment) description = case map emptyLineToDot $ lines description of
      x : xs -> intercalate "\n" (x : map (indentation ++) xs)
      [] -> ""
      where
        n = max alignment (length ("description: " :: String))
        indentation = replicate n ' '

        emptyLineToDot xs
          | isEmptyLine xs = "."
          | otherwise = xs

        isEmptyLine = all isSpace

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

    renderFlag :: Flag -> Element
    renderFlag Flag {..} = Stanza ("flag " ++ flagName) $ description ++ [
        Field "manual" (Literal $ show flagManual)
      , Field "default" (Literal $ show flagDefault)
      ]
      where
        description = maybe [] (return . Field "description" . Literal) flagDescription

    renderInternalLibraries :: Map String (Section Library) -> [Element]
    renderInternalLibraries = map renderInternalLibrary . Map.toList

    renderInternalLibrary :: (String, Section Library) -> Element
    renderInternalLibrary (name, sect) =
      Stanza ("library " ++ name) (renderLibrarySection sect)

    renderExecutables :: Map String (Section Executable) -> [Element]
    renderExecutables = map renderExecutable . Map.toList

    renderExecutable :: (String, Section Executable) -> Element
    renderExecutable (name, sect@(sectionData -> Executable{..})) =
      Stanza ("executable " ++ name) (renderExecutableSection [] sect)

    renderTests :: Map String (Section Executable) -> [Element]
    renderTests = map renderTest . Map.toList

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

    renderBenchmarks :: Map String (Section Executable) -> [Element]
    renderBenchmarks = map renderBenchmark . Map.toList

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

    renderExecutableSection :: [Element] -> Section Executable -> [Element]
    renderExecutableSection extraFields = renderSection renderExecutableFields extraFields [defaultLanguage]

    renderExecutableFields :: Executable -> [Element]
    renderExecutableFields Executable{..} = mainIs ++ [otherModules, generatedModules]
      where
        mainIs = maybe [] (return . Field "main-is" . Literal) executableMain
        otherModules = renderOtherModules executableOtherModules
        generatedModules = renderGeneratedModules executableGeneratedModules

    renderCustomSetup :: CustomSetup -> Element
    renderCustomSetup CustomSetup{..} =
      Stanza "custom-setup" $ renderDependencies "setup-depends" customSetupDependencies

    renderLibrary :: Section Library -> Element
    renderLibrary sect = Stanza "library" $ renderLibrarySection sect

    renderLibrarySection :: Section Library -> [Element]
    renderLibrarySection = renderSection renderLibraryFields [] [defaultLanguage]

    renderLibraryFields :: Library -> [Element]
    renderLibraryFields Library{..} =
      maybe [] (return . renderExposed) libraryExposed ++ [
        renderExposedModules libraryExposedModules
      , renderOtherModules libraryOtherModules
      , renderGeneratedModules libraryGeneratedModules
      , renderReexportedModules libraryReexportedModules
      , renderSignatures librarySignatures
      ]

    renderExposed :: Bool -> Element
    renderExposed = Field "exposed" . Literal . show

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

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

    filterVerbatim :: [Verbatim] -> [Element] -> [Element]
    filterVerbatim verbatim = filter p
      where
        p :: Element -> Bool
        p = \ case
          Field name _ -> name `notElem` fields
          _ -> True
        fields = concatMap verbatimFieldNames verbatim

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

    renderVerbatim :: [Verbatim] -> [Element]
    renderVerbatim = concatMap $ \ case
      VerbatimLiteral s -> [Verbatim s]
      VerbatimObject o -> renderVerbatimObject o

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

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

    defaultLanguage :: Element
    defaultLanguage = Field "default-language" "Haskell2010"

    renderDirectories :: String -> [String] -> Element
    renderDirectories name = Field name . LineSeparatedList . replaceDots
      where
        replaceDots = map replaceDot
        replaceDot xs = case xs of
          "." -> "./."
          _ -> xs

    renderExposedModules :: [String] -> Element
    renderExposedModules = Field "exposed-modules" . LineSeparatedList

    renderOtherModules :: [String] -> Element
    renderOtherModules = Field "other-modules" . LineSeparatedList

    renderGeneratedModules :: [String] -> Element
    renderGeneratedModules = Field "autogen-modules" . LineSeparatedList

    renderReexportedModules :: [String] -> Element
    renderReexportedModules = Field "reexported-modules" . LineSeparatedList

    renderSignatures :: [String] -> Element
    renderSignatures = Field "signatures" . CommaSeparatedList

    renderDependencies :: String -> Dependencies -> [Element]
    renderDependencies name deps = [
        Field name (CommaSeparatedList renderedDeps)
      , Field "mixins" (CommaSeparatedList $ concat mixins)
      ]
      where
        (renderedDeps, mixins) = unzip . map renderDependency . Map.toList $ unDependencies deps

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

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

    renderVersionConstraint :: VersionConstraint -> String
    renderVersionConstraint version = case version of
      AnyVersion -> ""
      VersionRange x -> " " ++ x

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

    data RenderBuildTool = BuildTools String | BuildToolDepends String

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

    renderSystemBuildTools :: SystemBuildTools -> [String]
    renderSystemBuildTools = map renderSystemBuildTool . Map.toList . unSystemBuildTools

    renderSystemBuildTool :: (String, VersionConstraint) -> String
    renderSystemBuildTool (name, constraint) = name ++ renderVersionConstraint constraint

    renderGhcOptions :: [GhcOption] -> Element
    renderGhcOptions = Field "ghc-options" . WordList

    renderGhcProfOptions :: [GhcProfOption] -> Element
    renderGhcProfOptions = Field "ghc-prof-options" . WordList

    renderGhcjsOptions :: [GhcjsOption] -> Element
    renderGhcjsOptions = Field "ghcjs-options" . WordList

    renderCppOptions :: [CppOption] -> Element
    renderCppOptions = Field "cpp-options" . WordList

    renderCcOptions :: [CcOption] -> Element
    renderCcOptions = Field "cc-options" . WordList

    renderCxxOptions :: [CxxOption] -> Element
    renderCxxOptions = Field "cxx-options" . WordList

    renderLdOptions :: [LdOption] -> Element
    renderLdOptions = Field "ld-options" . WordList

    renderBuildable :: Bool -> Element
    renderBuildable = Field "buildable" . Literal . show

    renderDefaultExtensions :: [String] -> Element
    renderDefaultExtensions = Field "default-extensions" . WordList

    renderOtherExtensions :: [String] -> Element
    renderOtherExtensions = Field "other-extensions" . WordList

    renderPaths :: [Path] -> Value
    renderPaths = LineSeparatedList . map renderPath
      where
        renderPath :: Path -> FilePath
        renderPath (Path path)
          | needsQuoting path = show path
          | otherwise = path

        needsQuoting :: FilePath -> Bool
        needsQuoting = any (\x -> isSpace x || x == ',')