content: {-# language LambdaCase #-}
  {-# language OverloadedStrings #-}
  {-# language RecordWildCards #-}
  {-# language ViewPatterns #-}
  module Main
    ( main
    )
    where
  
  import Control.Applicative ( (<**>) )
  import Data.Foldable ( for_ )
  import Data.String ( fromString )
  import System.Directory ( createDirectoryIfMissing )
  import System.FilePath
    ( (</>), (<.>), dropTrailingPathSeparator, normalise
    , splitDirectories, splitFileName, takeDirectory
    )
  
  import CabalToDhall
    ( KnownDefault, PreludeReference (..), getDefault )
  import DhallToCabal.FactorType
    ( KnownType (..), factored )
  import DhallToCabal.Util
    ( relativeTo )
  
  import qualified Data.Text.Prettyprint.Doc as Pretty
  import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
  import qualified Dhall.Core
  import qualified Dhall.Core as Expr ( Expr(..) )
  import qualified Dhall.Lint as Lint
  import qualified Dhall.Parser
  import qualified Options.Applicative as OptParse
  import qualified System.IO
  
  
  data MetaOptions = MetaOptions
    { prefix :: FilePath }
  
  
  metaOptionsParser :: OptParse.Parser MetaOptions
  metaOptionsParser =
    MetaOptions
      <$>
        OptParse.strOption
          ( mconcat
              [ OptParse.long "prefix"
              , OptParse.value "dhall/"
              , OptParse.metavar "PATH"
              ]
          )
  
  
  defaultFile :: KnownDefault -> FilePath
  defaultFile typ = "./defaults" </> show typ <.> "dhall"
  
  
  typeFile :: KnownType -> FilePath
  typeFile = \case
    Library -> "types/Library.dhall"
    ForeignLibrary -> "types/ForeignLibrary.dhall"
    Benchmark -> "types/Benchmark.dhall"
    Executable -> "types/Executable.dhall"
    TestSuite -> "types/TestSuite.dhall"
    BuildInfo -> "types/BuildInfo.dhall"
    Config -> "types/Config.dhall"
    SourceRepo -> "types/SourceRepo.dhall"
    RepoType -> "types/RepoType.dhall"
    RepoKind -> "types/RepoKind.dhall"
    Compiler -> "types/Compiler.dhall"
    OS -> "types/OS.dhall"
    Extension -> "types/Extension.dhall"
    CompilerOptions -> "types/CompilerOptions.dhall"
    Arch -> "types/Arch.dhall"
    Language -> "types/Language.dhall"
    License -> "types/License.dhall"
    BuildType -> "types/BuildType.dhall"
    Package -> "types/Package.dhall"
    VersionRange -> "types/VersionRange.dhall"
    Version -> "types/Version.dhall"
    SPDX -> "types/SPDX.dhall"
    LicenseId -> "types/SPDX/LicenseId.dhall"
    LicenseExceptionId -> "types/SPDX/LicenseExceptionId.dhall"
    Scope -> "types/Scope.dhall"
    ModuleRenaming -> "types/ModuleRenaming.dhall"
    ForeignLibOption -> "types/ForeignLibOption.dhall"
    ForeignLibType -> "types/ForeignLibType.dhall"
    SetupBuildInfo -> "types/SetupBuildInfo.dhall"
    Dependency -> "types/Dependency.dhall"
    TestType -> "types/TestType.dhall"
    Mixin -> "types/Mixin.dhall"
    Flag -> "types/Flag.dhall"
    PkgconfigVersionRange -> "types/PkgconfigVersionRange.dhall"
    LibraryName -> "types/LibraryName.dhall"
    LibraryVisibility -> "types/LibraryVisibility.dhall"
  
  
  importFile :: FilePath -> Dhall.Core.Import
  importFile ( splitFileName -> ( directory, filename ) ) =
    let
      rawComponents =
        fromString <$>
          splitDirectories ( dropTrailingPathSeparator directory )
      ( components, relativity ) =
        case rawComponents of
          ".." : rest -> ( rest, Dhall.Core.Parent )
          -- `splitFileName "foo"` produces (".", "foo"). It'd be OK to
          -- leave the dot component in, but we might as well remove it
          -- for neatness.
          "." : rest -> ( rest, Dhall.Core.Here )
          _ -> ( rawComponents, Dhall.Core.Here )
    in
      Dhall.Core.Import
        { Dhall.Core.importHashed =
            Dhall.Core.ImportHashed
              { Dhall.Core.hash =
                  Nothing
              , Dhall.Core.importType =
                  Dhall.Core.Local
                    relativity
                    ( Dhall.Core.File
                       ( Dhall.Core.Directory ( reverse components ) )
                       ( fromString filename )
                    )
              }
        , Dhall.Core.importMode =
            Dhall.Core.Code
        }
  
  
  writeOutput :: FilePath -> Dhall.Core.Expr s Dhall.Core.Import -> IO ()
  writeOutput dest expr =
    System.IO.withFile dest System.IO.WriteMode $ \ hnd -> do
      System.IO.hPutStrLn hnd $
           "-- This file is auto-generated by dhall-to-cabal-meta. Look but"
        ++ " don't touch (unless you want your edits to be over-written)."
      Pretty.renderIO
        hnd
        ( Pretty.layoutSmart prettyOpts
            ( Pretty.pretty expr )
        )
      -- Pretty.renderIO doesn't give us a final newline, so add that ourselves.
      System.IO.hPutStr hnd "\n"
  
  
  meta :: MetaOptions -> IO ()
  meta (MetaOptions {..}) = do
    putStrLn $
      "Generating defaults and types underneath " ++ prefix ++ "."
  
    putStrLn "Generating types..."
  
    for_ [ minBound .. maxBound ] $ \ knownType -> do
      let
        localDest =
          typeFile knownType
  
        expr =
          importFile . relativeTo localDest . typeFile <$> factored knownType
  
        dest =
          prefix </> localDest
  
      putStrLn $
        "  Writing type for " ++ show knownType ++ " to " ++ dest ++ "."
  
      createDirectoryIfMissing True ( takeDirectory dest )
  
      writeOutput dest expr
  
    putStrLn "Generating defaults..."
  
    for_ [ minBound .. maxBound ] $ \ defaultType -> do
      let localDest =
            defaultFile defaultType
  
          -- normalise for prettiness in display (otherwise we get /./ components)
          dest =
            normalise ( prefix </> localDest )
  
          resolve = \case
            PreludeDefault typ ->
              Expr.Embed
                ( importFile ( relativeTo localDest ( defaultFile typ ) ) )
            PreludeConstructorsLicense ->
              Expr.Var "types" `Expr.Field` "License"
            PreludeConstructorsRepoKind ->
              Expr.Var "types" `Expr.Field` "RepoKind"
            PreludeConstructorsScope ->
              Expr.Var "types" `Expr.Field` "Scope"
            PreludeConstructorsLibraryVisibility ->
              Expr.Var "types" `Expr.Field` "LibraryVisibility"
            PreludeV ->
              Expr.Embed
                ( importFile ( relativeTo localDest "./Version/v.dhall" ) )
  
          expr :: Expr.Expr Dhall.Parser.Src Dhall.Core.Import
          expr =
            getDefault
              ( importFile ( relativeTo localDest "./types.dhall" ) )
              resolve
              defaultType
  
      putStrLn $
        "  Writing default for " ++ show defaultType ++ " to " ++ dest ++ "."
  
      createDirectoryIfMissing True ( takeDirectory dest )
  
      writeOutput dest ( Lint.lint expr )
  
  
  -- Shamelessly taken from dhall-format
  prettyOpts :: Pretty.LayoutOptions
  prettyOpts =
    Pretty.defaultLayoutOptions
      { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }
  
  
  main :: IO ()
  main = do
    metaOpts <-
      OptParse.execParser opts
  
    meta metaOpts
  
    where
  
    opts =
      OptParse.info ( metaOptionsParser <**> OptParse.helper ) mempty
  