diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,6 +1,19 @@ # dhall-to-cabal change log -## NEXT +## 1.3.0.0 -- 2018-07-28 + +### Breaking API Changes + +* `DhallToCabal.dhallToCabal` now takes an `InputSettings` from + `dhall` as its first argument. + +### Functional Changes + +* `dhall-to-cabal` has a new `--print-default TYPE` flag. + +* When reading from a file, `dhall-to-cabal` now interprets imports as + being relative to that file, rather than the current working + directory. (#114) ## 1.2.0.0 -- 2018-07-05 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -46,7 +46,7 @@ Good news! `dhall-to-cabal` is currently running a two-for-one deal! By installing `dhall-to-cabal` we'll throw in the `cabal-to-dhall` executable *absolutely free*! `cabal-to-dhall` does the reverse of `dhall-to-cabal` - -taking `.cabal` files and trasforming them into appropriate Dhall expressions. +taking `.cabal` files and transforming them into appropriate Dhall expressions. This can be a great way to get started with `dhall-to-cabal`. ## The Details @@ -116,7 +116,7 @@ `library` field. It's OK if you don't follow all of the above - my goal is to simply get you -familiar with what a Dhall expression would look like. The Dhall lanugage itself +familiar with what a Dhall expression would look like. The Dhall language itself has a [much more detailed tutorial](https://hackage.haskell.org/package/dhall-1.9.1/docs/Dhall-Tutorial.html) and [other documentation](https://github.com/dhall-lang/dhall-lang/wiki). diff --git a/dhall-to-cabal.cabal b/dhall-to-cabal.cabal --- a/dhall-to-cabal.cabal +++ b/dhall-to-cabal.cabal @@ -9,7 +9,7 @@ -- 'dhall-to-cabal -- dhall-to-cabal.dhall > dhall-to-cabal.cabal'. -- * * * * * * * * * * * * WARNING * * * * * * * * * * * * name: dhall-to-cabal -version: 1.2.0.0 +version: 1.3.0.0 license: MIT license-file: LICENSE maintainer: ollie@ocharles.org.uk @@ -24,6 +24,7 @@ (including conditional stanzas). . category: Distribution +build-type: Simple extra-source-files: Changelog.md README.md @@ -132,7 +133,7 @@ bytestring ^>=0.10, containers ^>=0.5 || ^>=0.6, contravariant ^>=1.4 || ^>=1.5, - dhall ^>=1.15.0, + dhall ^>=1.16.0, hashable ^>=1.2.6.1, insert-ordered-containers ^>=0.2.1.0, text ^>=1.2, @@ -156,9 +157,11 @@ build-depends: Cabal ^>=2.2, base ^>=4.10 || ^>=4.11 || ^>=4.12, - dhall ^>=1.15.0, + dhall ^>=1.16.0, dhall-to-cabal -any, + filepath ^>=1.4, insert-ordered-containers ^>=0.2.1.0, + microlens ^>=0.1.0.0 || ^>=0.2.0.0 || ^>=0.3.0.0 || ^>=0.4.0.0, optparse-applicative ^>=0.13.2 || ^>=0.14, prettyprinter ^>=1.2.0.1, text ^>=1.2, @@ -180,13 +183,32 @@ -fno-warn-name-shadowing build-depends: base ^>=4.10 || ^>=4.11 || ^>=4.12, - dhall ^>=1.15.0, + dhall ^>=1.16.0, bytestring ^>=0.10, dhall-to-cabal -any, optparse-applicative ^>=0.13.2 || ^>=0.14, prettyprinter ^>=1.2.0.1, text ^>=1.2 +executable dhall-to-cabal-meta + main-is: Main.hs + scope: private + hs-source-dirs: meta + default-language: Haskell2010 + ghc-options: -Weverything -Wno-safe -Wno-unsafe + -Wno-implicit-prelude -Wno-missed-specialisations + -Wno-all-missed-specialisations -Wno-missing-import-lists + -Wno-missing-local-signatures -Wno-monomorphism-restriction + -fno-warn-name-shadowing + build-depends: + base ^>=4.10 || ^>=4.11 || ^>=4.12, + directory ^>=1.3.0.2, + dhall ^>=1.16.0, + dhall-to-cabal -any, + filepath ^>=1.4, + optparse-applicative ^>=0.13.2 || ^>=0.14, + prettyprinter ^>=1.2.0.1 + test-suite golden-tests type: exitcode-stdio-1.0 main-is: GoldenTests.hs @@ -202,9 +224,10 @@ Cabal ^>=2.2, Diff ^>=0.3.4, bytestring ^>=0.10, - dhall ^>=1.15.0, + dhall ^>=1.16.0, dhall-to-cabal -any, filepath ^>=1.4, + microlens ^>=0.1.0.0 || ^>=0.2.0.0 || ^>=0.3.0.0 || ^>=0.4.0.0, prettyprinter ^>=1.2.0.1, tasty ^>=0.11 || ^>=0.12 || ^>=1.0 || ^>=1.1, tasty-golden ^>=2.3, diff --git a/dhall/defaults/Benchmark.dhall b/dhall/defaults/Benchmark.dhall --- a/dhall/defaults/Benchmark.dhall +++ b/dhall/defaults/Benchmark.dhall @@ -1,1 +1,2 @@ -./BuildInfo.dhall +-- This file is auto-generated by dhall-to-cabal-meta. Look but don't touch (unless you want your edits to be over-written). +let types = ./../types.dhall in ././BuildInfo.dhall diff --git a/dhall/defaults/BuildInfo.dhall b/dhall/defaults/BuildInfo.dhall --- a/dhall/defaults/BuildInfo.dhall +++ b/dhall/defaults/BuildInfo.dhall @@ -1,86 +1,83 @@ -{ autogen-modules = - [] : List Text -, build-depends = - [] : List ../types/Dependency.dhall -, build-tool-depends = - [] : List - { component : - Text - , package : - Text - , version : - ../types/VersionRange.dhall - } -, build-tools = - [] : List { exe : Text, version : ../types/VersionRange.dhall } -, buildable = - True -, c-sources = - [] : List Text -, cc-options = - [] : List Text -, compiler-options = - ./CompilerOptions.dhall -, cpp-options = - [] : List Text -, default-extensions = - [] : List ../types/Extension.dhall -, default-language = - [] : Optional ../types/Language.dhall -, extra-framework-dirs = - [] : List Text -, extra-ghci-libraries = - [] : List Text -, extra-lib-dirs = - [] : List Text -, extra-libraries = - [] : List Text -, frameworks = - [] : List Text -, hs-source-dirs = - [] : List Text -, includes = - [] : List Text -, include-dirs = - [] : List Text -, install-includes = - [] : List Text -, js-sources = - [] : List Text -, ld-options = - [] : List Text -, other-extensions = - [] : List ../types/Extension.dhall -, other-languages = - [] : List ../types/Language.dhall -, other-modules = - [] : List Text -, pkgconfig-depends = - [] : List { name : Text, version : ../types/VersionRange.dhall } -, profiling-options = - ./CompilerOptions.dhall -, shared-options = - ./CompilerOptions.dhall -, static-options = - ./CompilerOptions.dhall -, mixins = - [] : List ../types/Mixin.dhall -, asm-options = - [] : List Text -, asm-sources = - [] : List Text -, cmm-options = - [] : List Text -, cmm-sources = - [] : List Text -, cxx-options = - [] : List Text -, cxx-sources = - [] : List Text -, virtual-modules = - [] : List Text -, extra-lib-flavours = - [] : List Text -, extra-bundled-libs = - [] : List Text -} +-- This file is auto-generated by dhall-to-cabal-meta. Look but don't touch (unless you want your edits to be over-written). + let types = ./../types.dhall + +in { autogen-modules = + [] : List Text + , build-depends = + [] : List { bounds : types.VersionRange, package : Text } + , build-tool-depends = + [] : List + { component : Text, package : Text, version : types.VersionRange } + , build-tools = + [] : List { exe : Text, version : types.VersionRange } + , buildable = + True + , c-sources = + [] : List Text + , cc-options = + [] : List Text + , compiler-options = + ././CompilerOptions.dhall + , cpp-options = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , includes = + [] : List Text + , include-dirs = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List { name : Text, version : types.VersionRange } + , profiling-options = + ././CompilerOptions.dhall + , shared-options = + ././CompilerOptions.dhall + , static-options = + ././CompilerOptions.dhall + , mixins = + [] : List types.Mixin + , asm-options = + [] : List Text + , asm-sources = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , virtual-modules = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-bundled-libs = + [] : List Text + } diff --git a/dhall/defaults/CompilerOptions.dhall b/dhall/defaults/CompilerOptions.dhall --- a/dhall/defaults/CompilerOptions.dhall +++ b/dhall/defaults/CompilerOptions.dhall @@ -1,21 +1,24 @@ -{ GHC = - [] : List Text -, GHCJS = - [] : List Text -, HBC = - [] : List Text -, Helium = - [] : List Text -, Hugs = - [] : List Text -, JHC = - [] : List Text -, LHC = - [] : List Text -, NHC = - [] : List Text -, UHC = - [] : List Text -, YHC = - [] : List Text -} +-- This file is auto-generated by dhall-to-cabal-meta. Look but don't touch (unless you want your edits to be over-written). + let types = ./../types.dhall + +in { GHC = + [] : List Text + , GHCJS = + [] : List Text + , HBC = + [] : List Text + , Helium = + [] : List Text + , Hugs = + [] : List Text + , JHC = + [] : List Text + , LHC = + [] : List Text + , NHC = + [] : List Text + , UHC = + [] : List Text + , YHC = + [] : List Text + } diff --git a/dhall/defaults/Executable.dhall b/dhall/defaults/Executable.dhall --- a/dhall/defaults/Executable.dhall +++ b/dhall/defaults/Executable.dhall @@ -1,2 +1,4 @@ - ./BuildInfo.dhall -⫽ { scope = (constructors ../types/Scope.dhall ).Public {=} } +-- This file is auto-generated by dhall-to-cabal-meta. Look but don't touch (unless you want your edits to be over-written). + let types = ./../types.dhall + +in ././BuildInfo.dhall ⫽ { scope = (constructors types.Scope).Public {=} } diff --git a/dhall/defaults/Library.dhall b/dhall/defaults/Library.dhall --- a/dhall/defaults/Library.dhall +++ b/dhall/defaults/Library.dhall @@ -1,9 +1,16 @@ - ./BuildInfo.dhall -⫽ { exposed-modules = - [] : List Text - , reexported-modules = - [] : List - { name : Text, original : { name : Text, package : Optional Text } } - , signatures = - [] : List Text - } +-- This file is auto-generated by dhall-to-cabal-meta. Look but don't touch (unless you want your edits to be over-written). + let types = ./../types.dhall + +in ././BuildInfo.dhall + ⫽ { exposed-modules = + [] : List Text + , reexported-modules = + [] : List + { name : + Text + , original : + { name : Text, package : Optional Text } + } + , signatures = + [] : List Text + } diff --git a/dhall/defaults/Package.dhall b/dhall/defaults/Package.dhall --- a/dhall/defaults/Package.dhall +++ b/dhall/defaults/Package.dhall @@ -1,91 +1,86 @@ -{ author = - "" -, flags = - [] : List ../types/Flag.dhall -, benchmarks = - [] : List - { benchmark : - ../types/Guarded.dhall ../types/Benchmark.dhall - , name : - Text - } -, bug-reports = - "" -, build-type = - [] : Optional ../types/BuildType.dhall -, cabal-version = - ../Version/v.dhall "2.2" -, category = - "" -, copyright = - "" -, data-dir = - "" -, data-files = - [] : List Text -, description = - "" -, executables = - [] : List - { executable : - ../types/Guarded.dhall ../types/Executable.dhall - , name : - Text - } -, extra-doc-files = - [] : List Text -, extra-source-files = - [] : List Text -, extra-tmp-files = - [] : List Text -, foreign-libraries = - [] : List - { foreign-lib : - ../types/Guarded.dhall ../types/ForeignLibrary.dhall - , name : - Text - } -, homepage = - "" -, library = - [] : Optional (../types/Guarded.dhall ../types/Library.dhall ) -, license = - (constructors ../types/License.dhall ).AllRightsReserved {=} -, license-files = - [] : List Text -, maintainer = - "" -, package-url = - "" -, source-repos = - [] : List ../types/SourceRepo.dhall -, stability = - "" -, sub-libraries = - [] : List - { library : - ../types/Guarded.dhall ../types/Library.dhall - , name : - Text - } -, synopsis = - "" -, test-suites = - [] : List - { name : - Text - , test-suite : - ../types/Guarded.dhall ../types/TestSuite.dhall - } -, tested-with = - [] : List - { compiler : - ../types/Compiler.dhall - , version : - ../types/VersionRange.dhall - } -, x-fields = - [] : List { _1 : Text, _2 : Text } -, custom-setup = - [] : Optional ../types/SetupBuildInfo.dhall -} +-- This file is auto-generated by dhall-to-cabal-meta. Look but don't touch (unless you want your edits to be over-written). + let types = ./../types.dhall + +in { author = + "" + , flags = + [] : List + { default : Bool, description : Text, manual : Bool, name : Text } + , benchmarks = + [] : List + { name : + Text + , benchmark : + ∀(config : types.Config) → types.Benchmark + } + , bug-reports = + "" + , build-type = + [] : Optional types.BuildType + , cabal-version = + ./../Version/v.dhall "2.2" + , category = + "" + , copyright = + "" + , data-dir = + "" + , data-files = + [] : List Text + , description = + "" + , executables = + [] : List + { name : + Text + , executable : + ∀(config : types.Config) → types.Executable + } + , extra-doc-files = + [] : List Text + , extra-source-files = + [] : List Text + , extra-tmp-files = + [] : List Text + , foreign-libraries = + [] : List + { name : + Text + , foreign-lib : + ∀(config : types.Config) → types.ForeignLibrary + } + , homepage = + "" + , library = + [] : Optional (∀(config : types.Config) → types.Library) + , license = + (constructors types.License).AllRightsReserved {=} + , license-files = + [] : List Text + , maintainer = + "" + , package-url = + "" + , source-repos = + [] : List types.SourceRepo + , stability = + "" + , sub-libraries = + [] : List + { name : Text, library : ∀(config : types.Config) → types.Library } + , synopsis = + "" + , test-suites = + [] : List + { name : + Text + , test-suite : + ∀(config : types.Config) → types.TestSuite + } + , tested-with = + [] : List { compiler : types.Compiler, version : types.VersionRange } + , x-fields = + [] : List { _1 : Text, _2 : Text } + , custom-setup = + [] : Optional types.CustomSetup + } diff --git a/dhall/defaults/SourceRepo.dhall b/dhall/defaults/SourceRepo.dhall --- a/dhall/defaults/SourceRepo.dhall +++ b/dhall/defaults/SourceRepo.dhall @@ -1,15 +1,18 @@ -{ type = - [] : Optional ../types/RepoType.dhall -, location = - [] : Optional Text -, module = - [] : Optional Text -, branch = - [] : Optional Text -, tag = - [] : Optional Text -, subdir = - [] : Optional Text -, kind = - (constructors ../types/RepoKind.dhall ).RepoHead {=} -} +-- This file is auto-generated by dhall-to-cabal-meta. Look but don't touch (unless you want your edits to be over-written). + let types = ./../types.dhall + +in { type = + [] : Optional types.RepoType + , location = + [] : Optional Text + , module = + [] : Optional Text + , branch = + [] : Optional Text + , tag = + [] : Optional Text + , subdir = + [] : Optional Text + , kind = + (constructors types.RepoKind).RepoHead {=} + } diff --git a/dhall/defaults/TestSuite.dhall b/dhall/defaults/TestSuite.dhall --- a/dhall/defaults/TestSuite.dhall +++ b/dhall/defaults/TestSuite.dhall @@ -1,1 +1,2 @@ -./BuildInfo.dhall +-- This file is auto-generated by dhall-to-cabal-meta. Look but don't touch (unless you want your edits to be over-written). +let types = ./../types.dhall in ././BuildInfo.dhall diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -22,8 +22,11 @@ import Data.Text (Text) import Data.String ( fromString ) import Data.Version ( showVersion ) +import Lens.Micro ( set ) +import System.FilePath ( takeDirectory ) -import DhallLocation ( typesLocation, dhallFromGitHub ) +import CabalToDhall ( KnownDefault, getDefault, resolvePreludeVar ) +import DhallLocation ( preludeLocation, typesLocation, dhallFromGitHub ) import DhallToCabal import qualified Paths_dhall_to_cabal as Paths @@ -47,6 +50,7 @@ data Command = RunDhallToCabal DhallToCabalOptions | PrintType PrintTypeOptions + | PrintDefault PrintDefaultOptions | PrintVersion @@ -170,6 +174,24 @@ ) +data PrintDefaultOptions = + PrintDefaultOptions + { defaultToPrint :: KnownDefault } + + +printDefaultOptionsParser :: OptParse.Parser PrintDefaultOptions +printDefaultOptionsParser = + PrintDefaultOptions + <$> + OptParse.option OptParse.auto + ( mconcat + [ OptParse.long "print-default" + , OptParse.help "Print out the default values for a type, as found in prelude.defaults" + , OptParse.metavar "TYPE" + ] + ) + + runDhallToCabal :: DhallToCabalOptions -> IO () runDhallToCabal DhallToCabalOptions { dhallFilePath, explain } = do source <- @@ -181,10 +203,12 @@ StrictText.readFile filePath let - fileName = fromMaybe "(STDIN)" dhallFilePath + settings = Dhall.defaultInputSettings + & set Dhall.rootDirectory ( maybe "." takeDirectory dhallFilePath ) + & set Dhall.sourceName ( fromMaybe "(STDIN)" dhallFilePath ) explaining - ( dhallToCabal fileName source + ( dhallToCabal settings source & fmap ( \ pkgDesc -> pkgDesc & Cabal.showGenericPackageDescription @@ -254,6 +278,9 @@ PrintType options -> printType options + PrintDefault options -> + printDefault options + PrintVersion -> printVersion @@ -263,6 +290,7 @@ asum [ RunDhallToCabal <$> dhallToCabalOptionsParser , PrintType <$> printTypeOptionsParser + , PrintDefault <$> printDefaultOptionsParser , PrintVersion <$ printVersionParser ] @@ -679,3 +707,25 @@ printVersion :: IO () printVersion = do putStrLn ( "dhall-to-cabal version " ++ showVersion Paths.version ) + + +printDefault :: PrintDefaultOptions -> IO () +printDefault PrintDefaultOptions {..} = do + Pretty.renderIO + System.IO.stdout + ( Pretty.layoutSmart opts + ( Pretty.pretty ( withPreludeImport expr ) ) + ) + + putStrLn "" + + where + withPreludeImport = + Expr.Let "prelude" Nothing ( Expr.Embed ( preludeLocation dhallFromGitHub ) ) + + expr :: Expr.Expr Dhall.Parser.Src Dhall.Import + expr = + getDefault + ( typesLocation dhallFromGitHub ) + resolvePreludeVar + defaultToPrint diff --git a/golden-tests/GoldenTests.hs b/golden-tests/GoldenTests.hs --- a/golden-tests/GoldenTests.hs +++ b/golden-tests/GoldenTests.hs @@ -5,7 +5,8 @@ import Data.Algorithm.Diff import Data.Algorithm.DiffOutput import Data.Function ( (&) ) -import System.FilePath ( takeBaseName, replaceExtension ) +import Lens.Micro ( set ) +import System.FilePath ( takeBaseName, takeDirectory, replaceExtension ) import Test.Tasty ( defaultMain, TestTree, testGroup ) import Test.Tasty.Golden ( findByExtension, goldenVsStringDiff ) import Test.Tasty.Golden.Advanced ( goldenTest ) @@ -15,6 +16,7 @@ import qualified Data.Text.Lazy.Encoding as LazyText import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty +import qualified Dhall import qualified Dhall.Core import qualified Distribution.PackageDescription.Parsec as Cabal import qualified Distribution.PackageDescription.PrettyPrint as Cabal @@ -91,7 +93,7 @@ [ goldenTest ( takeBaseName dhallFile ) ( Cabal.readGenericPackageDescription Cabal.normal cabalFile ) - ( StrictText.readFile dhallFile >>= dhallToCabal dhallFile ) + ( StrictText.readFile dhallFile >>= dhallToCabal settings ) ( \ ( Cabal.showGenericPackageDescription -> exp ) ( Cabal.showGenericPackageDescription -> act ) -> do if exp == act then return Nothing @@ -105,6 +107,9 @@ ( Cabal.writeGenericPackageDescription cabalFile ) | dhallFile <- dhallFiles , let cabalFile = replaceExtension dhallFile ".cabal" + settings = Dhall.defaultInputSettings + & set Dhall.rootDirectory ( takeDirectory dhallFile ) + & set Dhall.sourceName dhallFile ] , testGroup "cabal-to-dhall" [ goldenVsStringDiff diff --git a/golden-tests/dhall-to-cabal/SPDX.dhall b/golden-tests/dhall-to-cabal/SPDX.dhall --- a/golden-tests/dhall-to-cabal/SPDX.dhall +++ b/golden-tests/dhall-to-cabal/SPDX.dhall @@ -1,5 +1,5 @@ - let prelude = ./dhall/prelude.dhall -in let types = ./dhall/types.dhall + let prelude = ../../dhall/prelude.dhall +in let types = ../../dhall/types.dhall in prelude.defaults.Package // { name = "foo" , version = prelude.v "0" diff --git a/golden-tests/dhall-to-cabal/compiler-options-order.dhall b/golden-tests/dhall-to-cabal/compiler-options-order.dhall --- a/golden-tests/dhall-to-cabal/compiler-options-order.dhall +++ b/golden-tests/dhall-to-cabal/compiler-options-order.dhall @@ -1,6 +1,6 @@ - let prelude = ./dhall/prelude.dhall + let prelude = ../../dhall/prelude.dhall -in let types = ./dhall/types.dhall +in let types = ../../dhall/types.dhall in let v = prelude.v @@ -8,11 +8,11 @@ \ ( cfg : types.Config ) -> \ ( ver : types.VersionRange ) -> cfg.impl ( prelude.types.Compilers.GHC {=} ) ver -in ./dhall/defaults/Package.dhall +in ../../dhall/defaults/Package.dhall // { name = "Name" , version = - ./dhall/Version/v.dhall "1" + ../../dhall/Version/v.dhall "1" , library = [ \ ( config : types.Config ) -> prelude.defaults.Library diff --git a/golden-tests/dhall-to-cabal/conditional-dependencies.dhall b/golden-tests/dhall-to-cabal/conditional-dependencies.dhall --- a/golden-tests/dhall-to-cabal/conditional-dependencies.dhall +++ b/golden-tests/dhall-to-cabal/conditional-dependencies.dhall @@ -1,6 +1,6 @@ - let prelude = ./dhall/prelude.dhall + let prelude = ../../dhall/prelude.dhall -in let types = ./dhall/types.dhall +in let types = ../../dhall/types.dhall in let v = prelude.v @@ -8,11 +8,11 @@ \ ( cfg : types.Config ) -> \ ( ver : types.VersionRange ) -> cfg.impl ( prelude.types.Compilers.GHC {=} ) ver -in ./dhall/defaults/Package.dhall +in ../../dhall/defaults/Package.dhall // { name = "Name" , version = - ./dhall/Version/v.dhall "1" + ../../dhall/Version/v.dhall "1" , library = [ \ ( config : types.Config ) -> prelude.defaults.Library diff --git a/golden-tests/dhall-to-cabal/dhall-to-cabal.dhall b/golden-tests/dhall-to-cabal/dhall-to-cabal.dhall --- a/golden-tests/dhall-to-cabal/dhall-to-cabal.dhall +++ b/golden-tests/dhall-to-cabal/dhall-to-cabal.dhall @@ -1,6 +1,6 @@ - let prelude = ./dhall/prelude.dhall + let prelude = ../../dhall/prelude.dhall -in let types = ./dhall/types.dhall +in let types = ../../dhall/types.dhall in let v = prelude.v diff --git a/golden-tests/dhall-to-cabal/empty-package.dhall b/golden-tests/dhall-to-cabal/empty-package.dhall --- a/golden-tests/dhall-to-cabal/empty-package.dhall +++ b/golden-tests/dhall-to-cabal/empty-package.dhall @@ -1,14 +1,14 @@ - ./dhall/defaults/Package.dhall + ../../dhall/defaults/Package.dhall ⫽ { name = "Name" , version = - ./dhall/Version/v.dhall "1" + ../../dhall/Version/v.dhall "1" , executables = [ { name = "foo" , executable = - λ(config : ./dhall/types/Config.dhall) - → ./dhall/defaults/Executable.dhall + λ(config : ../../dhall/types/Config.dhall) + → ../../dhall/defaults/Executable.dhall ⫽ { main-is = "Main.hs" } } ] diff --git a/golden-tests/dhall-to-cabal/gh-53.dhall b/golden-tests/dhall-to-cabal/gh-53.dhall --- a/golden-tests/dhall-to-cabal/gh-53.dhall +++ b/golden-tests/dhall-to-cabal/gh-53.dhall @@ -1,6 +1,6 @@ - let prelude = ./dhall/prelude.dhall + let prelude = ../../dhall/prelude.dhall -in let types = ./dhall/types.dhall +in let types = ../../dhall/types.dhall in prelude.defaults.Package ⫽ { cabal-version = diff --git a/golden-tests/dhall-to-cabal/gh-55.dhall b/golden-tests/dhall-to-cabal/gh-55.dhall --- a/golden-tests/dhall-to-cabal/gh-55.dhall +++ b/golden-tests/dhall-to-cabal/gh-55.dhall @@ -1,6 +1,6 @@ - let prelude = ./dhall/prelude.dhall + let prelude = ../../dhall/prelude.dhall -in let types = ./dhall/types.dhall +in let types = ../../dhall/types.dhall in let v = prelude.v @@ -8,11 +8,11 @@ \ ( cfg : types.Config ) -> \ ( ver : types.VersionRange ) -> cfg.impl ( prelude.types.Compilers.GHC {=} ) ver -in ./dhall/defaults/Package.dhall +in ../../dhall/defaults/Package.dhall // { name = "Name" , version = - ./dhall/Version/v.dhall "1" + ../../dhall/Version/v.dhall "1" , library = [ \ ( config : types.Config ) -> prelude.defaults.Library @@ -27,6 +27,6 @@ ( if ghcImpl config ( prelude.orLaterVersion ( v "7.1.3" ) ) then [ "-DCOND1" ] else [ ] : List Text ) } - ] : Optional ( ./dhall/types/Guarded.dhall types.Library ) + ] : Optional ( ../../dhall/types/Guarded.dhall types.Library ) } diff --git a/golden-tests/dhall-to-cabal/map-source-repo.dhall b/golden-tests/dhall-to-cabal/map-source-repo.dhall --- a/golden-tests/dhall-to-cabal/map-source-repo.dhall +++ b/golden-tests/dhall-to-cabal/map-source-repo.dhall @@ -1,6 +1,6 @@ - let prelude = ./dhall/prelude.dhall + let prelude = ../../dhall/prelude.dhall -in let types = ./dhall/types.dhall +in let types = ../../dhall/types.dhall in let updateRepo = prelude.utils.mapSourceRepos @@ -24,8 +24,8 @@ [ { name = "foo" , executable = - λ(config : ./dhall/types/Config.dhall) - → ./dhall/defaults/Executable.dhall + λ(config : ../../dhall/types/Config.dhall) + → ../../dhall/defaults/Executable.dhall ⫽ { main-is = "Main.hs" } } ] diff --git a/golden-tests/dhall-to-cabal/nested-conditions.dhall b/golden-tests/dhall-to-cabal/nested-conditions.dhall --- a/golden-tests/dhall-to-cabal/nested-conditions.dhall +++ b/golden-tests/dhall-to-cabal/nested-conditions.dhall @@ -1,5 +1,5 @@ - let prelude = ./dhall/prelude.dhall -in let types = ./dhall/types.dhall + let prelude = ../../dhall/prelude.dhall +in let types = ../../dhall/types.dhall in let v = prelude.v in prelude.defaults.Package // { name = "foo" diff --git a/lib/CabalToDhall.hs b/lib/CabalToDhall.hs --- a/lib/CabalToDhall.hs +++ b/lib/CabalToDhall.hs @@ -1,6 +1,7 @@ {-# language FlexibleInstances #-} {-# language GeneralizedNewtypeDeriving #-} {-# language LambdaCase #-} +{-# language MultiWayIf #-} {-# language NamedFieldPuns #-} {-# language OverloadedStrings #-} {-# language ViewPatterns #-} @@ -8,6 +9,10 @@ module CabalToDhall ( cabalToDhall , parseGenericPackageDescriptionThrows + , KnownDefault (..) + , PreludeReference (..) + , resolvePreludeVar + , getDefault ) where import Data.Foldable ( foldMap ) @@ -106,9 +111,90 @@ genericPackageDescription -type Default s a = Map.InsOrdHashMap StrictText.Text ( Expr.Expr s a ) +-- Note: the Show instance is used by --print-type. +data KnownDefault + = CompilerOptions + | BuildInfo + | Library + | Executable + | Benchmark + | TestSuite + | Package + | SourceRepo + deriving ( Bounded, Enum, Eq, Ord, Read, Show ) +data PreludeReference + = PreludeDefault KnownDefault + | PreludeConstructorsLicense + | PreludeConstructorsRepoKind + | PreludeConstructorsScope + | PreludeV + + +resolvePreludeVar :: PreludeReference -> Expr.Expr s a +resolvePreludeVar = \case + PreludeDefault typ -> + Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` StrictText.pack ( show typ ) + PreludeV -> + Expr.Var "prelude" `Expr.Field` "v" + PreludeConstructorsLicense -> + Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "Licenses" + PreludeConstructorsRepoKind -> + Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "RepoKind" + PreludeConstructorsScope -> + Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "Scopes" + + +type Default s a + = ( PreludeReference -> Expr.Expr s a ) + -> Map.InsOrdHashMap StrictText.Text ( Expr.Expr s a ) + + +getDefault + :: ( Eq s ) + => Dhall.Core.Import + -> ( PreludeReference -> Expr.Expr s Dhall.Core.Import ) + -> KnownDefault + -> Expr.Expr s Dhall.Core.Import +getDefault typesLoc resolve typ = withTypesImport expr + where + withTypesImport = + Expr.Let "types" Nothing ( Expr.Embed typesLoc ) + + factorBuildInfo fields = + let + shared = Map.filter id ( Map.intersectionWith (==) fields ( buildInfoDefault resolve ) ) + in + if | null shared + -> Expr.RecordLit fields + | null ( Map.difference fields shared ) + -> resolve ( PreludeDefault BuildInfo ) + | otherwise + -> Expr.Prefer + ( resolve ( PreludeDefault BuildInfo ) ) + ( Expr.RecordLit ( Map.difference fields shared ) ) + + expr = + case typ of + CompilerOptions -> + Expr.RecordLit ( compilerOptionsDefault resolve ) + BuildInfo -> + Expr.RecordLit ( buildInfoDefault resolve ) + Library -> + factorBuildInfo ( libraryDefault resolve ) + Executable -> + factorBuildInfo ( executableDefault resolve ) + Benchmark -> + factorBuildInfo ( benchmarkDefault resolve ) + TestSuite -> + factorBuildInfo ( testSuiteDefault resolve ) + Package -> + Expr.RecordLit ( packageDefault resolve ) + SourceRepo -> + Expr.RecordLit ( sourceRepoDefault resolve ) + + emptyListDefault :: StrictText.Text -> Expr.Expr s a @@ -135,8 +221,12 @@ ) +generaliseDeclared = + Dhall.Core.denote . fmap Dhall.TypeCheck.absurd . Dhall.declared + + compilerOptionsDefault :: Default s a -compilerOptionsDefault = +compilerOptionsDefault _resolve = ( Map.fromList [ emptyListDefault "GHC" Expr.Text , emptyListDefault "GHCJS" Expr.Text @@ -152,81 +242,86 @@ ) -buildInfoDefault :: Default Dhall.Parser.Src Dhall.TypeCheck.X -buildInfoDefault = Map.fromList - [ emptyListDefault "autogen-modules" Expr.Text - , emptyListDefault "build-depends" ( Dhall.declared dependency ) - , emptyListDefault "build-tool-depends" ( Dhall.declared exeDependency ) - , emptyListDefault "build-tools" ( Dhall.declared legacyExeDependency ) - , ( "buildable", Expr.BoolLit True ) - , emptyListDefault "c-sources" Expr.Text - , emptyListDefault "cc-options" Expr.Text - , ( "compiler-options", Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` "CompilerOptions" ) - , emptyListDefault "cpp-options" Expr.Text - , emptyListDefault "default-extensions" ( Dhall.declared extension ) - , emptyOptionalDefault "default-language" ( Dhall.declared language ) - , emptyListDefault "extra-framework-dirs" Expr.Text - , emptyListDefault "extra-ghci-libraries" Expr.Text - , emptyListDefault "extra-lib-dirs" Expr.Text - , emptyListDefault "extra-libraries" Expr.Text - , emptyListDefault "frameworks" Expr.Text - , emptyListDefault "hs-source-dirs" Expr.Text - , emptyListDefault "includes" Expr.Text - , emptyListDefault "include-dirs" Expr.Text - , emptyListDefault "install-includes" Expr.Text - , emptyListDefault "js-sources" Expr.Text - , emptyListDefault "ld-options" Expr.Text - , emptyListDefault "other-extensions" ( Dhall.declared extension ) - , emptyListDefault "other-languages" ( Dhall.declared language ) - , emptyListDefault "other-modules" Expr.Text - , emptyListDefault "pkgconfig-depends" ( Dhall.declared pkgconfigDependency ) - , ( "profiling-options", Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` "CompilerOptions" ) - , ( "shared-options", Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` "CompilerOptions" ) - , ( "static-options", Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` "CompilerOptions" ) - , emptyListDefault "mixins" ( Dhall.declared mixin ) - , emptyListDefault "asm-options" Expr.Text - , emptyListDefault "asm-sources" Expr.Text - , emptyListDefault "cmm-options" Expr.Text - , emptyListDefault "cmm-sources" Expr.Text - , emptyListDefault "cxx-options" Expr.Text - , emptyListDefault "cxx-sources" Expr.Text - , emptyListDefault "virtual-modules" Expr.Text - , emptyListDefault "extra-lib-flavours" Expr.Text - , emptyListDefault "extra-bundled-libs" Expr.Text - ] +buildInfoDefault :: Default s a +buildInfoDefault resolve = fields + where + fields = Map.fromList + [ emptyListDefault "autogen-modules" Expr.Text + , emptyListDefault "build-depends" ( generaliseDeclared dependency ) + , emptyListDefault "build-tool-depends" ( generaliseDeclared exeDependency ) + , emptyListDefault "build-tools" + ( generaliseDeclared legacyExeDependency ) + , ( "buildable", Expr.BoolLit True ) + , emptyListDefault "c-sources" Expr.Text + , emptyListDefault "cc-options" Expr.Text + , ( "compiler-options", resolve ( PreludeDefault CompilerOptions ) ) + , emptyListDefault "cpp-options" Expr.Text + , emptyListDefault "default-extensions" ( generaliseDeclared extension ) + , emptyOptionalDefault "default-language" ( generaliseDeclared language ) + , emptyListDefault "extra-framework-dirs" Expr.Text + , emptyListDefault "extra-ghci-libraries" Expr.Text + , emptyListDefault "extra-lib-dirs" Expr.Text + , emptyListDefault "extra-libraries" Expr.Text + , emptyListDefault "frameworks" Expr.Text + , emptyListDefault "hs-source-dirs" Expr.Text + , emptyListDefault "includes" Expr.Text + , emptyListDefault "include-dirs" Expr.Text + , emptyListDefault "install-includes" Expr.Text + , emptyListDefault "js-sources" Expr.Text + , emptyListDefault "ld-options" Expr.Text + , emptyListDefault "other-extensions" ( generaliseDeclared extension ) + , emptyListDefault "other-languages" ( generaliseDeclared language ) + , emptyListDefault "other-modules" Expr.Text + , emptyListDefault "pkgconfig-depends" ( generaliseDeclared pkgconfigDependency ) + , ( "profiling-options", resolve ( PreludeDefault CompilerOptions ) ) + , ( "shared-options", resolve ( PreludeDefault CompilerOptions ) ) + , ( "static-options", resolve ( PreludeDefault CompilerOptions ) ) + , emptyListDefault "mixins" ( generaliseDeclared mixin ) + , emptyListDefault "asm-options" Expr.Text + , emptyListDefault "asm-sources" Expr.Text + , emptyListDefault "cmm-options" Expr.Text + , emptyListDefault "cmm-sources" Expr.Text + , emptyListDefault "cxx-options" Expr.Text + , emptyListDefault "cxx-sources" Expr.Text + , emptyListDefault "virtual-modules" Expr.Text + , emptyListDefault "extra-lib-flavours" Expr.Text + , emptyListDefault "extra-bundled-libs" Expr.Text + ] -libraryDefault :: Default Dhall.Parser.Src Dhall.TypeCheck.X -libraryDefault = buildInfoDefault <> specificFields +libraryDefault :: Default s a +libraryDefault resolve = buildInfoDefault resolve <> specificFields where specificFields = Map.fromList [ emptyListDefault "exposed-modules" Expr.Text , emptyListDefault "other-modules" Expr.Text - , emptyListDefault "reexported-modules" ( Dhall.declared moduleReexport ) + , emptyListDefault "reexported-modules" + ( generaliseDeclared moduleReexport ) , emptyListDefault "signatures" Expr.Text ] -benchmarkDefault :: Default Dhall.Parser.Src Dhall.TypeCheck.X +benchmarkDefault :: Default s a benchmarkDefault = buildInfoDefault -testSuiteDefault :: Default Dhall.Parser.Src Dhall.TypeCheck.X +testSuiteDefault :: Default s a testSuiteDefault = buildInfoDefault -executableDefault :: Default Dhall.Parser.Src Dhall.TypeCheck.X -executableDefault = buildInfoDefault <> specificFields +executableDefault :: Default s a +executableDefault resolve = buildInfoDefault resolve <> specificFields where specificFields = Map.singleton "scope" - ( Expr.UnionLit "Public" ( Expr.RecordLit mempty ) - ( Map.singleton "Private" ( Expr.Record mempty ) ) + ( Expr.App + ( resolve PreludeConstructorsScope `Expr.Field` "Public" ) + ( Expr.RecordLit mempty ) ) -packageDefault :: Default Dhall.Parser.Src Dhall.TypeCheck.X -packageDefault = fields +packageDefault :: Default s a +packageDefault resolve = fields where named name typ = Expr.Record ( Map.fromList @@ -237,20 +332,21 @@ , Expr.Pi "config" ( Expr.Var "types" `Expr.Field` "Config" ) - ( Dhall.declared typ ) + ( generaliseDeclared typ ) ) ] ) fields = Map.fromList [ textFieldDefault "author" "" - , emptyListDefault "flags" ( Dhall.declared flag ) + , emptyListDefault "flags" ( generaliseDeclared flag ) , emptyListDefault "benchmarks" ( named "benchmark" benchmark ) , textFieldDefault "bug-reports" "" - , emptyOptionalDefault "build-type" ( Dhall.declared buildType ) + , emptyOptionalDefault "build-type" + ( generaliseDeclared buildType ) , ( "cabal-version" , Expr.App - ( Expr.Var "prelude" `Expr.Field` "v" ) + ( resolve PreludeV ) ( Expr.TextLit ( Dhall.Core.Chunks [] "2.2" ) ) ) , textFieldDefault "category" "" @@ -268,17 +364,17 @@ ( Expr.Pi "config" ( Expr.Var "types" `Expr.Field` "Config" ) - ( Dhall.declared library ) + ( generaliseDeclared library ) ) , ( "license" , Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "Licenses" `Expr.Field` "AllRightsReserved" ) + ( resolve PreludeConstructorsLicense `Expr.Field` "AllRightsReserved" ) ( Expr.RecordLit mempty ) ) , emptyListDefault "license-files" Expr.Text , textFieldDefault "maintainer" "" , textFieldDefault "package-url" "" - , emptyListDefault "source-repos" ( Dhall.declared sourceRepo ) + , emptyListDefault "source-repos" ( generaliseDeclared sourceRepo ) , textFieldDefault "stability" "" , emptyListDefault "sub-libraries" ( named "library" library ) , textFieldDefault "synopsis" "" @@ -286,8 +382,8 @@ , emptyListDefault "tested-with" ( Expr.Record ( Map.fromList - [ ( "compiler", Dhall.declared compilerFlavor ) - , ( "version", Dhall.declared versionRange ) + [ ( "compiler", generaliseDeclared compilerFlavor ) + , ( "version", generaliseDeclared versionRange ) ] ) ) @@ -297,15 +393,16 @@ [ ( "_1", Expr.Text ), ( "_2", Expr.Text ) ] ) ) - , emptyOptionalDefault "custom-setup" ( Dhall.declared setupBuildInfo ) + , emptyOptionalDefault "custom-setup" + ( generaliseDeclared setupBuildInfo ) ] -sourceRepoDefault :: Default Dhall.Parser.Src Dhall.TypeCheck.X -sourceRepoDefault = fields +sourceRepoDefault :: Default s a +sourceRepoDefault resolve = fields where fields = Map.fromList - [ emptyOptionalDefault "type" ( Dhall.declared repoType ) + [ emptyOptionalDefault "type" ( generaliseDeclared repoType ) , emptyOptionalDefault "location" Expr.Text , emptyOptionalDefault "module" Expr.Text , emptyOptionalDefault "branch" Expr.Text @@ -313,7 +410,7 @@ , emptyOptionalDefault "subdir" Expr.Text , ( "kind" , Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "RepoKind" `Expr.Field` "RepoHead" ) + ( resolve PreludeConstructorsRepoKind `Expr.Field` "RepoHead" ) ( Expr.RecordLit mempty ) ) ] @@ -355,10 +452,11 @@ DefaultComparisonReplace expr -withDefault :: ( Eq a ) => StrictText.Text -> Default s a -> Expr.Expr s a -> Expr.Expr s a -withDefault name defs ( Expr.RecordLit fields ) = +withDefault :: ( Eq a ) => KnownDefault -> Default s a -> Expr.Expr s a -> Expr.Expr s a +withDefault typ defs ( Expr.RecordLit fields ) = let - nonDefaults = nonDefaultFields defs fields + nonDefaults = nonDefaultFields ( defs resolvePreludeVar ) fields + name = StrictText.pack ( show typ ) in if null nonDefaults then Expr.Var ( Expr.V "prelude" 0 ) `Expr.Field` "defaults" `Expr.Field` name @@ -396,12 +494,12 @@ } -runRecordInputTypeWithDefault :: StrictText.Text -> Default Dhall.Parser.Src Dhall.TypeCheck.X -> RecordInputType a -> Dhall.InputType a -runRecordInputTypeWithDefault defName def m = +runRecordInputTypeWithDefault :: KnownDefault -> Default Dhall.Parser.Src Dhall.TypeCheck.X -> RecordInputType a -> Dhall.InputType a +runRecordInputTypeWithDefault typ def m = let Dhall.InputType embed declared = runRecordInputType m in - Dhall.InputType ( withDefault defName def . embed ) declared + Dhall.InputType ( withDefault typ def . embed ) declared genericPackageDescriptionToDhall @@ -419,7 +517,7 @@ ) in - runRecordInputTypeWithDefault "Package" packageDefault + runRecordInputTypeWithDefault Package packageDefault ( mconcat [ Cabal.packageDescription >$< packageDescriptionToRecord , recordField "flags" ( Cabal.genPackageFlags >$< ( listOf flag ) ) @@ -823,17 +921,21 @@ sourceRepo :: Dhall.InputType Cabal.SourceRepo sourceRepo = - runRecordInputTypeWithDefault "SourceRepo" sourceRepoDefault - ( mconcat - [ recordField "kind" ( contramap Cabal.repoKind repoKind ) - , recordField "type" ( contramap Cabal.repoType ( maybeToDhall repoType ) ) - , recordField "location" ( contramap Cabal.repoLocation ( maybeToDhall stringToDhall ) ) - , recordField "module" ( contramap Cabal.repoModule ( maybeToDhall stringToDhall ) ) - , recordField "branch" ( contramap Cabal.repoBranch ( maybeToDhall stringToDhall ) ) - , recordField "tag" ( contramap Cabal.repoTag ( maybeToDhall stringToDhall ) ) - , recordField "subdir" ( contramap Cabal.repoSubdir ( maybeToDhall stringToDhall ) ) - ] - ) + ( runRecordInputTypeWithDefault SourceRepo sourceRepoDefault + ( mconcat + [ recordField "kind" ( contramap Cabal.repoKind repoKind ) + , recordField "type" ( contramap Cabal.repoType ( maybeToDhall repoType ) ) + , recordField "location" ( contramap Cabal.repoLocation ( maybeToDhall stringToDhall ) ) + , recordField "module" ( contramap Cabal.repoModule ( maybeToDhall stringToDhall ) ) + , recordField "branch" ( contramap Cabal.repoBranch ( maybeToDhall stringToDhall ) ) + , recordField "tag" ( contramap Cabal.repoTag ( maybeToDhall stringToDhall ) ) + , recordField "subdir" ( contramap Cabal.repoSubdir ( maybeToDhall stringToDhall ) ) + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "SourceRepo" + } repoKind :: Dhall.InputType Cabal.RepoKind @@ -968,7 +1070,7 @@ library :: Dhall.InputType Cabal.Library library = - ( runRecordInputTypeWithDefault "Library" libraryDefault + ( runRecordInputTypeWithDefault Library libraryDefault ( mconcat [ contramap Cabal.libBuildInfo buildInfoRecord , recordField @@ -1349,7 +1451,7 @@ compilerOptions = Dhall.InputType { Dhall.embed = \xs -> - withDefault "CompilerOptions" compilerOptionsDefault + withDefault CompilerOptions compilerOptionsDefault ( Expr.RecordLit ( Map.fromList ( map @@ -1407,7 +1509,7 @@ benchmark :: Dhall.InputType Cabal.Benchmark benchmark = - ( runRecordInputTypeWithDefault "Benchmark" benchmarkDefault + ( runRecordInputTypeWithDefault Benchmark benchmarkDefault ( mconcat [ recordField "main-is" ( ( \( Cabal.BenchmarkExeV10 _ s ) -> s ) . Cabal.benchmarkInterface >$< stringToDhall ) , Cabal.benchmarkBuildInfo >$< buildInfoRecord @@ -1421,7 +1523,7 @@ testSuite :: Dhall.InputType Cabal.TestSuite testSuite = - ( runRecordInputTypeWithDefault "TestSuite" testSuiteDefault + ( runRecordInputTypeWithDefault TestSuite testSuiteDefault ( mconcat [ recordField "type" ( Cabal.testInterface >$< testSuiteInterface ) , Cabal.testBuildInfo >$< buildInfoRecord @@ -1465,7 +1567,7 @@ executable :: Dhall.InputType Cabal.Executable executable = - ( runRecordInputTypeWithDefault "Executable" executableDefault + ( runRecordInputTypeWithDefault Executable executableDefault ( mconcat [ recordField "main-is" ( Cabal.modulePath >$< stringToDhall ) , recordField "scope" ( Cabal.exeScope >$< executableScope ) @@ -1480,19 +1582,19 @@ executableScope :: Dhall.InputType Cabal.ExecutableScope executableScope = - runUnion - ( mconcat - [ unionAlt - "Public" - ( \x -> - case x of - Cabal.ExecutablePublic -> Just () - _ -> Nothing - ) - Dhall.inject - , unionAlt "Private" ( \x -> case x of Cabal.ExecutablePrivate -> Just () ; _ -> Nothing ) Dhall.inject - ] - ) + Dhall.InputType + { Dhall.embed = \case + Cabal.ExecutablePublic -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "Scopes" `Expr.Field` "Public" ) + ( Expr.RecordLit mempty ) + Cabal.ExecutablePrivate -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "scopes" `Expr.Field` "Private" ) + ( Expr.RecordLit mempty ) + , Dhall.declared = + Expr.Var "types" `Expr.Field` "Scope" + } foreignLibrary :: Dhall.InputType Cabal.ForeignLib diff --git a/lib/Dhall/Extra.hs b/lib/Dhall/Extra.hs --- a/lib/Dhall/Extra.hs +++ b/lib/Dhall/Extra.hs @@ -5,20 +5,13 @@ {-# language RecordWildCards #-} module Dhall.Extra - ( RecordBuilder - , keyValue - , makeRecord - , makeUnion + ( makeUnion , validateType , sortExpr ) where -import Control.Applicative ( Const(..) ) import Control.Monad ( join ) -import Control.Monad.Trans.Reader ( Reader, reader, runReader ) -import Data.Functor.Compose ( Compose(..) ) -import Data.Functor.Product ( Product(..) ) import Data.Hashable ( Hashable ) import Data.List ( sortBy ) import Data.Ord ( comparing ) @@ -28,61 +21,6 @@ import qualified Dhall import qualified Dhall.Core as Dhall ( Expr ) import qualified Dhall.Core as Expr ( Expr(..) ) -import qualified Dhall.Parser -import qualified Dhall.TypeCheck - - - -newtype RecordBuilder a = - RecordBuilder - ( Product - ( Const - ( Map.InsOrdHashMap - StrictText.Text - ( Dhall.Expr Dhall.Parser.Src Dhall.TypeCheck.X ) - ) - ) - ( Compose - ( Reader - ( Dhall.Expr Dhall.Parser.Src Dhall.TypeCheck.X ) - ) - Maybe - ) - a - ) - deriving (Functor, Applicative) - - - -makeRecord :: RecordBuilder a -> Dhall.Type a -makeRecord ( RecordBuilder ( Pair ( Const fields ) ( Compose extractF ) ) ) = - let - extract = - runReader extractF - - expected = - sortExpr ( Expr.Record fields ) - - in Dhall.Type { .. } - - - -keyValue :: StrictText.Text -> Dhall.Type a -> RecordBuilder a -keyValue key valueType = - let - extract expr = do - Expr.RecordLit fields <- - return expr - - Map.lookup key fields >>= Dhall.extract valueType - - in - RecordBuilder - ( Pair - ( Const ( Map.singleton key ( Dhall.expected valueType ) ) ) - ( Compose ( reader extract ) ) - ) - makeUnion :: Map.InsOrdHashMap StrictText.Text ( Dhall.Type a ) -> Dhall.Type a diff --git a/lib/DhallToCabal.hs b/lib/DhallToCabal.hs --- a/lib/DhallToCabal.hs +++ b/lib/DhallToCabal.hs @@ -82,13 +82,13 @@ -packageIdentifier :: RecordBuilder Cabal.PackageIdentifier +packageIdentifier :: Dhall.RecordType Cabal.PackageIdentifier packageIdentifier = do pkgName <- - keyValue "name" packageName + Dhall.field "name" packageName pkgVersion <- - keyValue "version" version + Dhall.field "version" version pure Cabal.PackageIdentifier { .. } @@ -100,7 +100,7 @@ -packageDescription :: RecordBuilder Cabal.PackageDescription +packageDescription :: Dhall.RecordType Cabal.PackageDescription packageDescription = do package <- packageIdentifier @@ -124,57 +124,57 @@ pure Nothing customFieldsPD <- - keyValue + Dhall.field "x-fields" ( Dhall.list ( Dhall.pair Dhall.string Dhall.string ) ) sourceRepos <- - keyValue "source-repos" ( Dhall.list sourceRepo ) + Dhall.field "source-repos" ( Dhall.list sourceRepo ) specVersionRaw <- - Left <$> keyValue "cabal-version" version + Left <$> Dhall.field "cabal-version" version buildTypeRaw <- - keyValue "build-type" ( Dhall.maybe buildType ) + Dhall.field "build-type" ( Dhall.maybe buildType ) licenseRaw <- - keyValue "license" license + Dhall.field "license" license licenseFiles <- - keyValue "license-files" ( Dhall.list Dhall.string ) + Dhall.field "license-files" ( Dhall.list Dhall.string ) copyright <- - keyValue "copyright" Dhall.string + Dhall.field "copyright" Dhall.string maintainer <- - keyValue "maintainer" Dhall.string + Dhall.field "maintainer" Dhall.string author <- - keyValue "author" Dhall.string + Dhall.field "author" Dhall.string stability <- - keyValue "stability" Dhall.string + Dhall.field "stability" Dhall.string testedWith <- - keyValue "tested-with" ( Dhall.list compiler ) + Dhall.field "tested-with" ( Dhall.list compiler ) homepage <- - keyValue "homepage" Dhall.string + Dhall.field "homepage" Dhall.string pkgUrl <- - keyValue "package-url" Dhall.string + Dhall.field "package-url" Dhall.string bugReports <- - keyValue "bug-reports" Dhall.string + Dhall.field "bug-reports" Dhall.string synopsis <- - keyValue "synopsis" Dhall.string + Dhall.field "synopsis" Dhall.string description <- - keyValue "description" Dhall.string + Dhall.field "description" Dhall.string category <- - keyValue "category" Dhall.string + Dhall.field "category" Dhall.string -- Cabal documentation states -- @@ -185,22 +185,22 @@ pure [] setupBuildInfo <- - keyValue "custom-setup" ( Dhall.maybe setupBuildInfo ) + Dhall.field "custom-setup" ( Dhall.maybe setupBuildInfo ) dataFiles <- - keyValue "data-files" ( Dhall.list Dhall.string ) + Dhall.field "data-files" ( Dhall.list Dhall.string ) dataDir <- - keyValue "data-dir" Dhall.string + Dhall.field "data-dir" Dhall.string extraSrcFiles <- - keyValue "extra-source-files" ( Dhall.list Dhall.string ) + Dhall.field "extra-source-files" ( Dhall.list Dhall.string ) extraTmpFiles <- - keyValue "extra-tmp-files" ( Dhall.list Dhall.string ) + Dhall.field "extra-tmp-files" ( Dhall.list Dhall.string ) extraDocFiles <- - keyValue "extra-doc-files" ( Dhall.list Dhall.string ) + Dhall.field "extra-doc-files" ( Dhall.list Dhall.string ) return ( adjustUnspecifiedLicense Cabal.PackageDescription { .. } ) @@ -257,9 +257,9 @@ benchmark :: Dhall.Type Cabal.Benchmark benchmark = - makeRecord $ do + Dhall.record $ do mainIs <- - keyValue "main-is" Dhall.string + Dhall.field "main-is" Dhall.string benchmarkName <- pure "" @@ -276,142 +276,142 @@ -buildInfo :: RecordBuilder Cabal.BuildInfo +buildInfo :: Dhall.RecordType Cabal.BuildInfo buildInfo = do buildable <- - keyValue "buildable" Dhall.bool + Dhall.field "buildable" Dhall.bool buildTools <- - keyValue "build-tools" ( Dhall.list legacyExeDependency ) + Dhall.field "build-tools" ( Dhall.list legacyExeDependency ) buildToolDepends <- - keyValue "build-tool-depends" ( Dhall.list exeDependency ) + Dhall.field "build-tool-depends" ( Dhall.list exeDependency ) cppOptions <- - keyValue "cpp-options" ( Dhall.list Dhall.string ) + Dhall.field "cpp-options" ( Dhall.list Dhall.string ) ccOptions <- - keyValue "cc-options" ( Dhall.list Dhall.string ) + Dhall.field "cc-options" ( Dhall.list Dhall.string ) ldOptions <- - keyValue "ld-options" ( Dhall.list Dhall.string ) + Dhall.field "ld-options" ( Dhall.list Dhall.string ) pkgconfigDepends <- - keyValue "pkgconfig-depends" ( Dhall.list pkgconfigDependency ) + Dhall.field "pkgconfig-depends" ( Dhall.list pkgconfigDependency ) frameworks <- - keyValue "frameworks" ( Dhall.list Dhall.string ) + Dhall.field "frameworks" ( Dhall.list Dhall.string ) extraFrameworkDirs <- - keyValue "extra-framework-dirs" ( Dhall.list Dhall.string ) + Dhall.field "extra-framework-dirs" ( Dhall.list Dhall.string ) cSources <- - keyValue "c-sources" ( Dhall.list Dhall.string ) + Dhall.field "c-sources" ( Dhall.list Dhall.string ) jsSources <- - keyValue "js-sources" ( Dhall.list Dhall.string ) + Dhall.field "js-sources" ( Dhall.list Dhall.string ) hsSourceDirs <- - keyValue "hs-source-dirs" ( Dhall.list Dhall.string ) + Dhall.field "hs-source-dirs" ( Dhall.list Dhall.string ) otherModules <- - keyValue "other-modules" ( Dhall.list moduleName ) + Dhall.field "other-modules" ( Dhall.list moduleName ) autogenModules <- - keyValue "autogen-modules" ( Dhall.list moduleName ) + Dhall.field "autogen-modules" ( Dhall.list moduleName ) defaultLanguage <- - keyValue "default-language" ( Dhall.maybe language ) + Dhall.field "default-language" ( Dhall.maybe language ) otherLanguages <- - keyValue "other-languages" ( Dhall.list language ) + Dhall.field "other-languages" ( Dhall.list language ) defaultExtensions <- - keyValue "default-extensions" ( Dhall.list extension ) + Dhall.field "default-extensions" ( Dhall.list extension ) otherExtensions <- - keyValue "other-extensions" ( Dhall.list extension ) + Dhall.field "other-extensions" ( Dhall.list extension ) oldExtensions <- pure [] extraLibs <- - keyValue "extra-libraries" ( Dhall.list Dhall.string ) + Dhall.field "extra-libraries" ( Dhall.list Dhall.string ) extraGHCiLibs <- - keyValue "extra-ghci-libraries" ( Dhall.list Dhall.string ) + Dhall.field "extra-ghci-libraries" ( Dhall.list Dhall.string ) extraLibDirs <- - keyValue "extra-lib-dirs" ( Dhall.list Dhall.string ) + Dhall.field "extra-lib-dirs" ( Dhall.list Dhall.string ) includeDirs <- - keyValue "include-dirs" ( Dhall.list Dhall.string ) + Dhall.field "include-dirs" ( Dhall.list Dhall.string ) includes <- - keyValue "includes" ( Dhall.list Dhall.string ) + Dhall.field "includes" ( Dhall.list Dhall.string ) installIncludes <- - keyValue "install-includes" ( Dhall.list Dhall.string ) + Dhall.field "install-includes" ( Dhall.list Dhall.string ) options <- - keyValue "compiler-options" compilerOptions + Dhall.field "compiler-options" compilerOptions profOptions <- - keyValue "profiling-options" compilerOptions + Dhall.field "profiling-options" compilerOptions sharedOptions <- - keyValue "shared-options" compilerOptions + Dhall.field "shared-options" compilerOptions staticOptions <- - keyValue "static-options" compilerOptions + Dhall.field "static-options" compilerOptions customFieldsBI <- pure [] targetBuildDepends <- - keyValue "build-depends" ( Dhall.list dependency ) + Dhall.field "build-depends" ( Dhall.list dependency ) mixins <- - keyValue "mixins" ( Dhall.list mixin ) + Dhall.field "mixins" ( Dhall.list mixin ) asmOptions <- - keyValue "asm-options" ( Dhall.list Dhall.string ) + Dhall.field "asm-options" ( Dhall.list Dhall.string ) asmSources <- - keyValue "asm-sources" ( Dhall.list Dhall.string ) + Dhall.field "asm-sources" ( Dhall.list Dhall.string ) cmmOptions <- - keyValue "cmm-options" ( Dhall.list Dhall.string ) + Dhall.field "cmm-options" ( Dhall.list Dhall.string ) cmmSources <- - keyValue "cmm-sources" ( Dhall.list Dhall.string ) + Dhall.field "cmm-sources" ( Dhall.list Dhall.string ) cxxOptions <- - keyValue "cxx-options" ( Dhall.list Dhall.string ) + Dhall.field "cxx-options" ( Dhall.list Dhall.string ) cxxSources <- - keyValue "cxx-sources" ( Dhall.list Dhall.string ) + Dhall.field "cxx-sources" ( Dhall.list Dhall.string ) virtualModules <- - keyValue "virtual-modules" ( Dhall.list moduleName ) + Dhall.field "virtual-modules" ( Dhall.list moduleName ) extraLibFlavours <- - keyValue "extra-lib-flavours" ( Dhall.list Dhall.string ) + Dhall.field "extra-lib-flavours" ( Dhall.list Dhall.string ) extraBundledLibs <- - keyValue "extra-bundled-libs" ( Dhall.list Dhall.string ) + Dhall.field "extra-bundled-libs" ( Dhall.list Dhall.string ) return Cabal.BuildInfo { .. } buildInfoType :: Expr.Expr Dhall.Parser.Src Dhall.TypeCheck.X buildInfoType = - Dhall.expected ( makeRecord buildInfo ) + Dhall.expected ( Dhall.record buildInfo ) testSuite :: Dhall.Type Cabal.TestSuite testSuite = - makeRecord $ do + Dhall.record $ do testName <- pure "" @@ -419,7 +419,7 @@ buildInfo testInterface <- - keyValue "type" testSuiteInterface + Dhall.field "type" testSuiteInterface pure Cabal.TestSuite @@ -434,11 +434,11 @@ ( Map.fromList [ ( "exitcode-stdio" , Cabal.TestSuiteExeV10 ( Cabal.mkVersion [ 1, 0 ] ) - <$> makeRecord ( keyValue "main-is" Dhall.string ) + <$> Dhall.record ( Dhall.field "main-is" Dhall.string ) ) , ( "detailed" , Cabal.TestSuiteLibV09 ( Cabal.mkVersion [ 0, 9 ] ) - <$> makeRecord ( keyValue "module" moduleName ) + <$> Dhall.record ( Dhall.field "module" moduleName ) ) ] ) @@ -454,15 +454,15 @@ executable :: Dhall.Type Cabal.Executable executable = - makeRecord $ do + Dhall.record $ do exeName <- pure "" modulePath <- - keyValue "main-is" Dhall.string + Dhall.field "main-is" Dhall.string exeScope <- - keyValue "scope" executableScope + Dhall.field "scope" executableScope buildInfo <- buildInfo @@ -473,27 +473,27 @@ foreignLib :: Dhall.Type Cabal.ForeignLib foreignLib = - makeRecord $ do + Dhall.record $ do foreignLibName <- pure "" foreignLibType <- - keyValue "type" foreignLibType + Dhall.field "type" foreignLibType foreignLibOptions <- - keyValue "options" ( Dhall.list foreignLibOption ) + Dhall.field "options" ( Dhall.list foreignLibOption ) foreignLibBuildInfo <- buildInfo foreignLibVersionInfo <- - keyValue "lib-version-info" ( Dhall.maybe versionInfo ) + Dhall.field "lib-version-info" ( Dhall.maybe versionInfo ) foreignLibVersionLinux <- - keyValue "lib-version-linux" ( Dhall.maybe version ) + Dhall.field "lib-version-linux" ( Dhall.maybe version ) foreignLibModDefFile <- - keyValue "mod-def-files" ( Dhall.list Dhall.string ) + Dhall.field "mod-def-files" ( Dhall.list Dhall.string ) pure Cabal.ForeignLib { .. } @@ -512,7 +512,7 @@ library :: Dhall.Type Cabal.Library library = - makeRecord $ do + Dhall.record $ do libName <- pure Nothing @@ -520,13 +520,13 @@ buildInfo exposedModules <- - keyValue "exposed-modules" ( Dhall.list moduleName ) + Dhall.field "exposed-modules" ( Dhall.list moduleName ) reexportedModules <- - keyValue "reexported-modules" ( Dhall.list moduleReexport ) + Dhall.field "reexported-modules" ( Dhall.list moduleReexport ) signatures <- - keyValue "signatures" ( Dhall.list moduleName ) + Dhall.field "signatures" ( Dhall.list moduleName ) libExposed <- pure True @@ -537,27 +537,27 @@ sourceRepo :: Dhall.Type Cabal.SourceRepo sourceRepo = - makeRecord $ do + Dhall.record $ do repoKind <- - keyValue "kind" repoKind + Dhall.field "kind" repoKind repoType <- - keyValue "type" ( Dhall.maybe repoType ) + Dhall.field "type" ( Dhall.maybe repoType ) repoLocation <- - keyValue "location" ( Dhall.maybe Dhall.string ) + Dhall.field "location" ( Dhall.maybe Dhall.string ) repoModule <- - keyValue "module" ( Dhall.maybe Dhall.string ) + Dhall.field "module" ( Dhall.maybe Dhall.string ) repoBranch <- - keyValue "branch" ( Dhall.maybe Dhall.string ) + Dhall.field "branch" ( Dhall.maybe Dhall.string ) repoTag <- - keyValue "tag" ( Dhall.maybe Dhall.string ) + Dhall.field "tag" ( Dhall.maybe Dhall.string ) repoSubdir <- - keyValue "subdir" ( Dhall.maybe filePath ) + Dhall.field "subdir" ( Dhall.maybe filePath ) pure Cabal.SourceRepo { .. } @@ -571,12 +571,12 @@ dependency :: Dhall.Type Cabal.Dependency dependency = - makeRecord $ do + Dhall.record $ do packageName <- - keyValue "package" packageName + Dhall.field "package" packageName versionRange <- - keyValue "bounds" versionRange + Dhall.field "bounds" versionRange pure ( Cabal.Dependency packageName versionRange ) @@ -589,9 +589,13 @@ -dhallToCabal :: FilePath -> StrictText.Text -> IO Cabal.GenericPackageDescription -dhallToCabal fileName = - Dhall.inputFrom fileName genericPackageDescription +dhallToCabal + :: Dhall.InputSettings + -> StrictText.Text + -- ^ The Dhall to parse. + -> IO Cabal.GenericPackageDescription +dhallToCabal settings = + Dhall.inputWithSettings settings genericPackageDescription @@ -823,10 +827,10 @@ compiler :: Dhall.Type ( Cabal.CompilerFlavor, Cabal.VersionRange ) compiler = - makeRecord $ + Dhall.record $ (,) - <$> keyValue "compiler" compilerFlavor - <*> keyValue "version" versionRange + <$> Dhall.field "compiler" compilerFlavor + <*> Dhall.field "version" versionRange @@ -844,12 +848,12 @@ legacyExeDependency :: Dhall.Type Cabal.LegacyExeDependency legacyExeDependency = - makeRecord $ do + Dhall.record $ do exe <- - keyValue "exe" Dhall.string + Dhall.field "exe" Dhall.string version <- - keyValue "version" versionRange + Dhall.field "version" versionRange pure ( Cabal.LegacyExeDependency exe version ) @@ -857,18 +861,18 @@ compilerOptions :: Dhall.Type [ ( Cabal.CompilerFlavor, [ String ] ) ] compilerOptions = - makeRecord $ + Dhall.record $ sequenceA - [ (,) <$> pure Cabal.GHC <*> keyValue "GHC" options - , (,) <$> pure Cabal.GHCJS <*> keyValue "GHCJS" options - , (,) <$> pure Cabal.NHC <*> keyValue "NHC" options - , (,) <$> pure Cabal.YHC <*> keyValue "YHC" options - , (,) <$> pure Cabal.Hugs <*> keyValue "Hugs" options - , (,) <$> pure Cabal.HBC <*> keyValue "HBC" options - , (,) <$> pure Cabal.Helium <*> keyValue "Helium" options - , (,) <$> pure Cabal.JHC <*> keyValue "JHC" options - , (,) <$> pure Cabal.LHC <*> keyValue "LHC" options - , (,) <$> pure Cabal.UHC <*> keyValue "UHC" options + [ (,) <$> pure Cabal.GHC <*> Dhall.field "GHC" options + , (,) <$> pure Cabal.GHCJS <*> Dhall.field "GHCJS" options + , (,) <$> pure Cabal.NHC <*> Dhall.field "NHC" options + , (,) <$> pure Cabal.YHC <*> Dhall.field "YHC" options + , (,) <$> pure Cabal.Hugs <*> Dhall.field "Hugs" options + , (,) <$> pure Cabal.HBC <*> Dhall.field "HBC" options + , (,) <$> pure Cabal.Helium <*> Dhall.field "Helium" options + , (,) <$> pure Cabal.JHC <*> Dhall.field "JHC" options + , (,) <$> pure Cabal.LHC <*> Dhall.field "LHC" options + , (,) <$> pure Cabal.UHC <*> Dhall.field "UHC" options ] where @@ -880,15 +884,15 @@ exeDependency :: Dhall.Type Cabal.ExeDependency exeDependency = - makeRecord $ do + Dhall.record $ do packageName <- - keyValue "package" packageName + Dhall.field "package" packageName component <- - keyValue "component" unqualComponentName + Dhall.field "component" unqualComponentName version <- - keyValue "version" versionRange + Dhall.field "version" versionRange pure ( Cabal.ExeDependency packageName component version ) @@ -902,12 +906,12 @@ pkgconfigDependency :: Dhall.Type Cabal.PkgconfigDependency pkgconfigDependency = - makeRecord $ do + Dhall.record $ do name <- - keyValue "name" pkgconfigName + Dhall.field "name" pkgconfigName version <- - keyValue "version" versionRange + Dhall.field "version" versionRange return ( Cabal.PkgconfigDependency name version ) @@ -932,20 +936,20 @@ moduleReexport :: Dhall.Type Cabal.ModuleReexport moduleReexport = - makeRecord $ do + Dhall.record $ do original <- - keyValue "original" $ - makeRecord $ do + Dhall.field "original" $ + Dhall.record $ do package <- - keyValue "package" ( Dhall.maybe packageName ) + Dhall.field "package" ( Dhall.maybe packageName ) name <- - keyValue "name" moduleName + Dhall.field "name" moduleName pure ( package, name ) moduleReexportName <- - keyValue "name" moduleName + Dhall.field "name" moduleName pure Cabal.ModuleReexport @@ -965,12 +969,12 @@ versionInfo :: Dhall.Type Cabal.LibVersionInfo versionInfo = - makeRecord $ + Dhall.record $ fmap Cabal.mkLibVersionInfo $ (,,) - <$> ( fromIntegral <$> keyValue "current" Dhall.natural ) - <*> ( fromIntegral <$> keyValue "revision" Dhall.natural ) - <*> ( fromIntegral <$> keyValue "age" Dhall.natural ) + <$> ( fromIntegral <$> Dhall.field "current" Dhall.natural ) + <*> ( fromIntegral <$> Dhall.field "revision" Dhall.natural ) + <*> ( fromIntegral <$> Dhall.field "age" Dhall.natural ) @@ -1201,38 +1205,38 @@ let namedList k t = Dhall.list - ( makeRecord + ( Dhall.record ( (,) - <$> keyValue "name" unqualComponentName - <*> keyValue k ( guarded t ) + <$> Dhall.field "name" unqualComponentName + <*> Dhall.field k ( guarded t ) ) ) in - makeRecord $ do + Dhall.record $ do packageDescription <- packageDescription genPackageFlags <- - keyValue "flags" ( Dhall.list flag ) + Dhall.field "flags" ( Dhall.list flag ) condLibrary <- - keyValue "library" ( Dhall.maybe ( guarded library ) ) + Dhall.field "library" ( Dhall.maybe ( guarded library ) ) condSubLibraries <- - keyValue "sub-libraries" ( namedList "library" library ) + Dhall.field "sub-libraries" ( namedList "library" library ) condForeignLibs <- - keyValue "foreign-libraries" ( namedList "foreign-lib" foreignLib ) + Dhall.field "foreign-libraries" ( namedList "foreign-lib" foreignLib ) condExecutables <- - keyValue "executables" ( namedList "executable" executable ) + Dhall.field "executables" ( namedList "executable" executable ) condTestSuites <- - keyValue "test-suites" ( namedList "test-suite" testSuite ) + Dhall.field "test-suites" ( namedList "test-suite" testSuite ) condBenchmarks <- - keyValue "benchmarks" ( namedList "benchmark" benchmark ) + Dhall.field "benchmarks" ( namedList "benchmark" benchmark ) return Cabal.GenericPackageDescription { .. } @@ -1252,18 +1256,18 @@ flag :: Dhall.Type Cabal.Flag flag = - makeRecord $ do + Dhall.record $ do flagName <- - keyValue "name" flagName + Dhall.field "name" flagName flagDefault <- - keyValue "default" Dhall.bool + Dhall.field "default" Dhall.bool flagDescription <- - keyValue "description" Dhall.string + Dhall.field "description" Dhall.string flagManual <- - keyValue "manual" Dhall.bool + Dhall.field "manual" Dhall.bool return Cabal.MkFlag { .. } @@ -1277,9 +1281,9 @@ setupBuildInfo :: Dhall.Type Cabal.SetupBuildInfo setupBuildInfo = - makeRecord $ do + Dhall.record $ do setupDepends <- - keyValue "setup-depends" ( Dhall.list dependency ) + Dhall.field "setup-depends" ( Dhall.list dependency ) defaultSetupDepends <- pure False @@ -1296,12 +1300,12 @@ mixin :: Dhall.Type Cabal.Mixin mixin = - makeRecord $ do + Dhall.record $ do mixinPackageName <- - keyValue "package" packageName + Dhall.field "package" packageName mixinIncludeRenaming <- - keyValue "renaming" includeRenaming + Dhall.field "renaming" includeRenaming pure Cabal.Mixin { .. } @@ -1309,12 +1313,12 @@ includeRenaming :: Dhall.Type Cabal.IncludeRenaming includeRenaming = - makeRecord $ do + Dhall.record $ do includeProvidesRn <- - keyValue "provides" moduleRenaming + Dhall.field "provides" moduleRenaming includeRequiresRn <- - keyValue "requires" moduleRenaming + Dhall.field "requires" moduleRenaming pure Cabal.IncludeRenaming { .. } @@ -1324,8 +1328,8 @@ moduleRenaming = fmap Cabal.ModuleRenaming $ Dhall.list $ - makeRecord $ - (,) <$> keyValue "rename" moduleName <*> keyValue "to" moduleName + Dhall.record $ + (,) <$> Dhall.field "rename" moduleName <*> Dhall.field "to" moduleName sortType :: Dhall.Type a -> Dhall.Type a diff --git a/meta/Main.hs b/meta/Main.hs new file mode 100644 --- /dev/null +++ b/meta/Main.hs @@ -0,0 +1,165 @@ +{-# 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, joinPath, normalise + , splitDirectories, splitFileName, takeDirectory + ) + +import CabalToDhall + ( KnownDefault, PreludeReference (..), getDefault ) + +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.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" + + +-- | Like 'System.FilePath.makeRelative', but will introduce @..@ +-- segments (and hence will misbehave in the presence of symlinks). +relativeTo + :: FilePath + -- ^ The path to be relative to. Note that the final file-name is + -- ignored: @foo/bar@ is relative to @foo/@, even if @foo/bar@ is + -- a directory. + -> FilePath + -- ^ The path to relativise. + -> FilePath +relativeTo = + \ ( splitDirectories . dropTrailingPathSeparator . takeDirectory . normalise -> base ) -> + \ ( splitDirectories . normalise -> path ) -> + joinPath ( go base path ) + where + go ( a : as ) ( b : bs ) + | a == b = go as bs + | otherwise = ( ".." <$ ( a : as ) ) ++ ( b : bs ) + go [] bs = bs + go as [] = ".." <$ as + +importFile :: FilePath -> Dhall.Core.Import +importFile ( splitFileName -> ( directory, filename ) ) = + let + components = + fromString <$> + splitDirectories ( dropTrailingPathSeparator directory ) + in + Dhall.Core.Import + { Dhall.Core.importHashed = + Dhall.Core.ImportHashed + { Dhall.Core.hash = + Nothing + , Dhall.Core.importType = + Dhall.Core.Local + Dhall.Core.Here + ( Dhall.Core.File + ( Dhall.Core.Directory ( reverse components ) ) + ( fromString filename ) + ) + } + , Dhall.Core.importMode = + Dhall.Core.Code + } + + +meta :: MetaOptions -> IO () +meta (MetaOptions {..}) = do + putStrLn $ + "Generating defaults underneath " ++ prefix ++ "." + + 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.Constructors ( Expr.Var "types" `Expr.Field` "License" ) + PreludeConstructorsRepoKind -> + Expr.Constructors ( Expr.Var "types" `Expr.Field` "RepoKind" ) + PreludeConstructorsScope -> + Expr.Constructors ( Expr.Var "types" `Expr.Field` "Scope" ) + 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 ) + + 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 ) + ) + + +-- 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