diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,5 +1,51 @@ # dhall-to-cabal change log +## 1.1.0.0 -- 2018-06-03 + +### Breaking Changes + +* The type of DhallToCabal.license has changed to + `Dhall.Type (Either SPDX.License Cabal.License)` to accomodate Cabal 2.2. + +### Other Changes + +* Increase upper-bound of base to allow 4.11. + +* Increase upper-bound of tasty to allow 1.1. + +* Switch to Dhall 1.14.0. + +* dhall-to-cabal: Fix tracking which branches are already true or false in + conditionals. Dhall expressions with lots of conditions previously produced + Cabal files that did not correctly match the requested conditions. See + https://github.com/dhall-lang/dhall-to-cabal/pull/56, + https://github.com/dhall-lang/dhall-to-cabal/issues/53 and + https://github.com/dhall-lang/dhall-to-cabal/issues/55 for more information. + + Thank you to @jneira and @quasicomputational for helping identify and fix this + bug. + +* cabal-to-dhall: Rewrite conditional handling to avoid hangs with complicated ones. + See https://github.com/dhall-lang/dhall-to-cabal/pull/54 and linked issues. + +* Added a warning to generated `.cabal` files against hand-editing. + +* `cabal-to-dhall` now pretty prints the resulting Dhall. + +* The signature of `CabalToDhall.cabalToDhall` has changed: it now takes the location + of the `prelude.dhall` and `types.dhall` to import as a parameter. + +* Upgrade to Cabal 2.2. This introduces SPDX license identifiers and Dhall + functionality to manipulate them; see + for a (convoluted) demonstration. + +* `prelude.defaults.Executable` has lost its `main-is` field, as it + makes little sense to have an executable without it. + +* `--print-type` now omits the lengthy definition of `Extension`, instead importing + it from the prelude. `--self-contained` is a new switch to disable this behaviour. + + ## 1.0.0.1 -- 2018-03-25 Small packaging only tweaks: diff --git a/cabal-to-dhall/Main.hs b/cabal-to-dhall/Main.hs --- a/cabal-to-dhall/Main.hs +++ b/cabal-to-dhall/Main.hs @@ -1,1345 +1,93 @@ -{-# language FlexibleInstances #-} -{-# language GeneralizedNewtypeDeriving #-} -{-# language LambdaCase #-} -{-# language NamedFieldPuns #-} -{-# language OverloadedStrings #-} -{-# language ViewPatterns #-} - -module Main ( main ) where - -import Control.Applicative ( (<**>), optional ) -import Control.Monad ( join ) -import Data.Foldable ( foldMap ) -import Data.Functor.Contravariant ( (>$<), Contravariant( contramap ) ) -import Data.Hashable ( Hashable ) -import Data.List ( sortBy ) -import Data.Maybe ( listToMaybe ) -import Data.Monoid ( First(..), (<>) ) -import Data.Ord ( comparing ) -import GHC.Stack -import Numeric.Natural ( Natural ) - -import qualified Data.HashMap.Strict.InsOrd as Map -import qualified Data.Text.Lazy as LazyText -import qualified Data.Text.Lazy.IO as LazyText -import qualified Dhall -import qualified Dhall.Core -import qualified Dhall.Core as Expr ( Const(..), Expr(..) ) -import qualified Dhall.Import -import qualified Dhall.Parser -import qualified Dhall.TypeCheck -import qualified Distribution.Compiler as Cabal -import qualified Distribution.License as Cabal -import qualified Distribution.ModuleName as Cabal -import qualified Distribution.PackageDescription.Parse as Cabal -import qualified Distribution.System as Cabal -import qualified Distribution.Text as Cabal -import qualified Distribution.Types.Benchmark as Cabal -import qualified Distribution.Types.BenchmarkInterface as Cabal -import qualified Distribution.Types.BuildInfo as Cabal -import qualified Distribution.Types.BuildType as Cabal -import qualified Distribution.Types.CondTree as Cabal -import qualified Distribution.Types.Condition as Cabal -import qualified Distribution.Types.Dependency as Cabal -import qualified Distribution.Types.ExeDependency as Cabal -import qualified Distribution.Types.Executable as Cabal -import qualified Distribution.Types.ExecutableScope as Cabal -import qualified Distribution.Types.ForeignLib as Cabal -import qualified Distribution.Types.ForeignLibOption as Cabal -import qualified Distribution.Types.ForeignLibType as Cabal -import qualified Distribution.Types.GenericPackageDescription as Cabal -import qualified Distribution.Types.IncludeRenaming as Cabal -import qualified Distribution.Types.LegacyExeDependency as Cabal -import qualified Distribution.Types.Library as Cabal -import qualified Distribution.Types.Mixin as Cabal -import qualified Distribution.Types.ModuleReexport as Cabal -import qualified Distribution.Types.ModuleRenaming as Cabal -import qualified Distribution.Types.PackageDescription as Cabal -import qualified Distribution.Types.PackageId as Cabal -import qualified Distribution.Types.PackageName as Cabal -import qualified Distribution.Types.PkgconfigDependency as Cabal -import qualified Distribution.Types.PkgconfigName as Cabal -import qualified Distribution.Types.SetupBuildInfo as Cabal -import qualified Distribution.Types.SourceRepo as Cabal -import qualified Distribution.Types.TestSuite as Cabal -import qualified Distribution.Types.TestSuiteInterface as Cabal -import qualified Distribution.Types.UnqualComponentName as Cabal -import qualified Distribution.Version as Cabal -import qualified Language.Haskell.Extension as Cabal -import qualified Options.Applicative as OptParse - -import DhallToCabal ( sortExpr ) - -import qualified DhallToCabal - - -preludeLocation :: Dhall.Core.Path -preludeLocation = - Dhall.Core.Path - { Dhall.Core.pathHashed = - Dhall.Core.PathHashed - { Dhall.Core.hash = - Nothing - , Dhall.Core.pathType = - Dhall.Core.URL - "https://raw.githubusercontent.com/dhall-lang/dhall-to-cabal/1.0.0/dhall/prelude.dhall" - Nothing - } - , Dhall.Core.pathMode = - Dhall.Core.Code - } - - -typesLocation :: Dhall.Core.Path -typesLocation = - Dhall.Core.Path - { Dhall.Core.pathHashed = - Dhall.Core.PathHashed - { Dhall.Core.hash = - Nothing - , Dhall.Core.pathType = - Dhall.Core.URL - "https://raw.githubusercontent.com/dhall-lang/dhall-to-cabal/1.0.0/dhall/types.dhall" - Nothing - } - , Dhall.Core.pathMode = - Dhall.Core.Code - } - - -type DhallExpr = - Dhall.Core.Expr Dhall.Parser.Src Dhall.TypeCheck.X - - -data Command - = RunCabalToDhall CabalToDhallOptions - - -data CabalToDhallOptions = CabalToDhallOptions - { cabalFilePath :: Maybe String - } - - -cabalToDhallOptionsParser :: OptParse.Parser CabalToDhallOptions -cabalToDhallOptionsParser = - CabalToDhallOptions - <$> - optional - ( OptParse.argument - OptParse.str - ( mconcat - [ OptParse.metavar "" - , OptParse.help "The Cabal file to convert to Dhall" - ] - ) - ) - - -commandLineParser = - RunCabalToDhall <$> ( cabalToDhallOptionsParser <**> OptParse.helper ) - - -main :: IO () -main = do - command <- - OptParse.execParser - ( OptParse.info commandLineParser mempty ) - - case command of - RunCabalToDhall options -> - runCabalToDhall options - - -runCabalToDhall :: CabalToDhallOptions -> IO () -runCabalToDhall CabalToDhallOptions{ cabalFilePath } = do - source <- - case cabalFilePath of - Nothing -> - LazyText.getContents - - Just filePath -> - LazyText.readFile filePath - - case Cabal.parseGenericPackageDescription ( LazyText.unpack source ) of - Cabal.ParseFailed e -> do - putStrLn "Could not parse Cabal file: " - - error ( show e ) - - Cabal.ParseOk _warnings genericPackageDescription -> do - let - dhall = - Expr.Let "prelude" Nothing ( Expr.Embed preludeLocation ) - $ Expr.Let "types" Nothing ( Expr.Embed typesLocation ) - $ ( Dhall.TypeCheck.absurd <$> - Dhall.embed - genericPackageDescriptionToDhall - genericPackageDescription - ) - - LazyText.putStrLn ( Dhall.Core.pretty dhall ) - - -newtype RecordInputType a = - RecordInputType - { unRecordInputType :: - Map.InsOrdHashMap Dhall.Text ( Dhall.InputType a ) - } - deriving ( Monoid ) - - -instance Contravariant RecordInputType where - contramap f ( RecordInputType map ) = - RecordInputType ( fmap ( contramap f ) map ) - - -recordField :: Dhall.Text -> Dhall.InputType a -> RecordInputType a -recordField k v = - RecordInputType ( Map.singleton k v ) - - -runRecordInputType :: RecordInputType a -> Dhall.InputType a -runRecordInputType ( RecordInputType m ) = - Dhall.InputType - { Dhall.embed = - \a -> sortExpr ( Expr.RecordLit ( fmap ( \t -> Dhall.embed t a ) m ) ) - , Dhall.declared = sortExpr ( Expr.Record ( fmap Dhall.declared m ) ) - } - - -genericPackageDescriptionToDhall - :: Dhall.InputType Cabal.GenericPackageDescription -genericPackageDescriptionToDhall = - let - named k v = - listOf - ( runRecordInputType - ( mconcat - [ fst >$< recordField "name" unqualComponentName - , snd >$< recordField k v - ] - ) - ) - - in - runRecordInputType - ( mconcat - [ Cabal.packageDescription >$< packageDescriptionToRecord - , recordField "flags" ( Cabal.genPackageFlags >$< ( listOf flag ) ) - , recordField "library" ( Cabal.condLibrary >$< maybeToDhall ( condTree library ) ) - , recordField "sub-libraries" ( Cabal.condSubLibraries >$< named "library" ( condTree library ) ) - , recordField "foreign-libraries" ( Cabal.condForeignLibs >$< named "foreign-lib" ( condTree foreignLibrary ) ) - , recordField "executables" ( Cabal.condExecutables >$< named "executable" ( condTree executable ) ) - , recordField "test-suites" ( Cabal.condTestSuites >$< named "test-suite" ( condTree testSuite ) ) - , recordField "benchmarks" ( Cabal.condBenchmarks >$< named "benchmark" ( condTree benchmark ) ) - ] - ) - - -packageDescriptionToRecord - :: RecordInputType Cabal.PackageDescription -packageDescriptionToRecord = - mconcat - [ contramap Cabal.package packageIdentifierToRecord - , recordField "source-repos" ( contramap Cabal.sourceRepos ( listOf sourceRepo ) ) - , recordField "cabal-version" ( contramap Cabal.specVersionRaw specVersion ) - , recordField "build-type" ( contramap Cabal.buildType ( maybeToDhall buildType ) ) - , recordField "license" ( contramap Cabal.license licenseToDhall ) - , recordField "license-files" ( contramap Cabal.licenseFiles ( listOf stringToDhall ) ) - , recordField "copyright" ( contramap Cabal.copyright stringToDhall ) - , recordField "maintainer" ( contramap Cabal.maintainer stringToDhall ) - , recordField "author" ( contramap Cabal.author stringToDhall ) - , recordField "stability" ( contramap Cabal.stability stringToDhall ) - , recordField "tested-with" ( contramap Cabal.testedWith ( listOf compiler ) ) - , recordField "homepage" ( contramap Cabal.homepage stringToDhall ) - , recordField "package-url" ( contramap Cabal.pkgUrl stringToDhall ) - , recordField "bug-reports" ( contramap Cabal.bugReports stringToDhall ) - , recordField "synopsis" ( contramap Cabal.synopsis stringToDhall ) - , recordField "description" ( contramap Cabal.description stringToDhall ) - , recordField "category" ( contramap Cabal.category stringToDhall ) - , recordField "custom-setup" ( contramap Cabal.setupBuildInfo ( maybeToDhall setupBuildInfo ) ) - , recordField "data-files" ( contramap Cabal.dataFiles ( listOf stringToDhall ) ) - , recordField "data-dir" ( contramap Cabal.dataDir stringToDhall ) - , recordField "extra-source-files" ( contramap Cabal.extraSrcFiles ( listOf stringToDhall ) ) - , recordField "extra-tmp-files" ( contramap Cabal.extraTmpFiles ( listOf stringToDhall ) ) - , recordField "extra-doc-files" ( contramap Cabal.extraDocFiles ( listOf stringToDhall ) ) - , recordField - "x-fields" - ( Cabal.customFieldsPD - >$< - listOf - ( runRecordInputType - ( mconcat - [ fst >$< recordField "_1" stringToDhall - , snd >$< recordField "_2" stringToDhall - ] - ) - ) - ) - ] - - -packageIdentifierToRecord - :: RecordInputType Cabal.PackageIdentifier -packageIdentifierToRecord = - mconcat - [ recordField "name" ( contramap Cabal.pkgName packageNameToDhall ) - , recordField "version" ( contramap Cabal.pkgVersion versionToDhall ) - ] - - -packageNameToDhall :: Dhall.InputType Cabal.PackageName -packageNameToDhall = - contramap Cabal.unPackageName stringToDhall - - -versionToDhall :: Dhall.InputType Cabal.Version -versionToDhall = - Dhall.InputType - { Dhall.embed = - Expr.App ( Expr.Var "prelude" `Expr.Field` "v" ) - . Dhall.embed stringToDhall - . show - . Cabal.disp - , Dhall.declared = - Expr.Var "types" `Expr.Field` "Version" - } - - -stringToDhall :: Dhall.InputType String -stringToDhall = - contramap LazyText.pack Dhall.inject - - -licenseToDhall :: Dhall.InputType Cabal.License -licenseToDhall = - ( runUnion - ( mconcat - [ gpl - , agpl - , lgpl - , bsd2 - , bsd3 - , bsd4 - , mit - , isc - , mpl - , apache - , publicDomain - , allRightsReserved - , unspecified - , other - -- , unknown - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "License" - } - - where - - gpl = - unionAlt "GPL" ( \l -> case l of Cabal.GPL v -> Just v; _ -> Nothing ) ( maybeToDhall versionToDhall ) - - agpl = - unionAlt "AGPL" ( \l -> case l of Cabal.AGPL v -> Just v ; _ -> Nothing ) ( maybeToDhall versionToDhall ) - - lgpl = - unionAlt "LGPL" ( \l -> case l of Cabal.LGPL v -> Just v ; _ -> Nothing ) ( maybeToDhall versionToDhall ) - - bsd2 = - unionAlt "BSD2" ( \l -> case l of Cabal.BSD2 -> Just () ; _ -> Nothing ) Dhall.inject - - bsd3 = - unionAlt "BSD3" ( \l -> case l of Cabal.BSD3 -> Just () ; _ -> Nothing ) Dhall.inject - - bsd4 = - unionAlt "BSD4" ( \l -> case l of Cabal.BSD4 -> Just () ; _ -> Nothing ) Dhall.inject - - mit = - unionAlt "MIT" ( \l -> case l of Cabal.MIT -> Just () ; _ -> Nothing ) Dhall.inject - - isc = - unionAlt "ISC" ( \l -> case l of Cabal.ISC -> Just () ; _ -> Nothing ) Dhall.inject - - mpl = - unionAlt "MPL" ( \l -> case l of Cabal.MPL v -> Just v ; _ -> Nothing ) versionToDhall - - apache = - unionAlt "Apache" ( \l -> case l of Cabal.Apache v -> Just v ; _ -> Nothing ) ( maybeToDhall versionToDhall ) - - publicDomain = - unionAlt "PublicDomain" ( \l -> case l of Cabal.PublicDomain -> Just () ; _ -> Nothing ) Dhall.inject - - allRightsReserved = - unionAlt "AllRightsReserved" ( \l -> case l of Cabal.AllRightsReserved -> Just () ; _ -> Nothing ) Dhall.inject - - unspecified = - unionAlt - "Unspecified" - ( \l -> - case l of - Cabal.UnspecifiedLicense -> - Just () - - Cabal.UnknownLicense "UnspecifiedLicense" -> - Just () - - _ -> - Nothing - ) - Dhall.inject - - other = - unionAlt "Other" ( \l -> case l of Cabal.OtherLicense -> Just () ; _ -> Nothing ) Dhall.inject - - unknown = - unionAlt "Unknown" ( \l -> case l of Cabal.UnknownLicense s -> Just s ; _ -> Nothing ) stringToDhall - - -newtype Union a = - Union - { unUnion :: - ( a -> - ( First ( Dhall.Text, DhallExpr ) - , Map.InsOrdHashMap Dhall.Text DhallExpr - ) - , Map.InsOrdHashMap Dhall.Text DhallExpr - ) - } - deriving ( Monoid ) - - -runUnion :: ( HasCallStack, Show a ) => Union a -> Dhall.InputType a -runUnion ( Union ( f, t ) ) = - Dhall.InputType - { Dhall.embed = - \a -> - case f a of - ( First Nothing, _ ) -> - error $ "Union did not match anything. Given " ++ show a - - ( First ( Just ( k, v ) ), alts ) -> - Expr.UnionLit k v alts - , Dhall.declared = - sortExpr ( Expr.Union t ) - } - - -unionAlt :: Dhall.Text -> ( a -> Maybe b ) -> Dhall.InputType b -> Union a -unionAlt k f t = - Union - ( \a -> - case f a of - Nothing -> - ( mempty, Map.singleton k ( Dhall.declared t ) ) - - Just b -> - ( First ( fmap ( \b -> ( k, Dhall.embed t b ) ) ( f a ) ), mempty ) - , Map.singleton k ( Dhall.declared t ) - ) - - -maybeToDhall :: Dhall.InputType a -> Dhall.InputType ( Maybe a ) -maybeToDhall t = - Dhall.InputType - { Dhall.embed = - \a -> Expr.OptionalLit ( Dhall.declared t ) ( Dhall.embed t <$> a ) - , Dhall.declared = Expr.App Expr.Optional ( Dhall.declared t ) - } - - -listOf :: Dhall.InputType a -> Dhall.InputType [ a ] -listOf t = - Dhall.InputType - { Dhall.embed = - \a -> - Expr.ListLit - ( foldl ( \_ _ -> Nothing ) ( Just ( Dhall.declared t ) ) a ) - ( foldMap ( pure . Dhall.embed t ) a ) - , Dhall.declared = Expr.App Expr.List ( Dhall.declared t ) - } - - -compiler :: Dhall.InputType ( Cabal.CompilerFlavor, Cabal.VersionRange ) -compiler = - runRecordInputType - ( mconcat - [ recordField "compiler" ( contramap fst compilerFlavor ) - , recordField "version" ( contramap snd versionRange ) - ] - ) - - -instance {-# OVERLAPS #-} Dhall.Inject [Char] where - injectWith _ = stringToDhall - -instance Dhall.Inject Cabal.CompilerFlavor - - -compilerFlavor :: Dhall.InputType Cabal.CompilerFlavor -compilerFlavor = - let - constructor k v = - Expr.App ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "Compilers" `Expr.Field` k ) v - - in - Dhall.InputType - { Dhall.embed = \case - Cabal.GHC -> - constructor "GHC" ( Expr.RecordLit mempty ) - - Cabal.GHCJS -> - constructor "GHCJS" ( Expr.RecordLit mempty ) - - Cabal.HBC -> - constructor "HBC" ( Expr.RecordLit mempty ) - - Cabal.HaskellSuite v -> - constructor "HaskellSuite" ( Expr.Record ( Map.singleton "_1" ( Dhall.embed Dhall.inject v ) ) ) - - Cabal.Helium -> - constructor "Helium" ( Expr.RecordLit mempty ) - - Cabal.Hugs -> - constructor "Hugs" ( Expr.RecordLit mempty ) - - Cabal.JHC -> - constructor "JHC" ( Expr.RecordLit mempty ) - - Cabal.LHC -> - constructor "LHC" ( Expr.RecordLit mempty ) - - Cabal.NHC -> - constructor "NHC" ( Expr.RecordLit mempty ) - - Cabal.OtherCompiler v -> - constructor "OtherCompiler" ( Expr.Record ( Map.singleton "_1" ( Dhall.embed Dhall.inject v ) ) ) - - Cabal.UHC -> - constructor "UHC" ( Expr.RecordLit mempty ) - - Cabal.YHC -> - constructor "YHC" ( Expr.RecordLit mempty ) - , Dhall.declared = - Expr.Var "types" `Expr.Field` "Compiler" - } - - -versionRange :: Dhall.InputType Cabal.VersionRange -versionRange = - Dhall.InputType - { Dhall.embed = - \versionRange0 -> - let - go versionRange = - case versionRange of - Cabal.AnyVersion -> - Expr.Var "prelude" `Expr.Field` "anyVersion" - - Cabal.IntersectVersionRanges ( Cabal.LaterVersion ( Cabal.versionNumbers -> [ 1 ] ) ) ( Cabal.EarlierVersion ( Cabal.versionNumbers -> [ 1 ] ) ) -> - Expr.Var "prelude" `Expr.Field` "noVersion" - - Cabal.ThisVersion v -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "thisVersion" ) - ( Dhall.embed versionToDhall v ) - - Cabal.UnionVersionRanges ( Cabal.EarlierVersion v ) ( Cabal.LaterVersion v' ) | v == v' -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "notThisVersion" ) - ( Dhall.embed versionToDhall v ) - - Cabal.LaterVersion v -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "laterVersion" ) - ( Dhall.embed versionToDhall v ) - - Cabal.UnionVersionRanges ( Cabal.ThisVersion v ) ( Cabal.LaterVersion v' ) | v == v' -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "orLaterVersion" ) - ( Dhall.embed versionToDhall v ) - - Cabal.EarlierVersion v -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "earlierVersion" ) - ( Dhall.embed versionToDhall v ) - - Cabal.UnionVersionRanges ( Cabal.ThisVersion v ) ( Cabal.EarlierVersion v' ) | v == v' -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "orEarlierVersion" ) - ( Dhall.embed versionToDhall v ) - - Cabal.UnionVersionRanges a b -> - Expr.App - ( Expr.App ( Expr.Var "prelude" `Expr.Field` "unionVersionRanges" ) ( go a ) ) - ( go b ) - - Cabal.IntersectVersionRanges a b -> - Expr.App - ( Expr.App ( Expr.Var "prelude" `Expr.Field` "intersectVersionRanges" ) ( go a ) ) - ( go b ) - - Cabal.WildcardVersion v -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "withinVersion" ) - ( Dhall.embed versionToDhall v ) - - Cabal.MajorBoundVersion v -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "majorBoundVersion" ) - ( Dhall.embed versionToDhall v ) - - Cabal.VersionRangeParens vr -> - go vr - - in - go ( Cabal.fromVersionIntervals ( Cabal.toVersionIntervals versionRange0 ) ) - , Dhall.declared = - Expr.Var "types" `Expr.Field` "VersionRange" - } - - -sourceRepo :: Dhall.InputType Cabal.SourceRepo -sourceRepo = - runRecordInputType - ( 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 ) ) - ] - ) - - -repoKind :: Dhall.InputType Cabal.RepoKind -repoKind = - ( runUnion - ( mconcat - [ unionAlt "RepoThis" ( \x -> case x of Cabal.RepoThis -> Just () ; _ -> Nothing) Dhall.inject - , unionAlt "RepoKindUnknown" ( \x -> case x of Cabal.RepoKindUnknown str -> Just str ; _ -> Nothing) ( runRecordInputType ( recordField "_1" stringToDhall ) ) - , unionAlt "RepoHead" ( \x -> case x of Cabal.RepoHead -> Just () ; _ -> Nothing) Dhall.inject - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "RepoKind" - } - - -repoType :: Dhall.InputType Cabal.RepoType -repoType = - ( runUnion - ( mconcat - [ unionAlt "Darcs" ( \x -> case x of Cabal.Darcs -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Git" ( \x -> case x of Cabal.Git -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "SVN" ( \x -> case x of Cabal.SVN -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "CVS" ( \x -> case x of Cabal.CVS -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Mercurial" ( \x -> case x of Cabal.Mercurial -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "GnuArch" ( \x -> case x of Cabal.GnuArch -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Monotone" ( \x -> case x of Cabal.Monotone -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "OtherRepoType" ( \x -> case x of Cabal.OtherRepoType s -> Just s ; _ -> Nothing ) ( runRecordInputType ( recordField "_1" stringToDhall ) ) - , unionAlt "Bazaar" ( \x -> case x of Cabal.Bazaar -> Just () ; _ -> Nothing ) Dhall.inject - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "RepoType" - } - - -specVersion :: Dhall.InputType ( Either Cabal.Version Cabal.VersionRange ) -specVersion = - Dhall.InputType - { Dhall.embed = either ( Dhall.embed versionToDhall ) ( error "Only exact cabal-versions are supported" ) - , Dhall.declared = Dhall.declared versionToDhall - } - - -buildType :: Dhall.InputType Cabal.BuildType -buildType = - Dhall.InputType - { Dhall.embed = \case - Cabal.Simple -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "Simple" ) - ( Expr.RecordLit mempty ) - - Cabal.Configure -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "Configure" ) - ( Expr.RecordLit mempty ) - - Cabal.Custom -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "Custom" ) - ( Expr.RecordLit mempty ) - - Cabal.Make -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "Make" ) - ( Expr.RecordLit mempty ) - - Cabal.UnknownBuildType s -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "UnknownBuildType" ) - ( Expr.RecordLit ( Map.singleton "_1" ( Dhall.embed Dhall.inject s ) ) ) - - , Dhall.declared = - Expr.Var "types" `Expr.Field` "BuildType" - } - - -setupBuildInfo :: Dhall.InputType Cabal.SetupBuildInfo -setupBuildInfo = - ( runRecordInputType - ( mconcat - [ recordField "setup-depends" ( contramap Cabal.setupDepends ( listOf dependency ) ) - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "CustomSetup" - } - - -dependency :: Dhall.InputType Cabal.Dependency -dependency = - runRecordInputType - ( mconcat - [ recordField "package" ( contramap ( \( Cabal.Dependency p _ ) -> p ) packageNameToDhall ) - , recordField "bounds" ( contramap ( \( Cabal.Dependency _ a ) -> a ) versionRange ) - ] - ) - - -flag :: Dhall.InputType Cabal.Flag -flag = - runRecordInputType - ( mconcat - [ recordField "name" ( contramap Cabal.flagName flagName ) - , recordField "default" ( contramap Cabal.flagDefault Dhall.inject ) - , recordField "description" ( contramap Cabal.flagDescription stringToDhall ) - , recordField "manual" ( contramap Cabal.flagManual Dhall.inject ) - ] - ) - - -flagName :: Dhall.InputType Cabal.FlagName -flagName = - contramap Cabal.unFlagName stringToDhall - - -library :: Dhall.InputType Cabal.Library -library = - ( runRecordInputType - ( mconcat - [ contramap Cabal.libBuildInfo buildInfoRecord - , recordField - "exposed-modules" - ( contramap Cabal.exposedModules ( listOf moduleName ) ) - , recordField - "reexported-modules" - ( contramap Cabal.reexportedModules ( listOf moduleReexport ) ) - , recordField - "signatures" - ( contramap Cabal.signatures ( listOf moduleName ) ) - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "Library" - } - - -data CondIfTree v a - = Val a - | If v ( CondIfTree v a ) ( CondIfTree v a ) - deriving (Eq, Show) - - -unifyCondTree - :: ( Monoid a, Monoid x ) - => Cabal.CondTree v x a - -> CondIfTree ( Cabal.Condition v ) a -unifyCondTree = - let - go acc condTree = - case Cabal.condTreeComponents condTree of - [] -> - Val ( acc <> Cabal.condTreeData condTree ) - - [c] -> - If - ( Cabal.condBranchCondition c ) - ( go - ( acc <> Cabal.condTreeData condTree ) - ( Cabal.condBranchIfTrue c ) - ) - ( go - ( acc <> Cabal.condTreeData condTree ) - ( case Cabal.condBranchIfFalse c of - Nothing -> - Cabal.CondNode mempty mempty mempty - - Just c -> - c - ) - ) - - (c:cs) -> - go acc ( condTree { Cabal.condTreeComponents = pushDownBranch c <$> cs } ) - - pushDownBranch a b = - b - { Cabal.condBranchIfTrue = - pushDownTree a ( Cabal.condBranchIfTrue b ) - , Cabal.condBranchIfFalse = - case Cabal.condBranchIfFalse b of - Nothing -> - Just ( Cabal.CondNode mempty mempty [a] ) - - Just tree -> - Just ( pushDownTree a tree ) - } - - pushDownTree a b = - b { Cabal.condTreeComponents = a : Cabal.condTreeComponents b } - - in - go mempty - - -condTree - :: ( Monoid a, Monoid x ) - => Dhall.InputType a - -> Dhall.InputType ( Cabal.CondTree Cabal.ConfVar x a ) -condTree t = - let - go = \case - Val a -> - Dhall.embed t a - - If cond a b -> - Expr.BoolIf - ( Dhall.embed condBranchCondition cond ) - ( go a ) - ( go b ) - - configRecord = - Expr.Var "types" `Expr.Field` "ConfigOptions" - - in - Dhall.InputType - { Dhall.embed = - Expr.Lam "config" configRecord - . go - . unifyCondTree - , Dhall.declared = - Expr.Pi "_" configRecord ( Dhall.declared t ) - } - - -moduleName :: Dhall.InputType Cabal.ModuleName -moduleName = - contramap ( show . Cabal.disp ) stringToDhall - - -condBranchCondition :: Dhall.InputType (Cabal.Condition Cabal.ConfVar) -condBranchCondition = - Dhall.InputType - { Dhall.declared = Expr.Bool - , Dhall.embed = - \a -> - case a of - Cabal.Var ( Cabal.OS os0 ) -> - Expr.App ( Expr.Field ( Expr.Var "config" ) "os" ) ( Dhall.embed os os0 ) - - Cabal.Var ( Cabal.Arch arch0 ) -> - Expr.App ( Expr.Field ( Expr.Var "config" ) "arch" ) ( Dhall.embed arch arch0 ) - - Cabal.Var ( Cabal.Flag flagName0 ) -> - Expr.App ( Expr.Field ( Expr.Var "config" ) "flag" ) ( Dhall.embed flagName flagName0 ) - - Cabal.Var ( Cabal.Impl c v ) -> - Expr.App ( Expr.App ( Expr.Field ( Expr.Var "config" ) "impl" ) ( Dhall.embed compilerFlavor c ) ) ( Dhall.embed versionRange v ) - - Cabal.Lit b -> - Expr.BoolLit b - - Cabal.CNot c -> - Expr.BoolEQ ( Expr.BoolLit False ) ( Dhall.embed condBranchCondition c ) - - Cabal.CAnd a b -> - Expr.BoolAnd ( Dhall.embed condBranchCondition a ) ( Dhall.embed condBranchCondition b ) - - Cabal.COr a b -> - Expr.BoolOr ( Dhall.embed condBranchCondition a ) ( Dhall.embed condBranchCondition b ) - } - - -os :: Dhall.InputType Cabal.OS -os = - Dhall.InputType - { Dhall.embed = \case - Cabal.Linux -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Linux" ) - ( Expr.RecordLit mempty ) - - Cabal.Windows -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Windows" ) - ( Expr.RecordLit mempty ) - - Cabal.OSX -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "OSX" ) - ( Expr.RecordLit mempty ) - - Cabal.FreeBSD -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "FreeBSD" ) - ( Expr.RecordLit mempty ) - - Cabal.OpenBSD -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "OpenBSD" ) - ( Expr.RecordLit mempty ) - - Cabal.NetBSD -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "NetBSD" ) - ( Expr.RecordLit mempty ) - - Cabal.DragonFly -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "DragonFly" ) - ( Expr.RecordLit mempty ) - - Cabal.Solaris -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Solaris" ) - ( Expr.RecordLit mempty ) - - Cabal.AIX -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "AIX" ) - ( Expr.RecordLit mempty ) - - Cabal.HPUX -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "HPUX" ) - ( Expr.RecordLit mempty ) - - Cabal.IRIX -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "IRIX" ) - ( Expr.RecordLit mempty ) - - Cabal.HaLVM -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "HaLVM" ) - ( Expr.RecordLit mempty ) - - Cabal.Hurd -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Hurd" ) - ( Expr.RecordLit mempty ) - - Cabal.IOS -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "IOS" ) - ( Expr.RecordLit mempty ) - - Cabal.Android -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Android" ) - ( Expr.RecordLit mempty ) - - Cabal.Ghcjs -> - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Ghcjs" ) - ( Expr.RecordLit mempty ) - - , Dhall.declared = - Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OS" - } - - -arch :: Dhall.InputType Cabal.Arch -arch = - runUnion - ( mconcat - [ unionAlt "I386" ( \x -> case x of Cabal.I386 -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "X86_64" ( \x -> case x of Cabal.X86_64 -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "PPC" ( \x -> case x of Cabal.PPC -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "PPC64" ( \x -> case x of Cabal.PPC64 -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Sparc" ( \x -> case x of Cabal.Sparc -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Arm" ( \x -> case x of Cabal.Arm -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Mips" ( \x -> case x of Cabal.Mips -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "SH" ( \x -> case x of Cabal.SH -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "IA64" ( \x -> case x of Cabal.IA64 -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "S390" ( \x -> case x of Cabal.S390 -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Alpha" ( \x -> case x of Cabal.Alpha -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Hppa" ( \x -> case x of Cabal.Hppa -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Rs6000" ( \x -> case x of Cabal.Rs6000 -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "M68k" ( \x -> case x of Cabal.M68k -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Vax" ( \x -> case x of Cabal.Vax -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "JavaScript" ( \x -> case x of Cabal.JavaScript -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "OtherArch" ( \x -> case x of Cabal.OtherArch s -> Just s ; _ -> Nothing ) ( runRecordInputType ( recordField "_1" stringToDhall ) ) - ] - ) - - -buildInfoRecord :: RecordInputType Cabal.BuildInfo -buildInfoRecord = - mconcat - [ recordField "buildable" ( contramap Cabal.buildable Dhall.inject ) - , recordField "build-tools" ( contramap Cabal.buildTools ( listOf legacyExeDependency ) ) - , recordField "build-tool-depends" ( contramap Cabal.buildToolDepends ( listOf exeDependency ) ) - , recordField "cpp-options" ( contramap Cabal.cppOptions ( listOf stringToDhall ) ) - , recordField "cc-options" ( contramap Cabal.ccOptions ( listOf stringToDhall ) ) - , recordField "ld-options" ( contramap Cabal.ldOptions ( listOf stringToDhall ) ) - , recordField "pkgconfig-depends" ( contramap Cabal.pkgconfigDepends ( listOf pkgconfigDependency ) ) - , recordField "frameworks" ( contramap Cabal.frameworks ( listOf stringToDhall ) ) - , recordField "extra-framework-dirs" ( contramap Cabal.extraFrameworkDirs ( listOf stringToDhall ) ) - , recordField "c-sources" ( contramap Cabal.cSources ( listOf stringToDhall ) ) - , recordField "js-sources" ( contramap Cabal.jsSources ( listOf stringToDhall ) ) - , recordField "hs-source-dirs" ( contramap Cabal.hsSourceDirs ( listOf stringToDhall ) ) - , recordField "other-modules" ( contramap Cabal.otherModules ( listOf moduleName ) ) - , recordField "autogen-modules" ( contramap Cabal.autogenModules ( listOf moduleName ) ) - , recordField "default-language" ( contramap Cabal.defaultLanguage ( maybeToDhall language ) ) - , recordField "other-languages" ( contramap Cabal.otherLanguages ( listOf language ) ) - , recordField "default-extensions" ( Cabal.defaultExtensions >$< listOf extension ) - , recordField "other-extensions" ( Cabal.otherExtensions >$< listOf extension ) - , recordField "extra-libraries" ( Cabal.extraLibs >$< listOf stringToDhall ) - , recordField "extra-ghci-libraries" ( Cabal.extraGHCiLibs >$< listOf stringToDhall ) - , recordField "extra-lib-dirs" ( Cabal.extraLibDirs >$< listOf stringToDhall ) - , recordField "include-dirs" ( Cabal.includeDirs >$< listOf stringToDhall ) - , recordField "includes" ( Cabal.includes >$< listOf stringToDhall ) - , recordField "install-includes" ( Cabal.installIncludes >$< listOf stringToDhall ) - , recordField "compiler-options" ( Cabal.options >$< compilerOptions ) - , recordField "profiling-options" ( Cabal.profOptions >$< compilerOptions ) - , recordField "shared-options" ( Cabal.sharedOptions >$< compilerOptions ) - , recordField "build-depends" ( Cabal.targetBuildDepends >$< listOf dependency ) - , recordField "mixins" ( Cabal.mixins >$< listOf mixin ) - ] - - -moduleReexport :: Dhall.InputType Cabal.ModuleReexport -moduleReexport = - runRecordInputType - ( mconcat - [ recordField "original" - ( ( \a -> ( Cabal.moduleReexportOriginalPackage a, Cabal.moduleReexportOriginalName a ) ) >$< - runRecordInputType - ( mconcat - [ recordField "package" ( fst >$< maybeToDhall packageNameToDhall ) - , recordField "name" ( snd >$< moduleName ) - ] - ) - ) - , recordField "name" ( Cabal.moduleReexportName >$< moduleName ) - ] - ) - - -legacyExeDependency :: Dhall.InputType Cabal.LegacyExeDependency -legacyExeDependency = - runRecordInputType - ( mconcat - [ recordField "exe" ( ( \( Cabal.LegacyExeDependency exe _ ) -> exe ) >$< stringToDhall ) - , recordField "version" ( ( \( Cabal.LegacyExeDependency _ version ) -> version ) >$< versionRange ) - ] - ) - -exeDependency :: Dhall.InputType Cabal.ExeDependency -exeDependency = - runRecordInputType - ( mconcat - [ recordField "package" ( ( \( Cabal.ExeDependency packageName _ _ ) -> packageName ) >$< packageNameToDhall ) - , recordField "component" ( ( \( Cabal.ExeDependency _ component _ ) -> component ) >$< unqualComponentName ) - , recordField "version" ( ( \( Cabal.ExeDependency _ _ version ) -> version ) >$< versionRange ) - ] - ) - - -unqualComponentName :: Dhall.InputType Cabal.UnqualComponentName -unqualComponentName = - show . Cabal.disp >$< stringToDhall - - -pkgconfigDependency :: Dhall.InputType Cabal.PkgconfigDependency -pkgconfigDependency = - runRecordInputType - ( mconcat - [ recordField "name" ( ( \( Cabal.PkgconfigDependency a _version ) -> a ) >$< pkgconfigName ) - , recordField "version" ( ( \( Cabal.PkgconfigDependency _name a ) -> a ) >$< versionRange ) - ] - ) - - -pkgconfigName :: Dhall.InputType Cabal.PkgconfigName -pkgconfigName = - show . Cabal.disp >$< stringToDhall - - -language :: Dhall.InputType Cabal.Language -language = - ( runUnion - ( mconcat - [ unionAlt "Haskell2010" ( \x -> case x of Cabal.Haskell2010 -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "UnknownLanguage" ( \x -> case x of Cabal.UnknownLanguage s -> Just s ; _ -> Nothing ) ( runRecordInputType ( recordField "_1" stringToDhall ) ) - , unionAlt "Haskell98" ( \x -> case x of Cabal.Haskell98 -> Just () ; _ -> Nothing ) Dhall.inject - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "Language" - } - -extension :: Dhall.InputType Cabal.Extension -extension = - Dhall.InputType - { Dhall.embed = - \a -> - case a of - Cabal.EnableExtension ext -> - extWith True ext - - Cabal.DisableExtension ext -> - extWith False ext - - _ -> - error "Unknown extension" - , Dhall.declared = - Expr.Var "types" `Expr.Field` "Extension" - } - - where - - extName :: Cabal.KnownExtension -> LazyText.Text - extName e = - LazyText.pack ( show e ) - - extWith trueFalse ext = - Expr.App - ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "Extensions" `Expr.Field` extName ext ) - ( Expr.BoolLit trueFalse ) - - -compilerOptions :: Dhall.InputType [ ( Cabal.CompilerFlavor, [ String ] ) ] -compilerOptions = - Dhall.InputType - { Dhall.embed = \l -> - case filter ( not . null . snd ) l of - [] -> - Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` "CompilerOptions" - - xs -> - Expr.Prefer - ( Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` "compiler-options" ) - ( Expr.RecordLit - ( Map.fromList - ( map - ( \( c, opts ) -> - ( LazyText.pack ( show c ), Dhall.embed Dhall.inject opts ) - ) - xs - ) - ) - ) - , Dhall.declared = - Expr.Var "types" `Expr.Field` "CompilerOptions" - } - - where - - field c = - recordField ( LazyText.pack ( show c ) ) ( filtering c ) - - filtering c = - contramap - ( \l -> join [ opts | ( c', opts ) <- l, c == c' ] ) - ( listOf stringToDhall ) - - -mixin :: Dhall.InputType Cabal.Mixin -mixin = - ( runRecordInputType - ( mconcat - [ recordField "package" ( Cabal.mixinPackageName >$< packageNameToDhall ) - , recordField "renaming" ( Cabal.mixinIncludeRenaming >$< includeRenaming ) - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "Mixin" - - } - - -includeRenaming :: Dhall.InputType Cabal.IncludeRenaming -includeRenaming = - runRecordInputType - ( mconcat - [ recordField "provides" ( Cabal.includeProvidesRn >$< moduleRenaming ) - , recordField "requires" ( Cabal.includeRequiresRn >$< moduleRenaming ) - ] - ) - - -moduleRenaming :: Dhall.InputType Cabal.ModuleRenaming -moduleRenaming = - ( \( Cabal.ModuleRenaming a ) -> a ) >$< - listOf - ( runRecordInputType - ( mconcat - [ recordField "rename" ( ( \( a, _ ) -> a ) >$< moduleName ) - , recordField "to" ( ( \( _, a ) -> a ) >$< moduleName ) - ] - ) - ) - - -benchmark :: Dhall.InputType Cabal.Benchmark -benchmark = - ( runRecordInputType - ( mconcat - [ recordField "main-is" ( ( \( Cabal.BenchmarkExeV10 _ s ) -> s ) . Cabal.benchmarkInterface >$< stringToDhall ) - , Cabal.benchmarkBuildInfo >$< buildInfoRecord - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "Benchmark" - } - - -testSuite :: Dhall.InputType Cabal.TestSuite -testSuite = - ( runRecordInputType - ( mconcat - [ recordField "type" ( Cabal.testInterface >$< testSuiteInterface ) - , Cabal.testBuildInfo >$< buildInfoRecord - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "TestSuite" - } - - -testSuiteInterface :: Dhall.InputType Cabal.TestSuiteInterface -testSuiteInterface = - runUnion - ( mconcat - [ unionAlt - "exitcode-stdio" - ( \x -> - case x of - Cabal.TestSuiteExeV10 _ main -> - Just main - - _ -> - Nothing - ) - ( runRecordInputType ( recordField "main-is" stringToDhall ) ) - , unionAlt - "detailed" - ( \x -> - case x of - Cabal.TestSuiteLibV09 _ m -> - Just m - - _ -> - Nothing - ) - ( runRecordInputType ( recordField "module" moduleName ) ) - ] - ) - - -executable :: Dhall.InputType Cabal.Executable -executable = - ( runRecordInputType - ( mconcat - [ recordField "main-is" ( Cabal.modulePath >$< stringToDhall ) - , recordField "scope" ( Cabal.exeScope >$< executableScope ) - , Cabal.buildInfo >$< buildInfoRecord - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "Executable" - } - - -executableScope :: Dhall.InputType Cabal.ExecutableScope -executableScope = - runUnion - ( mconcat - [ unionAlt - "Public" - ( \x -> - case x of - Cabal.ExecutablePublic -> Just () - Cabal.ExecutableScopeUnknown -> Just () - _ -> Nothing - ) - Dhall.inject - , unionAlt "Private" ( \x -> case x of Cabal.ExecutablePrivate -> Just () ; _ -> Nothing ) Dhall.inject - ] - ) - - -foreignLibrary :: Dhall.InputType Cabal.ForeignLib -foreignLibrary = - ( runRecordInputType - ( mconcat - [ recordField "type" ( Cabal.foreignLibType >$< foreignLibType ) - , recordField "options" ( Cabal.foreignLibOptions >$< ( listOf foreignLibOption ) ) - , Cabal.foreignLibBuildInfo >$< buildInfoRecord - , recordField "lib-version-info" ( Cabal.foreignLibVersionInfo >$< maybeToDhall versionInfo ) - , recordField "lib-version-linux" ( Cabal.foreignLibVersionLinux >$< maybeToDhall versionToDhall ) - , recordField "mod-def-files" ( Cabal.foreignLibModDefFile >$< listOf stringToDhall ) - ] - ) - ) - { Dhall.declared = - Expr.Var "types" `Expr.Field` "ForeignLibrary" - } - - -versionInfo :: Dhall.InputType Cabal.LibVersionInfo -versionInfo = - Cabal.libVersionInfoCRA >$< - runRecordInputType - ( mconcat - [ recordField "current" ( ( \( a, _, _ ) -> fromIntegral a :: Natural ) >$< ( Dhall.inject ) ) - , recordField "revision" ( ( \( _, a, _ ) -> fromIntegral a :: Natural ) >$< ( Dhall.inject ) ) - , recordField "age" ( ( \( _, _, a ) -> fromIntegral a :: Natural ) >$< ( Dhall.inject ) ) - ] - ) - - -foreignLibOption :: Dhall.InputType Cabal.ForeignLibOption -foreignLibOption = - runUnion - ( unionAlt "Standalone" ( \x -> case x of Cabal.ForeignLibStandalone -> Just () ; _ -> Nothing ) Dhall.inject - ) - - -foreignLibType :: Dhall.InputType Cabal.ForeignLibType -foreignLibType = - runUnion - ( mconcat - [ unionAlt "Shared" ( \x -> case x of Cabal.ForeignLibNativeShared -> Just () ; _ -> Nothing ) Dhall.inject - , unionAlt "Static" ( \x -> case x of Cabal.ForeignLibNativeStatic -> Just () ; _ -> Nothing ) Dhall.inject - ] - ) +{-# language NamedFieldPuns #-} +{-# language OverloadedStrings #-} + +module Main ( main ) where + +import Control.Applicative ( (<**>), optional ) +import GHC.Stack + +import qualified Data.ByteString as ByteString +import qualified Data.Text.Lazy as LazyText +import qualified Data.Text.Lazy.IO as LazyText +import qualified Data.Text.Prettyprint.Doc as Pretty +import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty +import qualified Data.Text.Prettyprint.Doc.Symbols.Unicode as Pretty +import qualified Dhall.Core +import qualified Options.Applicative as OptParse +import qualified System.IO + +import CabalToDhall ( cabalToDhall ) +import DhallLocation ( dhallFromGitHub ) + + +data Command + = RunCabalToDhall CabalToDhallOptions + + +data CabalToDhallOptions = CabalToDhallOptions + { cabalFilePath :: Maybe String + } + + +cabalToDhallOptionsParser :: OptParse.Parser CabalToDhallOptions +cabalToDhallOptionsParser = + CabalToDhallOptions + <$> + optional + ( OptParse.argument + OptParse.str + ( mconcat + [ OptParse.metavar "" + , OptParse.help "The Cabal file to convert to Dhall" + ] + ) + ) + + +commandLineParser = + RunCabalToDhall <$> ( cabalToDhallOptionsParser <**> OptParse.helper ) + + +main :: IO () +main = do + command <- + OptParse.execParser + ( OptParse.info commandLineParser mempty ) + + case command of + RunCabalToDhall options -> + runCabalToDhall options + + +runCabalToDhall :: CabalToDhallOptions -> IO () +runCabalToDhall CabalToDhallOptions{ cabalFilePath } = do + source <- + case cabalFilePath of + Nothing -> + ByteString.getContents + + Just filePath -> + ByteString.readFile filePath + + dhall <- + cabalToDhall dhallFromGitHub source + + Pretty.renderIO + System.IO.stdout + ( Pretty.layoutSmart opts + ( Pretty.pretty dhall ) + ) + + putStrLn "" + + + +-- Shamelessly taken from dhall-format + +-- Note: must remain in sync with the layout options in +-- golden-tests/GoldenTests.hs, so that test output is easy to generate +-- at the command line. +opts :: Pretty.LayoutOptions +opts = + Pretty.defaultLayoutOptions + { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 } diff --git a/dhall-to-cabal.cabal b/dhall-to-cabal.cabal --- a/dhall-to-cabal.cabal +++ b/dhall-to-cabal.cabal @@ -1,21 +1,30 @@ -name: dhall-to-cabal -version: 1.0.0.1 cabal-version: 2.0 -build-type: Simple +-- * * * * * * * * * * * * WARNING * * * * * * * * * * * * +-- This file has been AUTO-GENERATED by dhall-to-cabal. +-- +-- Do not edit it by hand, because your changes will be over-written! +-- +-- Instead, edit the source Dhall file, namely +-- 'dhall-to-cabal.dhall', and re-generate this file by running +-- 'dhall-to-cabal -- dhall-to-cabal.dhall > dhall-to-cabal.cabal'. +-- * * * * * * * * * * * * WARNING * * * * * * * * * * * * +name: dhall-to-cabal +version: 1.1.0.0 license: MIT license-file: LICENSE maintainer: ollie@ocharles.org.uk +author: Ollie Charles homepage: https://github.com/ocharles/dhall-to-cabal bug-reports: https://github.com/ocharles/dhall-to-cabal/issues synopsis: Compile Dhall expressions to Cabal files description: - dhall-to-cabal takes Dhall expressions and compiles them into Cabal + dhall-to-cabal takes Dhall expressions and compiles them into Cabal files. All of the features of Dhall are supported, such as let - bindings and imports, and all features of Cabal are supported + bindings and imports, and all features of Cabal are supported (including conditional stanzas). . category: Distribution -author: Ollie Charles +build-type: Simple extra-source-files: Changelog.md README.md @@ -75,6 +84,19 @@ dhall/types/VersionRange/MajorBoundVersion.dhall dhall/types/VersionRange/UnionVersionRanges.dhall dhall/types/SetupBuildInfo.dhall + dhall/types/SPDX.dhall + dhall/types/SPDX/License.dhall + dhall/types/SPDX/LicenseVersionOrLater.dhall + dhall/types/SPDX/Ref.dhall + dhall/types/SPDX/RefWithFile.dhall + dhall/types/SPDX/And.dhall + dhall/types/SPDX/Or.dhall + dhall/types/SPDX/LicenseExceptionId.dhall + dhall/types/SPDX/LicenseId.dhall + golden-tests/dhall-to-cabal/*.dhall + golden-tests/dhall-to-cabal/*.cabal + golden-tests/cabal-to-dhall/*.dhall + golden-tests/cabal-to-dhall/*.cabal source-repository head type: git @@ -83,75 +105,79 @@ library exposed-modules: DhallToCabal + DhallLocation + CabalToDhall + hs-source-dirs: lib + other-modules: + DhallToCabal.ConfigTree + DhallToCabal.Diff + Dhall.Extra + Paths_dhall_to_cabal + autogen-modules: + Paths_dhall_to_cabal + default-language: Haskell2010 + other-extensions: ApplicativeDo GADTs GeneralizedNewtypeDeriving + LambdaCase OverloadedStrings RecordWildCards TypeApplications + ghc-options: -Wall -fno-warn-name-shadowing build-depends: - Cabal ^>=2.0, - base ^>=4.10, + Cabal ^>=2.2, + base ^>=4.10 || ^>=4.11, bytestring ^>=0.10, containers ^>=0.5, - dhall ^>=1.12.0, + contravariant ^>=1.4, + dhall ^>=1.14.0, formatting ^>=6.3.1, hashable ^>=1.2.6.1, insert-ordered-containers ^>=0.2.1.0, text ^>=1.2, transformers ^>=0.5.2, - trifecta ^>=1.7, vector ^>=0.12 - default-language: Haskell2010 - other-extensions: ApplicativeDo GADTs GeneralizedNewtypeDeriving - LambdaCase OverloadedStrings RecordWildCards TypeApplications - hs-source-dirs: lib - other-modules: - DhallToCabal.ConfigTree - DhallToCabal.Diff - Dhall.Extra - ghc-options: -Wall -fno-warn-name-shadowing -executable dhall-to-cabal +executable dhall-to-cabal main-is: Main.hs - scope: public + hs-source-dirs: exe + default-language: Haskell2010 + other-extensions: NamedFieldPuns build-depends: - Cabal ^>=2.0, - base ^>=4.10, - dhall ^>=1.12.0, + Cabal ^>=2.2, + base ^>=4.10 || ^>=4.11, + dhall ^>=1.14.0, dhall-to-cabal -any, + insert-ordered-containers ^>=0.2.1.0, optparse-applicative ^>=0.13.2 || ^>=0.14, prettyprinter ^>=1.2.0.1, - text ^>=1.2 - default-language: Haskell2010 - other-extensions: NamedFieldPuns - hs-source-dirs: exe + text ^>=1.2, + transformers ^>=0.5.2 -executable cabal-to-dhall +executable cabal-to-dhall main-is: Main.hs - scope: public + hs-source-dirs: cabal-to-dhall + default-language: Haskell2010 + other-extensions: NamedFieldPuns build-depends: - Cabal ^>=2.0, - base ^>=4.10, - contravariant ^>=1.4, - dhall ^>=1.12.0, - hashable ^>=1.2.6.1, + base ^>=4.10 || ^>=4.11, + dhall ^>=1.14.0, + bytestring ^>=0.10, dhall-to-cabal -any, - insert-ordered-containers ^>=0.2.1.0, optparse-applicative ^>=0.13.2 || ^>=0.14, prettyprinter ^>=1.2.0.1, text ^>=1.2 - default-language: Haskell2010 - other-extensions: NamedFieldPuns - hs-source-dirs: cabal-to-dhall -test-suite golden-tests +test-suite golden-tests type: exitcode-stdio-1.0 main-is: GoldenTests.hs + hs-source-dirs: golden-tests + default-language: Haskell2010 build-depends: - base ^>=4.10, - Cabal ^>=2.0, + base ^>=4.10 || ^>=4.11, + Cabal ^>=2.2, Diff ^>=0.3.4, bytestring ^>=0.10, + dhall ^>=1.14.0, dhall-to-cabal -any, filepath ^>=1.4, - tasty ^>=0.11, + prettyprinter ^>=1.2.0.1, + tasty ^>=0.11 || ^>=0.12 || ^>=1.0 || ^>=1.1, tasty-golden ^>=2.3, text ^>=1.2 - default-language: Haskell2010 - hs-source-dirs: golden-tests diff --git a/dhall/defaults/BuildInfo.dhall b/dhall/defaults/BuildInfo.dhall --- a/dhall/defaults/BuildInfo.dhall +++ b/dhall/defaults/BuildInfo.dhall @@ -60,7 +60,27 @@ , profiling-options = ./CompilerOptions.dhall , shared-options = - ./CompilerOptions.dhall + ./CompilerOptions.dhall +, static-options = + ./CompilerOptions.dhall , mixins = - [] : List ../types/Mixin.dhall + [] : 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 } 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,2 @@ ./BuildInfo.dhall -⫽ { main-is = "", scope = (constructors ../types/Scope.dhall ).Public {=} } +⫽ { scope = (constructors ../types/Scope.dhall ).Public {=} } diff --git a/dhall/defaults/Package.dhall b/dhall/defaults/Package.dhall --- a/dhall/defaults/Package.dhall +++ b/dhall/defaults/Package.dhall @@ -56,8 +56,6 @@ [] : List Text , maintainer = "" -, name = - "" , package-url = "" , source-repos = diff --git a/dhall/prelude.dhall b/dhall/prelude.dhall --- a/dhall/prelude.dhall +++ b/dhall/prelude.dhall @@ -10,7 +10,11 @@ , Languages = constructors ./types/Language.dhall , Licenses = - constructors ./types/License.dhall + constructors ./types/License.dhall + , LicenseExceptionId = + constructors ./types/SPDX/LicenseExceptionId.dhall + , LicenseId = + constructors ./types/SPDX/LicenseId.dhall , TestTypes = constructors ./types/TestType.dhall } @@ -110,5 +114,21 @@ ./GitHub-project.dhall } , unconditional = - ./unconditional.dhall + ./unconditional.dhall +, SPDX = + { license = + ./types/SPDX/License.dhall + , licenseVersionOrLater = + ./types/SPDX/LicenseVersionOrLater.dhall + , ref = + ./types/SPDX/Ref.dhall + , refWithFile = + ./types/SPDX/RefWithFile.dhall + , and = + ./types/SPDX/And.dhall + , or = + ./types/SPDX/Or.dhall + , noException = + [] : Optional ./types/SPDX/LicenseExceptionId.dhall + } } diff --git a/dhall/types/Benchmark.dhall b/dhall/types/Benchmark.dhall --- a/dhall/types/Benchmark.dhall +++ b/dhall/types/Benchmark.dhall @@ -1,61 +1,1 @@ -{ autogen-modules : - List Text -, build-depends : - List ./Dependency.dhall -, build-tool-depends : - List { component : Text, package : Text, version : ./VersionRange.dhall } -, build-tools : - List { exe : Text, version : ./VersionRange.dhall } -, buildable : - Bool -, c-sources : - List Text -, cc-options : - List Text -, compiler-options : - ./CompilerOptions.dhall -, cpp-options : - List Text -, default-extensions : - List ./Extension.dhall -, default-language : - Optional ./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 -, main-is : - Text -, other-extensions : - List ./Extension.dhall -, other-languages : - List ./Language.dhall -, other-modules : - List Text -, pkgconfig-depends : - List { name : Text, version : ./VersionRange.dhall } -, profiling-options : - ./CompilerOptions.dhall -, shared-options : - ./CompilerOptions.dhall -, mixins : - List ./Mixin.dhall -} +./BuildInfo.dhall ⩓ { main-is : Text } diff --git a/dhall/types/BuildType.dhall b/dhall/types/BuildType.dhall --- a/dhall/types/BuildType.dhall +++ b/dhall/types/BuildType.dhall @@ -6,6 +6,4 @@ {} | Simple : {} -| UnknownBuildType : - { _1 : Text } > diff --git a/dhall/types/Executable.dhall b/dhall/types/Executable.dhall --- a/dhall/types/Executable.dhall +++ b/dhall/types/Executable.dhall @@ -1,63 +1,1 @@ -{ autogen-modules : - List Text -, build-depends : - List ./Dependency.dhall -, build-tool-depends : - List { component : Text, package : Text, version : ./VersionRange.dhall } -, build-tools : - List { exe : Text, version : ./VersionRange.dhall } -, buildable : - Bool -, c-sources : - List Text -, cc-options : - List Text -, compiler-options : - ./CompilerOptions.dhall -, cpp-options : - List Text -, default-extensions : - List ./Extension.dhall -, default-language : - Optional ./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 ./Extension.dhall -, other-languages : - List ./Language.dhall -, other-modules : - List Text -, pkgconfig-depends : - List { name : Text, version : ./VersionRange.dhall } -, profiling-options : - ./CompilerOptions.dhall -, shared-options : - ./CompilerOptions.dhall -, main-is : - Text -, scope : - ./Scope.dhall -, mixins : - List ./Mixin.dhall -} +./BuildInfo.dhall ⩓ { main-is : Text, scope : ./Scope.dhall } diff --git a/dhall/types/Extension.dhall b/dhall/types/Extension.dhall --- a/dhall/types/Extension.dhall +++ b/dhall/types/Extension.dhall @@ -38,6 +38,8 @@ Bool | DeriveTraversable : Bool +| DerivingStrategies : + Bool | DisambiguateRecordFields : Bool | DoAndIfThenElse : @@ -80,6 +82,8 @@ Bool | HereDocuments : Bool +| HexFloatLiterals : + Bool | ImplicitParams : Bool | ImplicitPrelude : @@ -219,6 +223,8 @@ | TypeOperators : Bool | TypeSynonymInstances : + Bool +| UnboxedSums : Bool | UnboxedTuples : Bool diff --git a/dhall/types/ForeignLibrary.dhall b/dhall/types/ForeignLibrary.dhall --- a/dhall/types/ForeignLibrary.dhall +++ b/dhall/types/ForeignLibrary.dhall @@ -1,69 +1,12 @@ -{ autogen-modules : - List Text -, build-depends : - List ./Dependency.dhall -, build-tool-depends : - List { component : Text, package : Text, version : ./VersionRange.dhall } -, build-tools : - List { exe : Text, version : ./VersionRange.dhall } -, buildable : - Bool -, c-sources : - List Text -, cc-options : - List Text -, compiler-options : - ./CompilerOptions.dhall -, cpp-options : - List Text -, default-extensions : - List ./Extension.dhall -, default-language : - Optional ./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 -, lib-version-linux : - Optional ./Version.dhall -, mod-def-files : - List Text -, options : - List < Standalone : {} > -, other-extensions : - List ./Extension.dhall -, other-languages : - List ./Language.dhall -, other-modules : - List Text -, pkgconfig-depends : - List { name : Text, version : ./VersionRange.dhall } -, profiling-options : - ./CompilerOptions.dhall -, shared-options : - ./CompilerOptions.dhall -, type : - < Shared : {} | Static : {} > -, lib-version-info : - Optional { age : Natural, current : Natural, revision : Natural } -, mixins : - List ./Mixin.dhall -} + ./BuildInfo.dhall +⩓ { type : + < Shared : {} | Static : {} > + , options : + List < Standalone : {} > + , lib-version-info : + Optional { age : Natural, current : Natural, revision : Natural } + , lib-version-linux : + Optional ./Version.dhall + , mod-def-files : + List Text + } diff --git a/dhall/types/Library.dhall b/dhall/types/Library.dhall --- a/dhall/types/Library.dhall +++ b/dhall/types/Library.dhall @@ -1,65 +1,8 @@ -{ autogen-modules : - List Text -, build-depends : - List ./Dependency.dhall -, build-tool-depends : - List { component : Text, package : Text, version : ./VersionRange.dhall } -, build-tools : - List { exe : Text, version : ./VersionRange.dhall } -, buildable : - Bool -, c-sources : - List Text -, cc-options : - List Text -, compiler-options : - ./CompilerOptions.dhall -, cpp-options : - List Text -, default-extensions : - List ./Extension.dhall -, default-language : - Optional ./Language.dhall -, exposed-modules : - List Text -, 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 ./Extension.dhall -, other-languages : - List ./Language.dhall -, other-modules : - List Text -, pkgconfig-depends : - List { name : Text, version : ./VersionRange.dhall } -, profiling-options : - ./CompilerOptions.dhall -, reexported-modules : - List { name : Text, original : { name : Text, package : Optional Text } } -, shared-options : - ./CompilerOptions.dhall -, mixins : - List ./Mixin.dhall -, signatures : - List Text -} + ./BuildInfo.dhall +⩓ { exposed-modules : + List Text + , reexported-modules : + List { name : Text, original : { name : Text, package : Optional Text } } + , signatures : + List Text + } diff --git a/dhall/types/License.dhall b/dhall/types/License.dhall --- a/dhall/types/License.dhall +++ b/dhall/types/License.dhall @@ -26,4 +26,6 @@ {} | Unspecified : {} +| SPDX : + ./SPDX.dhall > diff --git a/dhall/types/SPDX.dhall b/dhall/types/SPDX.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX.dhall @@ -0,0 +1,10 @@ + let LicenseExceptionId : Type = ./SPDX/LicenseExceptionId.dhall +in let LicenseId : Type = ./SPDX/LicenseId.dhall +in ∀(SPDX : Type) + → ∀(license : LicenseId → Optional LicenseExceptionId → SPDX) + → ∀(licenseVersionOrLater : LicenseId → Optional LicenseExceptionId → SPDX) + → ∀(ref : Text → Optional LicenseExceptionId → SPDX) + → ∀(refWithFile : Text → Text → Optional LicenseExceptionId → SPDX) + → ∀(and : SPDX → SPDX → SPDX) + → ∀(or : SPDX → SPDX → SPDX) + → SPDX diff --git a/dhall/types/SPDX/And.dhall b/dhall/types/SPDX/And.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX/And.dhall @@ -0,0 +1,30 @@ + let LicenseId = ./LicenseId.dhall +in let LicenseExceptionId = ./LicenseExceptionId.dhall +in λ(a : ../SPDX.dhall ) + → λ(b : ../SPDX.dhall ) + → λ(SPDX : Type) + → λ(license : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(licenseVersionOrLater : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(ref : Text → Optional LicenseExceptionId → SPDX) + → λ(refWithFile : Text → Text → Optional LicenseExceptionId → SPDX) + → λ(and : SPDX → SPDX → SPDX) + → λ(or : SPDX → SPDX → SPDX) + → and + ( a + SPDX + license + licenseVersionOrLater + ref + refWithFile + and + or + ) + ( b + SPDX + license + licenseVersionOrLater + ref + refWithFile + and + or + ) diff --git a/dhall/types/SPDX/License.dhall b/dhall/types/SPDX/License.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX/License.dhall @@ -0,0 +1,12 @@ + let LicenseId = ./LicenseId.dhall +in let LicenseExceptionId = ./LicenseExceptionId.dhall +in λ(licenseId : LicenseId ) + → λ(licenseExceptionIdOpt : Optional LicenseExceptionId ) + → λ(SPDX : Type) + → λ(license : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(licenseVersionOrLater : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(ref : Text → Optional LicenseExceptionId → SPDX) + → λ(refWithFile : Text → Text → Optional LicenseExceptionId → SPDX) + → λ(and : SPDX → SPDX → SPDX) + → λ(or : SPDX → SPDX → SPDX) + → license licenseId licenseExceptionIdOpt diff --git a/dhall/types/SPDX/LicenseExceptionId.dhall b/dhall/types/SPDX/LicenseExceptionId.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX/LicenseExceptionId.dhall @@ -0,0 +1,55 @@ +< Autoconf_exception_2_0 : + {} +| Autoconf_exception_3_0 : + {} +| DS389_exception : + {} +| Bootloader_exception : + {} +| Classpath_exception_2_0 : + {} +| Bison_exception_2_2 : + {} +| DigiRule_FOSS_exception : + {} +| ECos_exception_2_0 : + {} +| CLISP_exception_2_0 : + {} +| Fawkes_Runtime_exception : + {} +| FLTK_exception : + {} +| Font_exception_2_0 : + {} +| Freertos_exception_2_0 : + {} +| GCC_exception_3_1 : + {} +| Gnu_javamail_exception : + {} +| GCC_exception_2_0 : + {} +| I2p_gpl_java_exception : + {} +| Libtool_exception : + {} +| Linux_syscall_note : + {} +| LZMA_exception : + {} +| Nokia_Qt_exception_1_1 : + {} +| OCCT_exception_1_0 : + {} +| Mif_exception : + {} +| Openvpn_openssl_exception : + {} +| Qwt_exception_1_0 : + {} +| U_boot_exception_2_0 : + {} +| WxWindows_exception_3_1 : + {} +> diff --git a/dhall/types/SPDX/LicenseId.dhall b/dhall/types/SPDX/LicenseId.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX/LicenseId.dhall @@ -0,0 +1,685 @@ +< NullBSD : + {} +| AAL : + {} +| Adobe_2006 : + {} +| Adobe_Glyph : + {} +| Abstyles : + {} +| ADSL : + {} +| AFL_1_1 : + {} +| AFL_2_0 : + {} +| AFL_2_1 : + {} +| AFL_1_2 : + {} +| AFL_3_0 : + {} +| Afmparse : + {} +| AGPL_3_0_only : + {} +| AGPL_3_0_or_later : + {} +| AGPL_1_0 : + {} +| AMDPLPA : + {} +| AML : + {} +| Aladdin : + {} +| ANTLR_PD : + {} +| Apache_1_0 : + {} +| AMPAS : + {} +| Apache_1_1 : + {} +| Apache_2_0 : + {} +| APL_1_0 : + {} +| APSL_1_0 : + {} +| APAFML : + {} +| APSL_1_1 : + {} +| APSL_1_2 : + {} +| Artistic_1_0_cl8 : + {} +| Artistic_1_0_Perl : + {} +| APSL_2_0 : + {} +| Artistic_1_0 : + {} +| Artistic_2_0 : + {} +| Barr : + {} +| Beerware : + {} +| Bahyph : + {} +| BitTorrent_1_1 : + {} +| Borceux : + {} +| BitTorrent_1_0 : + {} +| BSD_2_Clause_FreeBSD : + {} +| BSD_2_Clause_NetBSD : + {} +| BSD_1_Clause : + {} +| BSD_2_Clause_Patent : + {} +| BSD_2_Clause : + {} +| BSD_3_Clause_Clear : + {} +| BSD_3_Clause_LBNL : + {} +| BSD_3_Clause_Attribution : + {} +| BSD_3_Clause_No_Nuclear_License_2014 : + {} +| BSD_3_Clause_No_Nuclear_License : + {} +| BSD_3_Clause : + {} +| BSD_4_Clause_UC : + {} +| BSD_3_Clause_No_Nuclear_Warranty : + {} +| BSD_4_Clause : + {} +| BSD_Protection : + {} +| BSL_1_0 : + {} +| Bzip2_1_0_5 : + {} +| BSD_Source_Code : + {} +| Caldera : + {} +| CATOSL_1_1 : + {} +| Bzip2_1_0_6 : + {} +| CC_BY_2_0 : + {} +| CC_BY_2_5 : + {} +| CC_BY_1_0 : + {} +| CC_BY_3_0 : + {} +| CC_BY_4_0 : + {} +| CC_BY_NC_2_0 : + {} +| CC_BY_NC_2_5 : + {} +| CC_BY_NC_1_0 : + {} +| CC_BY_NC_4_0 : + {} +| CC_BY_NC_ND_1_0 : + {} +| CC_BY_NC_3_0 : + {} +| CC_BY_NC_ND_2_5 : + {} +| CC_BY_NC_ND_3_0 : + {} +| CC_BY_NC_ND_2_0 : + {} +| CC_BY_NC_ND_4_0 : + {} +| CC_BY_NC_SA_1_0 : + {} +| CC_BY_NC_SA_2_5 : + {} +| CC_BY_NC_SA_3_0 : + {} +| CC_BY_NC_SA_2_0 : + {} +| CC_BY_ND_1_0 : + {} +| CC_BY_ND_2_0 : + {} +| CC_BY_NC_SA_4_0 : + {} +| CC_BY_ND_3_0 : + {} +| CC_BY_ND_4_0 : + {} +| CC_BY_ND_2_5 : + {} +| CC_BY_SA_1_0 : + {} +| CC_BY_SA_2_0 : + {} +| CC_BY_SA_3_0 : + {} +| CC_BY_SA_4_0 : + {} +| CC_BY_SA_2_5 : + {} +| CC0_1_0 : + {} +| CDDL_1_0 : + {} +| CDLA_Permissive_1_0 : + {} +| CDLA_Sharing_1_0 : + {} +| CDDL_1_1 : + {} +| CECILL_1_0 : + {} +| CECILL_1_1 : + {} +| CECILL_2_1 : + {} +| CECILL_B : + {} +| CECILL_2_0 : + {} +| ClArtistic : + {} +| CNRI_Jython : + {} +| CECILL_C : + {} +| CNRI_Python : + {} +| Condor_1_1 : + {} +| CNRI_Python_GPL_Compatible : + {} +| CPAL_1_0 : + {} +| CPL_1_0 : + {} +| Crossword : + {} +| CrystalStacker : + {} +| CPOL_1_02 : + {} +| Cube : + {} +| Curl : + {} +| CUA_OPL_1_0 : + {} +| Diffmark : + {} +| DOC : + {} +| D_FSL_1_0 : + {} +| Dotseqn : + {} +| DSDP : + {} +| ECL_1_0 : + {} +| ECL_2_0 : + {} +| Dvipdfm : + {} +| EFL_2_0 : + {} +| EGenix : + {} +| EFL_1_0 : + {} +| EPL_1_0 : + {} +| EPL_2_0 : + {} +| Entessa : + {} +| ErlPL_1_1 : + {} +| EUDatagrid : + {} +| EUPL_1_1 : + {} +| EUPL_1_2 : + {} +| EUPL_1_0 : + {} +| Eurosym : + {} +| Fair : + {} +| FreeImage : + {} +| FSFAP : + {} +| Frameworx_1_0 : + {} +| FSFUL : + {} +| FSFULLR : + {} +| GFDL_1_1_only : + {} +| GFDL_1_1_or_later : + {} +| FTL : + {} +| GFDL_1_2_or_later : + {} +| GFDL_1_3_only : + {} +| GFDL_1_2_only : + {} +| Giftware : + {} +| GL2PS : + {} +| GFDL_1_3_or_later : + {} +| Glide : + {} +| Glulxe : + {} +| GPL_1_0_only : + {} +| GPL_1_0_or_later : + {} +| Gnuplot : + {} +| GPL_2_0_or_later : + {} +| GPL_3_0_only : + {} +| GPL_2_0_only : + {} +| GSOAP_1_3b : + {} +| HaskellReport : + {} +| GPL_3_0_or_later : + {} +| HPND : + {} +| IBM_pibs : + {} +| IJG : + {} +| ImageMagick : + {} +| ICU : + {} +| Imlib2 : + {} +| Info_ZIP : + {} +| IMatix : + {} +| Intel : + {} +| Interbase_1_0 : + {} +| Intel_ACPI : + {} +| IPA : + {} +| IPL_1_0 : + {} +| JasPer_2_0 : + {} +| JSON : + {} +| ISC : + {} +| LAL_1_2 : + {} +| LAL_1_3 : + {} +| Leptonica : + {} +| LGPL_2_0_only : + {} +| Latex2e : + {} +| LGPL_2_0_or_later : + {} +| LGPL_2_1_only : + {} +| LGPL_3_0_only : + {} +| LGPL_3_0_or_later : + {} +| LGPL_2_1_or_later : + {} +| Libpng : + {} +| Libtiff : + {} +| LGPLLR : + {} +| LiLiQ_R_1_1 : + {} +| LiLiQ_Rplus_1_1 : + {} +| LiLiQ_P_1_1 : + {} +| LPL_1_0 : + {} +| LPL_1_02 : + {} +| LPPL_1_1 : + {} +| LPPL_1_2 : + {} +| LPPL_1_0 : + {} +| LPPL_1_3a : + {} +| LPPL_1_3c : + {} +| MirOS : + {} +| MIT_advertising : + {} +| MakeIndex : + {} +| MIT_CMU : + {} +| MIT_enna : + {} +| MIT : + {} +| MITNFA : + {} +| MIT_feh : + {} +| Mpich2 : + {} +| MPL_1_0 : + {} +| Motosoto : + {} +| MPL_2_0_no_copyleft_exception : + {} +| MPL_2_0 : + {} +| MPL_1_1 : + {} +| MS_PL : + {} +| MS_RL : + {} +| Multics : + {} +| Mup : + {} +| MTLL : + {} +| NASA_1_3 : + {} +| Naumen : + {} +| NCSA : + {} +| Net_SNMP : + {} +| NBPL_1_0 : + {} +| NetCDF : + {} +| Newsletr : + {} +| NLOD_1_0 : + {} +| NLPL : + {} +| NGPL : + {} +| NOSL : + {} +| Noweb : + {} +| Nokia : + {} +| NPL_1_1 : + {} +| NPOSL_3_0 : + {} +| NPL_1_0 : + {} +| NRL : + {} +| NTP : + {} +| OCLC_2_0 : + {} +| ODbL_1_0 : + {} +| OCCT_PL : + {} +| OFL_1_1 : + {} +| OGTSL : + {} +| OFL_1_0 : + {} +| OLDAP_1_2 : + {} +| OLDAP_1_3 : + {} +| OLDAP_1_1 : + {} +| OLDAP_1_4 : + {} +| OLDAP_2_0_1 : + {} +| OLDAP_2_1 : + {} +| OLDAP_2_2_1 : + {} +| OLDAP_2_0 : + {} +| OLDAP_2_2 : + {} +| OLDAP_2_3 : + {} +| OLDAP_2_2_2 : + {} +| OLDAP_2_5 : + {} +| OLDAP_2_6 : + {} +| OLDAP_2_4 : + {} +| OLDAP_2_7 : + {} +| OLDAP_2_8 : + {} +| OpenSSL : + {} +| OPL_1_0 : + {} +| OML : + {} +| OSET_PL_2_1 : + {} +| OSL_1_0 : + {} +| OSL_2_0 : + {} +| OSL_2_1 : + {} +| OSL_1_1 : + {} +| OSL_3_0 : + {} +| PDDL_1_0 : + {} +| PHP_3_01 : + {} +| Plexus : + {} +| PHP_3_0 : + {} +| Psfrag : + {} +| Psutils : + {} +| PostgreSQL : + {} +| Qhull : + {} +| QPL_1_0 : + {} +| Python_2_0 : + {} +| Rdisc : + {} +| RHeCos_1_1 : + {} +| RPL_1_5 : + {} +| RPSL_1_0 : + {} +| RPL_1_1 : + {} +| RSCPL : + {} +| Ruby : + {} +| RSA_MD : + {} +| Saxpath : + {} +| SCEA : + {} +| SAX_PD : + {} +| Sendmail : + {} +| SGI_B_1_0 : + {} +| SGI_B_2_0 : + {} +| SimPL_2_0 : + {} +| SGI_B_1_1 : + {} +| SISSL : + {} +| Sleepycat : + {} +| SISSL_1_2 : + {} +| SMPPL : + {} +| SNIA : + {} +| SMLNJ : + {} +| Spencer_86 : + {} +| Spencer_94 : + {} +| SPL_1_0 : + {} +| SugarCRM_1_1_3 : + {} +| Spencer_99 : + {} +| SWL : + {} +| TCL : + {} +| TMate : + {} +| TORQUE_1_1 : + {} +| TCP_wrappers : + {} +| TOSL : + {} +| Unicode_DFS_2015 : + {} +| Unicode_TOU : + {} +| Unlicense : + {} +| Unicode_DFS_2016 : + {} +| Vim : + {} +| VOSTROM : + {} +| UPL_1_0 : + {} +| W3C_19980720 : + {} +| W3C_20150513 : + {} +| VSL_1_0 : + {} +| W3C : + {} +| Watcom_1_0 : + {} +| WTFPL : + {} +| X11 : + {} +| Wsuipa : + {} +| XFree86_1_1 : + {} +| Xinetd : + {} +| Xerox : + {} +| Xpp : + {} +| XSkat : + {} +| Xnet : + {} +| YPL_1_0 : + {} +| YPL_1_1 : + {} +| Zend_2_0 : + {} +| Zimbra_1_3 : + {} +| Zed : + {} +| Zlib_acknowledgement : + {} +| Zlib : + {} +| Zimbra_1_4 : + {} +| ZPL_2_0 : + {} +| ZPL_2_1 : + {} +| ZPL_1_1 : + {} +> diff --git a/dhall/types/SPDX/LicenseVersionOrLater.dhall b/dhall/types/SPDX/LicenseVersionOrLater.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX/LicenseVersionOrLater.dhall @@ -0,0 +1,12 @@ + let LicenseId = ./LicenseId.dhall +in let LicenseExceptionId = ./LicenseExceptionId.dhall +in λ(licenseId : LicenseId ) + → λ(licenseExceptionIdOpt : Optional LicenseExceptionId ) + → λ(SPDX : Type) + → λ(license : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(licenseVersionOrLater : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(ref : Text → Optional LicenseExceptionId → SPDX) + → λ(refWithFile : Text → Text → Optional LicenseExceptionId → SPDX) + → λ(and : SPDX → SPDX → SPDX) + → λ(or : SPDX → SPDX → SPDX) + → licenseVersionOrLater licenseId licenseExceptionIdOpt diff --git a/dhall/types/SPDX/Or.dhall b/dhall/types/SPDX/Or.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX/Or.dhall @@ -0,0 +1,30 @@ + let LicenseId = ./LicenseId.dhall +in let LicenseExceptionId = ./LicenseExceptionId.dhall +in λ(a : ../SPDX.dhall ) + → λ(b : ../SPDX.dhall ) + → λ(SPDX : Type) + → λ(license : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(licenseVersionOrLater : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(ref : Text → Optional LicenseExceptionId → SPDX) + → λ(refWithFile : Text → Text → Optional LicenseExceptionId → SPDX) + → λ(and : SPDX → SPDX → SPDX) + → λ(or : SPDX → SPDX → SPDX) + → or + ( a + SPDX + license + licenseVersionOrLater + ref + refWithFile + and + or + ) + ( b + SPDX + license + licenseVersionOrLater + ref + refWithFile + and + or + ) diff --git a/dhall/types/SPDX/Ref.dhall b/dhall/types/SPDX/Ref.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX/Ref.dhall @@ -0,0 +1,12 @@ + let LicenseId = ./LicenseId.dhall +in let LicenseExceptionId = ./LicenseExceptionId.dhall +in λ(refName : Text) + → λ(licenseExceptionIdOpt : Optional LicenseExceptionId ) + → λ(SPDX : Type) + → λ(version : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(versionOrLater : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(ref : Text → Optional LicenseExceptionId → SPDX) + → λ(refWithFile : Text → Text → Optional LicenseExceptionId → SPDX) + → λ(and : SPDX → SPDX → SPDX) + → λ(or : SPDX → SPDX → SPDX) + → ref refName licenseExceptionIdOpt diff --git a/dhall/types/SPDX/RefWithFile.dhall b/dhall/types/SPDX/RefWithFile.dhall new file mode 100644 --- /dev/null +++ b/dhall/types/SPDX/RefWithFile.dhall @@ -0,0 +1,13 @@ + let LicenseId = ./LicenseId.dhall +in let LicenseExceptionId = ./LicenseExceptionId.dhall +in λ(refName : Text) + → λ(file : Text) + → λ(licenseExceptionIdOpt : Optional LicenseExceptionId ) + → λ(SPDX : Type) + → λ(license : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(licenseVersionOrLater : LicenseId → Optional LicenseExceptionId → SPDX) + → λ(ref : Text → Optional LicenseExceptionId → SPDX) + → λ(refWithFile : Text → Text → Optional LicenseExceptionId → SPDX) + → λ(and : SPDX → SPDX → SPDX) + → λ(or : SPDX → SPDX → SPDX) + → refWithFile refName file licenseExceptionIdOpt diff --git a/dhall/types/TestSuite.dhall b/dhall/types/TestSuite.dhall --- a/dhall/types/TestSuite.dhall +++ b/dhall/types/TestSuite.dhall @@ -1,61 +1,1 @@ -{ autogen-modules : - List Text -, build-depends : - List ./Dependency.dhall -, build-tool-depends : - List { component : Text, package : Text, version : ./VersionRange.dhall } -, build-tools : - List { exe : Text, version : ./VersionRange.dhall } -, buildable : - Bool -, c-sources : - List Text -, cc-options : - List Text -, compiler-options : - ./CompilerOptions.dhall -, cpp-options : - List Text -, default-extensions : - List ./Extension.dhall -, default-language : - Optional ./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 ./Extension.dhall -, other-languages : - List ./Language.dhall -, other-modules : - List Text -, pkgconfig-depends : - List { name : Text, version : ./VersionRange.dhall } -, profiling-options : - ./CompilerOptions.dhall -, shared-options : - ./CompilerOptions.dhall -, mixins : - List ./Mixin.dhall -, type : - ./TestType.dhall -} +./BuildInfo.dhall ⩓ { type : ./TestType.dhall } diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -2,11 +2,18 @@ {-# language NoMonomorphismRestriction #-} {-# language NamedFieldPuns #-} {-# language OverloadedStrings #-} +{-# language RecordWildCards #-} +{-# language ViewPatterns #-} module Main ( main ) where import Control.Applicative ( (<**>), (<|>), Const(..), optional ) -import Data.Foldable ( asum, foldl' ) +import Control.Monad ( guard ) +import Data.Char ( isAlphaNum ) +import Control.Monad.Trans.Class ( lift ) +import Control.Monad.Trans.State ( State, execState, get, modify, put ) +import Control.Monad.Trans.Writer ( WriterT, execWriterT, tell ) +import Data.Foldable ( asum, foldl', traverse_ ) import Data.Functor.Product ( Product(..) ) import Data.Functor.Identity ( Identity(..) ) import Data.Monoid ( Any(..), (<>) ) @@ -16,8 +23,10 @@ import System.Environment ( getArgs ) import Data.String ( fromString ) +import DhallLocation ( typesLocation, dhallFromGitHub ) import DhallToCabal +import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import qualified Data.Text.Lazy.IO as LazyText import qualified Data.Text.Prettyprint.Doc as Pretty import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty @@ -26,24 +35,30 @@ import qualified Dhall.Context import qualified Dhall.Core as Dhall import qualified Dhall.Core as Expr ( Expr(..), Var(..), shift ) +import qualified Distribution.PackageDescription as Cabal +import qualified Dhall.Parser +import qualified Dhall.TypeCheck as Dhall import qualified Distribution.PackageDescription.PrettyPrint as Cabal +import qualified Distribution.Types.GenericPackageDescription as Cabal +import qualified Distribution.Types.PackageId as Cabal +import qualified Distribution.Types.PackageName as Cabal import qualified Options.Applicative as OptParse import qualified System.IO - data Command = RunDhallToCabal DhallToCabalOptions - | PrintType KnownType + | PrintType PrintTypeOptions data KnownType = Library | ForeignLibrary - | Executable | Benchmark + | Executable | TestSuite + | BuildInfo | Config | SourceRepo | RepoType @@ -59,10 +74,29 @@ | Package | VersionRange | Version + | SPDX + | LicenseId + | LicenseExceptionId deriving (Bounded, Enum, Eq, Ord, Read, Show) +-- | A 'Benchmark' is a proper subrecord of an 'Executable', but we +-- don't want to write 'Executable' in terms of 'Benchmark'! Hence, +-- limit which types we will do the common-field extraction for to +-- only 'BuildInfo', for the time being. +isCandidateSubrecord :: KnownType -> Bool +isCandidateSubrecord BuildInfo = True +isCandidateSubrecord _ = False + +shouldBeImported :: KnownType -> Bool +shouldBeImported Extension = True +shouldBeImported LicenseId = True +shouldBeImported LicenseExceptionId = True +shouldBeImported _ = False + + + data DhallToCabalOptions = DhallToCabalOptions { dhallFilePath :: Maybe String , explain :: Bool @@ -94,11 +128,27 @@ ) +data PrintTypeOptions = PrintTypeOptions + { typeToPrint :: KnownType + , selfContained :: Bool + } -printTypeParser :: OptParse.Parser KnownType -printTypeParser = - OptParse.option OptParse.auto modifiers +printTypeOptionsParser :: OptParse.Parser PrintTypeOptions +printTypeOptionsParser = + PrintTypeOptions + <$> + OptParse.option OptParse.auto modifiers + <*> + OptParse.flag + False + True + ( mconcat + [ OptParse.long "self-contained" + , OptParse.help "Emit self-contained types. Without this flag, some large enumerations are referenced by import." + ] + ) + where modifiers = @@ -125,7 +175,11 @@ explaining ( dhallToCabal fileName source - & fmap Cabal.showGenericPackageDescription + & fmap ( \ pkgDesc -> + pkgDesc + & Cabal.showGenericPackageDescription + & addWarningHeader ( pkgDescName pkgDesc ) + ) >>= putStrLn ) @@ -134,8 +188,50 @@ explaining = if explain then Dhall.detailed else id + pkgDescName = Cabal.unPackageName . Cabal.pkgName . Cabal.package . Cabal.packageDescription + -- Make sure that the displayed source path is copy-pasteable to + -- the command line, and won't break the generated Cabal + -- file. This is a somewhat conservative check. + isAcceptableCommentChar c = + isAlphaNum c || c == '.' || c == '/' || c == '_' || c == '-' + regenerationInstructions name = + case dhallFilePath of + Just filePath | all isAcceptableCommentChar filePath -> + [ "-- Instead, edit the source Dhall file, namely" + , "-- '" ++ filePath ++ "', and re-generate this file by running" + , "-- 'dhall-to-cabal -- " ++ filePath ++ " > " ++ name ++ ".cabal'." + ] + _ -> + [ "-- Instead, edit the source Dhall file (which may have the" + , "-- '.dhall' extension) and re-run dhall-to-cabal, passing the" + , "-- source file's name as its argument and redirecting output to" + , "-- '" ++ name ++ ".cabal' (this file)." + ] + + -- Starting with Cabal 2.2, the cabal-version field *has* to be + -- the first thing in the .cabal file. So split that off and plonk + -- the warning header after it. + addWarningHeader name str = + case lines str of + [] -> + error "addWarningHeader: no cabal-version line found?" + cabalVersion : rest -> + unlines $ concat + [ [ cabalVersion + , "-- * * * * * * * * * * * * WARNING * * * * * * * * * * * *" + , "-- This file has been AUTO-GENERATED by dhall-to-cabal." + , "--" + , "-- Do not edit it by hand, because your changes will be over-written!" + , "--" + ] + , regenerationInstructions name + , [ "-- * * * * * * * * * * * * WARNING * * * * * * * * * * * *" ] + , rest + ] + + main :: IO () main = do command <- @@ -145,15 +241,15 @@ RunDhallToCabal options -> runDhallToCabal options - PrintType t -> - printType t + PrintType options -> + printType options where parser = asum [ RunDhallToCabal <$> dhallToCabalOptionsParser - , PrintType <$> printTypeParser + , PrintType <$> printTypeOptionsParser ] opts = @@ -175,8 +271,28 @@ -printType :: KnownType -> IO () -printType t = do +data CSEState a = CSEState + { factoredOutTypes :: [ ( KnownType, Expr.Expr Dhall.Parser.Src a ) ] + -- ^ Things we've already factored out (which may undergo further factoring themselves). + , rootType :: Expr.Expr Dhall.Parser.Src a + -- ^ The original type, which we started factoring things from. + } + + +traverseTypes + :: ( Applicative f ) + => ( Expr.Expr Dhall.Parser.Src a -> f ( Expr.Expr Dhall.Parser.Src b ) ) + -> CSEState a + -> f ( CSEState b ) +traverseTypes f (CSEState types root) = + CSEState + <$> traverse (traverse f) types + <*> f root + + + +printType :: PrintTypeOptions -> IO () +printType PrintTypeOptions { .. } = do Pretty.renderIO System.IO.stdout ( Pretty.layoutSmart opts @@ -187,46 +303,109 @@ where - dhallType t = - case t of - Config -> configRecordType - Library -> Dhall.expected library - ForeignLibrary -> Dhall.expected foreignLib - Executable -> Dhall.expected executable - Benchmark -> Dhall.expected benchmark - TestSuite -> Dhall.expected testSuite - SourceRepo -> Dhall.expected sourceRepo - RepoType -> Dhall.expected repoType - RepoKind -> Dhall.expected repoKind - Compiler -> Dhall.expected compilerFlavor - OS -> Dhall.expected operatingSystem - Extension -> Dhall.expected extension - CompilerOptions -> Dhall.expected compilerOptions - Arch -> Dhall.expected arch - Language -> Dhall.expected language - License -> Dhall.expected license - BuildType -> Dhall.expected buildType - Package -> Dhall.expected genericPackageDescription - VersionRange -> Dhall.expected versionRange - Version -> Dhall.expected version + dhallType :: KnownType -> Dhall.Expr Dhall.Parser.Src a + dhallType t = fmap Dhall.absurd + ( case t of + Config -> configRecordType + Library -> Dhall.expected library + ForeignLibrary -> Dhall.expected foreignLib + Executable -> Dhall.expected executable + Benchmark -> Dhall.expected benchmark + TestSuite -> Dhall.expected testSuite + BuildInfo -> buildInfoType + SourceRepo -> Dhall.expected sourceRepo + RepoType -> Dhall.expected repoType + RepoKind -> Dhall.expected repoKind + Compiler -> Dhall.expected compilerFlavor + OS -> Dhall.expected operatingSystem + Extension -> Dhall.expected extension + CompilerOptions -> Dhall.expected compilerOptions + Arch -> Dhall.expected arch + Language -> Dhall.expected language + License -> Dhall.expected license + BuildType -> Dhall.expected buildType + Package -> Dhall.expected genericPackageDescription + VersionRange -> Dhall.expected versionRange + Version -> Dhall.expected version + SPDX -> Dhall.expected spdxLicense + LicenseId -> Dhall.expected spdxLicenseId + LicenseExceptionId -> Dhall.expected spdxLicenseExceptionId + ) - letDhallType t = - liftCSE ( fromString ( show t ) ) ( dhallType t ) + makeLetOrImport t val reduced = + let + name = fromString ( show t ) + in if shouldBeImported t && not selfContained + then Dhall.subst ( Expr.V name 0 ) ( Expr.Var ( Expr.V "types" 0 ) `Expr.Field` name ) reduced + else Expr.Let name Nothing val reduced + factoredType :: Expr.Expr Dhall.Parser.Src Dhall.Import factoredType = - foldl' - ( flip letDhallType ) - ( dhallType t ) - [ minBound .. maxBound ] + let + initialState :: CSEState Dhall.Import + initialState = CSEState mempty ( dhallType typeToPrint ) + CSEState types expr = + execState + ( traverse_ step [ minBound .. maxBound ] ) + initialState + -- Note: right fold here, though the above traversal is a left + -- fold. We need the types we factor out last to be the + -- outermost-bound. + body = foldr ( uncurry makeLetOrImport ) expr types + + importing = if any shouldBeImported ( fst <$> types ) && not selfContained + then Expr.Let "types" Nothing ( Expr.Embed ( typesLocation dhallFromGitHub ) ) + else id + + in + importing body + + step + :: (Eq a) + => KnownType + -- ^ Name of the type we're trying to factor out + -> State ( CSEState a ) () + step factorType = do + Any usedFactor <- execWriterT + ( lift . put =<< traverseTypes ( tryCSE factorType ) =<< lift get ) + let + addingUsedFactor = + if usedFactor then ( ( factorType, ( dhallType factorType ) ) : ) else id + modify $ \ ( CSEState types expr ) -> CSEState ( addingUsedFactor types ) expr + + tryCSE + :: (Eq a, Monad m) + => KnownType -- ^ The type we're factoring out + -> Expr.Expr Dhall.Parser.Src a + -> WriterT Any m ( Expr.Expr Dhall.Parser.Src a ) + tryCSE factorType expr = + let + name = fromString ( show factorType ) + subrecord = isCandidateSubrecord factorType + in + case liftCSE subrecord name ( dhallType factorType ) expr of + Just expr' -> do + tell (Any True) + return expr' + Nothing -> + return expr + + liftCSE :: (Eq s, Eq a) - => Text -- ^ The name of the binding - -> Expr.Expr s a -- ^ The common subexpression to lift - -> Expr.Expr s a -- ^ The expression to remove a common subexpression from + => Bool + -- ^ Should we attempt to find the subexpression as a sub-record? + -> Text + -- ^ The name of the binding -> Expr.Expr s a -liftCSE name body expr = + -- ^ The common subexpression to lift + -> Expr.Expr s a + -- ^ The expression to remove a common subexpression from + -> Maybe (Expr.Expr s a) + -- ^ 'Just' the CSE-ed expression, or Nothing if the subexpression wasn't found. +liftCSE subrecord name body expr = let v0 = Expr.V name 0 @@ -235,11 +414,14 @@ case go ( Expr.shift 1 v0 expr ) v0 of Pair ( Const ( Any False ) ) _ -> -- There was nothing to lift - expr + Nothing + Pair _ ( Identity reduced ) | reduced == Expr.Var v0 -> + -- We lifted the whole expression out. This is not a win, so don't bother. + Nothing + Pair _ ( Identity reduced ) -> - -- We did manage to lift a CSE, so let bind it - Expr.Let name Nothing body reduced + Just reduced where @@ -252,9 +434,44 @@ shiftVar delta ( Expr.V name' n ) = Expr.V name' ( n + delta ) + subtractRecordFields a b = do + guard subrecord + + Expr.Record left <- + return a + + Expr.Record right <- + return b + + let + intersection = + InsOrdHashMap.intersectionWith (==) left right + + -- The right record cannot have any fields not in left. + guard ( InsOrdHashMap.null ( InsOrdHashMap.difference right left ) ) + + -- We must have at least one field with a common name + guard ( not ( InsOrdHashMap.null intersection ) ) + + -- All common fields must have identical types + guard ( and intersection ) + + let + extra = + InsOrdHashMap.difference left right + + guard ( not ( InsOrdHashMap.null extra ) ) + + return ( Expr.Record extra ) + go e v | e == body = Pair ( Const ( Any True ) ) ( Identity ( Expr.Var v ) ) + go ( ( `subtractRecordFields` body ) -> Just extra ) v = + Pair + ( Const ( Any True ) ) + ( Identity ( Expr.CombineTypes ( Expr.Var v ) extra ) ) + go e v = case e of Expr.Lam n t b -> @@ -338,6 +555,12 @@ Expr.Note s e -> Expr.Note s <$> go e v + + Expr.CombineTypes a b -> + Expr.CombineTypes <$> go a v <*> go b v + + Expr.Project e fs -> + Expr.Project <$> go e v <*> pure fs Expr.Embed{} -> pure e diff --git a/golden-tests/GoldenTests.hs b/golden-tests/GoldenTests.hs --- a/golden-tests/GoldenTests.hs +++ b/golden-tests/GoldenTests.hs @@ -1,23 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import Data.Algorithm.Diff import Data.Algorithm.DiffOutput -import Data.Function ( on ) +import Data.Function ( on, (&) ) import System.FilePath ( takeBaseName, replaceExtension ) import Test.Tasty ( defaultMain, TestTree, testGroup ) -import Test.Tasty.Golden ( findByExtension ) +import Test.Tasty.Golden ( findByExtension, goldenVsStringDiff ) import Test.Tasty.Golden.Advanced ( goldenTest ) +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Encoding as LazyText +import qualified Data.Text.Lazy.IO as LazyText +import qualified Data.Text.Prettyprint.Doc as Pretty +import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty +import qualified Dhall.Core import qualified Distribution.PackageDescription.Configuration as Cabal -import qualified Distribution.PackageDescription.Parse as Cabal +import qualified Distribution.PackageDescription.Parsec as Cabal import qualified Distribution.PackageDescription.PrettyPrint as Cabal import qualified Distribution.PackageDescription as Cabal import qualified Distribution.Verbosity as Cabal -import Distribution.Package.Dhall ( dhallFileToCabal ) +import CabalToDhall ( cabalToDhall ) +import DhallLocation ( DhallLocation ( DhallLocation ) ) +import DhallToCabal ( dhallToCabal ) @@ -26,31 +34,97 @@ defaultMain =<< goldenTests +preludeLocation :: Dhall.Core.Import +preludeLocation = + Dhall.Core.Import + { Dhall.Core.importHashed = + Dhall.Core.ImportHashed + { Dhall.Core.hash = + Nothing + , Dhall.Core.importType = + Dhall.Core.Local + Dhall.Core.Parent + ( Dhall.Core.File + ( Dhall.Core.Directory [ "dhall", ".." ] ) + "prelude.dhall" + ) + } + , Dhall.Core.importMode = + Dhall.Core.Code + } + +typesLocation :: Dhall.Core.Import +typesLocation = + Dhall.Core.Import + { Dhall.Core.importHashed = + Dhall.Core.ImportHashed + { Dhall.Core.hash = + Nothing + , Dhall.Core.importType = + Dhall.Core.Local + Dhall.Core.Parent + ( Dhall.Core.File + ( Dhall.Core.Directory [ "dhall", ".." ] ) + "types.dhall" + ) + } + , Dhall.Core.importMode = + Dhall.Core.Code + } + + goldenTests :: IO TestTree goldenTests = do + -- Note: must remain in sync with the layout options in + -- cabal-to-dhall/Main.hs, so that test output is easy to generate + -- at the command line. + let layoutOpts = Pretty.defaultLayoutOptions + { Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 } + dhallLocation = DhallLocation preludeLocation typesLocation + dhallFiles <- - findByExtension [ ".dhall" ] "golden-tests" + findByExtension [ ".dhall" ] "golden-tests/dhall-to-cabal" + cabalFiles <- + findByExtension [ ".cabal" ] "golden-tests/cabal-to-dhall" return - $ testGroup "dhall-to-cabal golden tests" - [ goldenTest - ( takeBaseName dhallFile ) - ( Cabal.readGenericPackageDescription Cabal.normal cabalFile ) - ( dhallFileToCabal dhallFile ) - ( \expected actual -> - return $ - if on (==) Cabal.showGenericPackageDescription expected actual then - Nothing - else - Just "Generated .cabal file does not match input" - ) - ( Cabal.writeGenericPackageDescription cabalFile ) - | dhallFile <- dhallFiles - , let cabalFile = replaceExtension dhallFile ".cabal" - ] - - + $ testGroup "golden tests" + [ testGroup "dhall-to-cabal" + [ goldenTest + ( takeBaseName dhallFile ) + ( Cabal.readGenericPackageDescription Cabal.normal cabalFile ) + ( LazyText.readFile dhallFile >>= dhallToCabal dhallFile ) + ( \expected actual -> do + let [exp,act] = map Cabal.showGenericPackageDescription + [expected, actual] + if exp == act then + return Nothing + else do + putStrLn $ "Diff between expected " ++ cabalFile ++ + " and actual " ++ dhallFile ++ " :" + let gDiff = getGroupedDiff (lines exp) (lines act) + putStrLn $ ppDiff gDiff + return $ Just "Generated .cabal file does not match input" + ) + ( Cabal.writeGenericPackageDescription cabalFile ) + | dhallFile <- dhallFiles + , let cabalFile = replaceExtension dhallFile ".cabal" + ] + , testGroup "cabal-to-dhall" + [ goldenVsStringDiff + ( takeBaseName cabalFile ) + ( \ ref new -> [ "diff", "-u", ref, new ] ) + dhallFile + ( BS.readFile cabalFile >>= cabalToDhall dhallLocation + & fmap ( LazyText.encodeUtf8 . Pretty.renderLazy + . Pretty.layoutSmart layoutOpts . Pretty.pretty + ) + ) + | cabalFile <- cabalFiles + , let dhallFile = replaceExtension cabalFile ".dhall" + ] + ] reverseArtifacts pkg = pkg { Cabal.executables = reverse (Cabal.executables pkg) } diff --git a/golden-tests/cabal-to-dhall/SPDX.cabal b/golden-tests/cabal-to-dhall/SPDX.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/cabal-to-dhall/SPDX.cabal @@ -0,0 +1,6 @@ +cabal-version: 2.2 +name: foo +version: 0 +license: (AGPL-3.0-or-later WITH Classpath-exception-2.0 OR Apache-2.0+) AND (LicenseRef-MyFancyLicense OR DocumentRef-LICENSE.txt:LicenseRef-MyFancierLicense) +build-type: Simple + diff --git a/golden-tests/cabal-to-dhall/SPDX.dhall b/golden-tests/cabal-to-dhall/SPDX.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/cabal-to-dhall/SPDX.dhall @@ -0,0 +1,139 @@ + let prelude = ../../dhall/prelude.dhall + +in let types = ../../dhall/types.dhall + +in { author = + "" + , benchmarks = + [] : List { benchmark : types.Config → types.Benchmark, name : Text } + , bug-reports = + "" + , build-type = + [ prelude.types.BuildTypes.Simple {=} ] : Optional types.BuildType + , cabal-version = + prelude.v "2.2" + , category = + "" + , copyright = + "" + , custom-setup = + [] : Optional types.CustomSetup + , data-dir = + "" + , data-files = + [] : List Text + , description = + "" + , executables = + [] : List { executable : types.Config → types.Executable, name : Text } + , extra-doc-files = + [] : List Text + , extra-source-files = + [] : List Text + , extra-tmp-files = + [] : List Text + , flags = + [] : List + { default : Bool, description : Text, manual : Bool, name : Text } + , foreign-libraries = + [] : List + { foreign-lib : types.Config → types.ForeignLibrary, name : Text } + , homepage = + "" + , library = + [] : Optional (types.Config → types.Library) + , license = + < SPDX = + prelude.SPDX.and + ( prelude.SPDX.or + ( prelude.SPDX.license + (prelude.types.LicenseId.AGPL_3_0_or_later {=}) + ( [ prelude.types.LicenseExceptionId.Classpath_exception_2_0 {=} + ] : Optional types.LicenseExceptionId + ) + ) + ( prelude.SPDX.licenseVersionOrLater + (prelude.types.LicenseId.Apache_2_0 {=}) + ([] : Optional types.LicenseExceptionId) + ) + ) + ( prelude.SPDX.or + ( prelude.SPDX.ref + "MyFancyLicense" + ([] : Optional types.LicenseExceptionId) + ) + ( prelude.SPDX.refWithFile + "MyFancierLicense" + "LICENSE.txt" + ([] : Optional types.LicenseExceptionId) + ) + ) + | GPL : + Optional types.Version + | AGPL : + Optional types.Version + | LGPL : + Optional types.Version + | BSD2 : + {} + | BSD3 : + {} + | BSD4 : + {} + | MIT : + {} + | ISC : + {} + | MPL : + types.Version + | Apache : + Optional types.Version + | PublicDomain : + {} + | AllRightsReserved : + {} + | Unspecified : + {} + | Other : + {} + > + , license-files = + [] : List Text + , maintainer = + "" + , name = + "foo" + , package-url = + "" + , source-repos = + [] : List + { branch : + Optional Text + , kind : + types.RepoKind + , location : + Optional Text + , module : + Optional Text + , subdir : + Optional Text + , tag : + Optional Text + , type : + Optional types.RepoType + } + , stability = + "" + , sub-libraries = + [] : List { library : types.Config → types.Library, name : Text } + , synopsis = + "" + , test-suites = + [] : List { name : Text, test-suite : types.Config → types.TestSuite } + , tested-with = + [] : List { compiler : types.Compiler, version : types.VersionRange } + , version = + prelude.v "0" + , x-fields = + [] : List { _1 : Text, _2 : Text } + } diff --git a/golden-tests/cabal-to-dhall/conditional-dependencies.cabal b/golden-tests/cabal-to-dhall/conditional-dependencies.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/cabal-to-dhall/conditional-dependencies.cabal @@ -0,0 +1,19 @@ +name: Name +version: 1 +cabal-version: 2.0 +build-type: Simple +license: UnspecifiedLicense + +library + + if impl(ghc >=8.2) + build-depends: + B -any + + if impl(ghc >=8.4) + build-depends: + C -any + build-depends: + A -any + + diff --git a/golden-tests/cabal-to-dhall/conditional-dependencies.dhall b/golden-tests/cabal-to-dhall/conditional-dependencies.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/cabal-to-dhall/conditional-dependencies.dhall @@ -0,0 +1,583 @@ + let prelude = ../../dhall/prelude.dhall + +in let types = ../../dhall/types.dhall + +in { author = + "" + , benchmarks = + [] : List { benchmark : types.Config → types.Benchmark, name : Text } + , bug-reports = + "" + , build-type = + [ prelude.types.BuildTypes.Simple {=} ] : Optional types.BuildType + , cabal-version = + prelude.v "2.0" + , category = + "" + , copyright = + "" + , custom-setup = + [] : Optional types.CustomSetup + , data-dir = + "" + , data-files = + [] : List Text + , description = + "" + , executables = + [] : List { executable : types.Config → types.Executable, name : Text } + , extra-doc-files = + [] : List Text + , extra-source-files = + [] : List Text + , extra-tmp-files = + [] : List Text + , flags = + [] : List + { default : Bool, description : Text, manual : Bool, name : Text } + , foreign-libraries = + [] : List + { foreign-lib : types.Config → types.ForeignLibrary, name : Text } + , homepage = + "" + , library = + [ λ(config : types.Config) + → if config.impl + (prelude.types.Compilers.GHC {=}) + ( prelude.unionVersionRanges + (prelude.thisVersion (prelude.v "8.2")) + (prelude.laterVersion (prelude.v "8.2")) + ) + then if config.impl + (prelude.types.Compilers.GHC {=}) + ( prelude.unionVersionRanges + (prelude.thisVersion (prelude.v "8.4")) + (prelude.laterVersion (prelude.v "8.4")) + ) + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , autogen-modules = + [] : List Text + , build-depends = + [ { bounds = + prelude.anyVersion + , package = + "A" + } + , { bounds = + prelude.anyVersion + , package = + "B" + } + , { bounds = + prelude.anyVersion + , package = + "C" + } + ] + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [] : List Text + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , autogen-modules = + [] : List Text + , build-depends = + [ { bounds = + prelude.anyVersion + , package = + "A" + } + , { bounds = + prelude.anyVersion + , package = + "B" + } + ] + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [] : List Text + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else if config.impl + (prelude.types.Compilers.GHC {=}) + ( prelude.unionVersionRanges + (prelude.thisVersion (prelude.v "8.4")) + (prelude.laterVersion (prelude.v "8.4")) + ) + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , autogen-modules = + [] : List Text + , build-depends = + [ { bounds = prelude.anyVersion, package = "A" } + , { bounds = prelude.anyVersion, package = "C" } + ] + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [] : List Text + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : Text, version : types.VersionRange } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : Text, package : Optional Text } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , autogen-modules = + [] : List Text + , build-depends = + [ { bounds = prelude.anyVersion, package = "A" } ] + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [] : List Text + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List { name : Text, version : types.VersionRange } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : Text, package : Optional Text } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + ] : Optional (types.Config → types.Library) + , license = + < Unspecified = + {=} + | GPL : + Optional types.Version + | AGPL : + Optional types.Version + | LGPL : + Optional types.Version + | BSD2 : + {} + | BSD3 : + {} + | BSD4 : + {} + | MIT : + {} + | ISC : + {} + | MPL : + types.Version + | Apache : + Optional types.Version + | PublicDomain : + {} + | AllRightsReserved : + {} + | Other : + {} + | SPDX : + types.SPDX + > + , license-files = + [] : List Text + , maintainer = + "" + , name = + "Name" + , package-url = + "" + , source-repos = + [] : List + { branch : + Optional Text + , kind : + types.RepoKind + , location : + Optional Text + , module : + Optional Text + , subdir : + Optional Text + , tag : + Optional Text + , type : + Optional types.RepoType + } + , stability = + "" + , sub-libraries = + [] : List { library : types.Config → types.Library, name : Text } + , synopsis = + "" + , test-suites = + [] : List { name : Text, test-suite : types.Config → types.TestSuite } + , tested-with = + [] : List { compiler : types.Compiler, version : types.VersionRange } + , version = + prelude.v "1" + , x-fields = + [] : List { _1 : Text, _2 : Text } + } diff --git a/golden-tests/cabal-to-dhall/gh-36.cabal b/golden-tests/cabal-to-dhall/gh-36.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/cabal-to-dhall/gh-36.cabal @@ -0,0 +1,17 @@ +name: wai-servlet +version: 0.1.5.0 +cabal-version: 2.0 + +Flag wai-servlet-debug + Description: print debug output. not suitable for production + Default: False + +library + if impl(ghc >= 0.0.9.7) + cpp-options: -DINTEROP + if impl(ghc < 0.7.0.2) + cpp-options: -DPURE_JAVA_WITH + if impl(ghc >= 0.0.9) + c-sources: java/Utils.java + if flag(wai-servlet-debug) + cpp-options: -DWAI_SERVLET_DEBUG diff --git a/golden-tests/cabal-to-dhall/gh-36.dhall b/golden-tests/cabal-to-dhall/gh-36.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/cabal-to-dhall/gh-36.dhall @@ -0,0 +1,2047 @@ + let prelude = ../../dhall/prelude.dhall + +in let types = ../../dhall/types.dhall + +in { author = + "" + , benchmarks = + [] : List { benchmark : types.Config → types.Benchmark, name : Text } + , bug-reports = + "" + , build-type = + [] : Optional types.BuildType + , cabal-version = + prelude.v "2.0" + , category = + "" + , copyright = + "" + , custom-setup = + [] : Optional types.CustomSetup + , data-dir = + "" + , data-files = + [] : List Text + , description = + "" + , executables = + [] : List { executable : types.Config → types.Executable, name : Text } + , extra-doc-files = + [] : List Text + , extra-source-files = + [] : List Text + , extra-tmp-files = + [] : List Text + , flags = + [ { default = + False + , description = + "print debug output. not suitable for production" + , manual = + False + , name = + "wai-servlet-debug" + } + ] + , foreign-libraries = + [] : List + { foreign-lib : types.Config → types.ForeignLibrary, name : Text } + , homepage = + "" + , library = + [ λ ( config + : types.Config + ) + → if config.impl + (prelude.types.Compilers.GHC {=}) + ( prelude.unionVersionRanges + (prelude.thisVersion (prelude.v "0.0.9.7")) + (prelude.laterVersion (prelude.v "0.0.9.7")) + ) + then if config.impl + (prelude.types.Compilers.GHC {=}) + ( prelude.earlierVersion + (prelude.v "0.7.0.2") + ) + then if config.impl + ( prelude.types.Compilers.GHC + {=} + ) + ( prelude.unionVersionRanges + ( prelude.thisVersion + (prelude.v "0.0.9") + ) + ( prelude.laterVersion + (prelude.v "0.0.9") + ) + ) + then if config.flag + "wai-servlet-debug" + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 = + [ "java/Utils.java" + ] + , cc-options = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DINTEROP" + , "-DPURE_JAVA_WITH" + , "-DWAI_SERVLET_DEBUG" + ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List + types.Extension + , default-language = + [] : Optional + types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List + types.Mixin + , other-extensions = + [] : List + types.Extension + , other-languages = + [] : List + types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional + Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 = + [ "java/Utils.java" ] + , cc-options = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DINTEROP" + , "-DPURE_JAVA_WITH" + ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List + types.Extension + , default-language = + [] : Optional + types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List + types.Extension + , other-languages = + [] : List + types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional + Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else if config.flag + "wai-servlet-debug" + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DINTEROP" + , "-DPURE_JAVA_WITH" + , "-DWAI_SERVLET_DEBUG" + ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DINTEROP" + , "-DPURE_JAVA_WITH" + ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else if config.impl + (prelude.types.Compilers.GHC {=}) + ( prelude.unionVersionRanges + (prelude.thisVersion (prelude.v "0.0.9")) + (prelude.laterVersion (prelude.v "0.0.9")) + ) + then if config.flag + "wai-servlet-debug" + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 = + [ "java/Utils.java" ] + , cc-options = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DINTEROP" + , "-DWAI_SERVLET_DEBUG" + ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 = + [ "java/Utils.java" ] + , cc-options = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DINTEROP" ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else if config.flag "wai-servlet-debug" + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DINTEROP", "-DWAI_SERVLET_DEBUG" ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DINTEROP" ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else if config.impl + (prelude.types.Compilers.GHC {=}) + (prelude.earlierVersion (prelude.v "0.7.0.2")) + then if config.impl + (prelude.types.Compilers.GHC {=}) + ( prelude.unionVersionRanges + (prelude.thisVersion (prelude.v "0.0.9")) + (prelude.laterVersion (prelude.v "0.0.9")) + ) + then if config.flag + "wai-servlet-debug" + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 = + [ "java/Utils.java" ] + , cc-options = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DPURE_JAVA_WITH" + , "-DWAI_SERVLET_DEBUG" + ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 = + [ "java/Utils.java" ] + , cc-options = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DPURE_JAVA_WITH" ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else if config.flag "wai-servlet-debug" + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DPURE_JAVA_WITH" + , "-DWAI_SERVLET_DEBUG" + ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DPURE_JAVA_WITH" ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else if config.impl + (prelude.types.Compilers.GHC {=}) + ( prelude.unionVersionRanges + (prelude.thisVersion (prelude.v "0.0.9")) + (prelude.laterVersion (prelude.v "0.0.9")) + ) + then if config.flag "wai-servlet-debug" + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 = + [ "java/Utils.java" ] + , cc-options = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DWAI_SERVLET_DEBUG" ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 = + [ "java/Utils.java" ] + , cc-options = + [] : List Text + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [] : List Text + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : + Text + , version : + types.VersionRange + } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : + Text + , package : + Optional Text + } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else if config.flag "wai-servlet-debug" + then { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [ "-DWAI_SERVLET_DEBUG" ] + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List + { name : Text, version : types.VersionRange } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : Text, package : Optional Text } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + + else { asm-options = + [] : List Text + , asm-sources = + [] : List Text + , 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 + , cmm-options = + [] : List Text + , cmm-sources = + [] : List Text + , compiler-options = + prelude.defaults.CompilerOptions + , cpp-options = + [] : List Text + , cxx-options = + [] : List Text + , cxx-sources = + [] : List Text + , default-extensions = + [] : List types.Extension + , default-language = + [] : Optional types.Language + , exposed-modules = + [] : List Text + , extra-bundled-libs = + [] : List Text + , extra-framework-dirs = + [] : List Text + , extra-ghci-libraries = + [] : List Text + , extra-lib-dirs = + [] : List Text + , extra-lib-flavours = + [] : List Text + , extra-libraries = + [] : List Text + , frameworks = + [] : List Text + , hs-source-dirs = + [] : List Text + , include-dirs = + [] : List Text + , includes = + [] : List Text + , install-includes = + [] : List Text + , js-sources = + [] : List Text + , ld-options = + [] : List Text + , mixins = + [] : List types.Mixin + , other-extensions = + [] : List types.Extension + , other-languages = + [] : List types.Language + , other-modules = + [] : List Text + , pkgconfig-depends = + [] : List { name : Text, version : types.VersionRange } + , profiling-options = + prelude.defaults.CompilerOptions + , reexported-modules = + [] : List + { name : + Text + , original : + { name : Text, package : Optional Text } + } + , shared-options = + prelude.defaults.CompilerOptions + , signatures = + [] : List Text + , static-options = + prelude.defaults.CompilerOptions + , virtual-modules = + [] : List Text + } + ] : Optional (types.Config → types.Library) + , license = + < AllRightsReserved = + {=} + | GPL : + Optional types.Version + | AGPL : + Optional types.Version + | LGPL : + Optional types.Version + | BSD2 : + {} + | BSD3 : + {} + | BSD4 : + {} + | MIT : + {} + | ISC : + {} + | MPL : + types.Version + | Apache : + Optional types.Version + | PublicDomain : + {} + | Unspecified : + {} + | Other : + {} + | SPDX : + types.SPDX + > + , license-files = + [] : List Text + , maintainer = + "" + , name = + "wai-servlet" + , package-url = + "" + , source-repos = + [] : List + { branch : + Optional Text + , kind : + types.RepoKind + , location : + Optional Text + , module : + Optional Text + , subdir : + Optional Text + , tag : + Optional Text + , type : + Optional types.RepoType + } + , stability = + "" + , sub-libraries = + [] : List { library : types.Config → types.Library, name : Text } + , synopsis = + "" + , test-suites = + [] : List { name : Text, test-suite : types.Config → types.TestSuite } + , tested-with = + [] : List { compiler : types.Compiler, version : types.VersionRange } + , version = + prelude.v "0.1.5.0" + , x-fields = + [] : List { _1 : Text, _2 : Text } + } diff --git a/golden-tests/cabal-to-dhall/simple.cabal b/golden-tests/cabal-to-dhall/simple.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/cabal-to-dhall/simple.cabal @@ -0,0 +1,3 @@ +cabal-version: 2.0 +name: test +version: 1.0 diff --git a/golden-tests/cabal-to-dhall/simple.dhall b/golden-tests/cabal-to-dhall/simple.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/cabal-to-dhall/simple.dhall @@ -0,0 +1,116 @@ + let prelude = ../../dhall/prelude.dhall + +in let types = ../../dhall/types.dhall + +in { author = + "" + , benchmarks = + [] : List { benchmark : types.Config → types.Benchmark, name : Text } + , bug-reports = + "" + , build-type = + [] : Optional types.BuildType + , cabal-version = + prelude.v "2.0" + , category = + "" + , copyright = + "" + , custom-setup = + [] : Optional types.CustomSetup + , data-dir = + "" + , data-files = + [] : List Text + , description = + "" + , executables = + [] : List { executable : types.Config → types.Executable, name : Text } + , extra-doc-files = + [] : List Text + , extra-source-files = + [] : List Text + , extra-tmp-files = + [] : List Text + , flags = + [] : List + { default : Bool, description : Text, manual : Bool, name : Text } + , foreign-libraries = + [] : List + { foreign-lib : types.Config → types.ForeignLibrary, name : Text } + , homepage = + "" + , library = + [] : Optional (types.Config → types.Library) + , license = + < AllRightsReserved = + {=} + | GPL : + Optional types.Version + | AGPL : + Optional types.Version + | LGPL : + Optional types.Version + | BSD2 : + {} + | BSD3 : + {} + | BSD4 : + {} + | MIT : + {} + | ISC : + {} + | MPL : + types.Version + | Apache : + Optional types.Version + | PublicDomain : + {} + | Unspecified : + {} + | Other : + {} + | SPDX : + types.SPDX + > + , license-files = + [] : List Text + , maintainer = + "" + , name = + "test" + , package-url = + "" + , source-repos = + [] : List + { branch : + Optional Text + , kind : + types.RepoKind + , location : + Optional Text + , module : + Optional Text + , subdir : + Optional Text + , tag : + Optional Text + , type : + Optional types.RepoType + } + , stability = + "" + , sub-libraries = + [] : List { library : types.Config → types.Library, name : Text } + , synopsis = + "" + , test-suites = + [] : List { name : Text, test-suite : types.Config → types.TestSuite } + , tested-with = + [] : List { compiler : types.Compiler, version : types.VersionRange } + , version = + prelude.v "1.0" + , x-fields = + [] : List { _1 : Text, _2 : Text } + } diff --git a/golden-tests/dhall-to-cabal/SPDX.cabal b/golden-tests/dhall-to-cabal/SPDX.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/SPDX.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.2 +name: foo +version: 0 +license: (AGPL-3.0-or-later OR Apache-2.0+ WITH Classpath-exception-2.0) AND (LicenseRef-MyFancyLicense OR DocumentRef-LICENSE.txt:LicenseRef-MyFancierLicense) +build-type: Simple + +library diff --git a/golden-tests/dhall-to-cabal/SPDX.dhall b/golden-tests/dhall-to-cabal/SPDX.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/SPDX.dhall @@ -0,0 +1,19 @@ + let prelude = ./dhall/prelude.dhall +in let types = ./dhall/types.dhall +in prelude.defaults.Package + // { name = "foo" + , version = prelude.v "0" + , cabal-version = prelude.v "2.2" + , license = prelude.types.Licenses.SPDX + ( prelude.SPDX.and + ( prelude.SPDX.or + (prelude.SPDX.license (prelude.types.LicenseId.AGPL_3_0_or_later {=}) prelude.SPDX.noException) + (prelude.SPDX.licenseVersionOrLater (prelude.types.LicenseId.Apache_2_0 {=}) ([prelude.types.LicenseExceptionId.Classpath_exception_2_0 {=}] : Optional types.LicenseExceptionId)) + ) + ( prelude.SPDX.or + (prelude.SPDX.ref "MyFancyLicense" ([] : Optional types.LicenseExceptionId)) + (prelude.SPDX.refWithFile "MyFancierLicense" "LICENSE.txt" ([] : Optional types.LicenseExceptionId)) + ) + ) + , library = prelude.unconditional.library prelude.defaults.Library + } diff --git a/golden-tests/dhall-to-cabal/compiler-options-order.cabal b/golden-tests/dhall-to-cabal/compiler-options-order.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/compiler-options-order.cabal @@ -0,0 +1,25 @@ +name: Name +version: 1 +cabal-version: 2.0 +build-type: Simple +license: UnspecifiedLicense + +library + + if impl(ghc >=8.2) + + if impl(ghc >=8.4) + ghc-options: A B C D E F + else + ghc-options: A B D F + else + + if impl(ghc >=8.4) + ghc-options: A C E F + else + ghc-options: A F + exposed-modules: + Foo + Bar + + diff --git a/golden-tests/dhall-to-cabal/compiler-options-order.dhall b/golden-tests/dhall-to-cabal/compiler-options-order.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/compiler-options-order.dhall @@ -0,0 +1,44 @@ + let prelude = ./dhall/prelude.dhall + +in let types = ./dhall/types.dhall + +in let v = prelude.v + +in let ghcImpl = + \ ( cfg : types.Config ) -> \ ( ver : types.VersionRange ) + -> cfg.impl ( prelude.types.Compilers.GHC {=} ) ver + +in ./dhall/defaults/Package.dhall +// { name = + "Name" + , version = + ./dhall/types/Version/v.dhall "1" + , library = + [ \ ( config : types.Config ) + -> prelude.defaults.Library + // { exposed-modules = [ "Foo", "Bar" ] + , compiler-options = + prelude.defaults.CompilerOptions + // { GHC = ["A"] + # ( if ghcImpl config (prelude.orLaterVersion (v "8.2")) + then ["B"] + else [] : List Text + ) + # ( if ghcImpl config (prelude.orLaterVersion (v "8.4")) + then ["C"] + else [] : List Text + ) + # ( if ghcImpl config (prelude.orLaterVersion (v "8.2")) + then ["D"] + else [] : List Text + ) + # ( if ghcImpl config (prelude.orLaterVersion (v "8.4")) + then ["E"] + else [] : List Text + ) + # ["F"] + } + } + ] : Optional ( types.Config -> types.Library ) + + } diff --git a/golden-tests/dhall-to-cabal/conditional-dependencies.cabal b/golden-tests/dhall-to-cabal/conditional-dependencies.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/conditional-dependencies.cabal @@ -0,0 +1,21 @@ +name: Name +version: 1 +cabal-version: 2.0 +build-type: Simple +license: UnspecifiedLicense + +library + + if impl(ghc >=8.2) + build-depends: + B -any + else + + if impl(ghc >=8.4) + build-depends: + C -any + else + build-depends: + A -any + + diff --git a/golden-tests/dhall-to-cabal/conditional-dependencies.dhall b/golden-tests/dhall-to-cabal/conditional-dependencies.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/conditional-dependencies.dhall @@ -0,0 +1,32 @@ + let prelude = ./dhall/prelude.dhall + +in let types = ./dhall/types.dhall + +in let v = prelude.v + +in let ghcImpl = + \ ( cfg : types.Config ) -> \ ( ver : types.VersionRange ) + -> cfg.impl ( prelude.types.Compilers.GHC {=} ) ver + +in ./dhall/defaults/Package.dhall +// { name = + "Name" + , version = + ./dhall/types/Version/v.dhall "1" + , library = + [ \ ( config : types.Config ) + -> prelude.defaults.Library + // { build-depends = + [ { package = "A", bounds = prelude.anyVersion } ] + # ( if ghcImpl config (prelude.orLaterVersion (v "8.2")) + then [ { package = "B", bounds = prelude.anyVersion } ] + else [] : List types.Dependency + ) + # ( if ghcImpl config (prelude.orLaterVersion (v "8.4")) + then [ { package = "C", bounds = prelude.anyVersion } ] + else [] : List types.Dependency + ) + } + ] : Optional ( types.Config -> types.Library ) + + } diff --git a/golden-tests/dhall-to-cabal/dhall-to-cabal.cabal b/golden-tests/dhall-to-cabal/dhall-to-cabal.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/dhall-to-cabal.cabal @@ -0,0 +1,155 @@ +name: dhall-to-cabal +version: 1.0.0 +cabal-version: 2.0 +build-type: Simple +license: MIT +license-file: LICENSE +maintainer: ollie@ocharles.org.uk +homepage: https://github.com/ocharles/dhall-to-cabal +bug-reports: https://github.com/ocharles/dhall-to-cabal/issues +synopsis: Compile Dhall expressions to Cabal files +description: + dhall-to-cabal takes Dhall expressions and compiles them into Cabal + files. All of the features of Dhall are supported, such as let + bindings and imports, and all features of Cabal are supported + (including conditional stanzas). + . +category: Distribution +extra-source-files: + Changelog.md + dhall/defaults/BuildInfo.dhall + dhall/defaults/Library.dhall + dhall/defaults/CompilerOptions.dhall + dhall/defaults/SourceRepo.dhall + dhall/defaults/TestSuite.dhall + dhall/defaults/Executable.dhall + dhall/defaults/Package.dhall + dhall/defaults/Benchmark.dhall + dhall/unconditional.dhall + dhall/GitHub-project.dhall + dhall/prelude.dhall + dhall/types/VersionRange.dhall + dhall/types/OS.dhall + dhall/types/Guarded.dhall + dhall/types/License.dhall + dhall/types/Library.dhall + dhall/types/Version.dhall + dhall/types/Language.dhall + dhall/types/Extension.dhall + dhall/types/CompilerOptions.dhall + dhall/types/SourceRepo.dhall + dhall/types/TestSuite.dhall + dhall/types/Executable.dhall + dhall/types/Dependency.dhall + dhall/types/Mixin.dhall + dhall/types/Compiler.dhall + dhall/types/Config.dhall + dhall/types/Package.dhall + dhall/types/builtin.dhall + dhall/types/BuildType.dhall + dhall/types/RepoKind.dhall + dhall/types/Version/v.dhall + dhall/types/Arch.dhall + dhall/types/Scope.dhall + dhall/types/CustomSetup.dhall + dhall/types/Benchmark.dhall + dhall/types/Flag.dhall + dhall/types/ForeignLibrary.dhall + dhall/types/ModuleRenaming.dhall + dhall/types/RepoType.dhall + dhall/types/TestType.dhall + dhall/types/VersionRange/IntersectVersionRanges.dhall + dhall/types/VersionRange/WithinVersion.dhall + dhall/types/VersionRange/InvertVersionRange.dhall + dhall/types/VersionRange/EarlierVersion.dhall + dhall/types/VersionRange/DifferenceVersionRanges.dhall + dhall/types/VersionRange/ThisVersion.dhall + dhall/types/VersionRange/OrLaterVersion.dhall + dhall/types/VersionRange/OrEarlierVersion.dhall + dhall/types/VersionRange/AnyVersion.dhall + dhall/types/VersionRange/NotThisVersion.dhall + dhall/types/VersionRange/LaterVersion.dhall + dhall/types/VersionRange/NoVersion.dhall + dhall/types/VersionRange/MajorBoundVersion.dhall + dhall/types/VersionRange/UnionVersionRanges.dhall + dhall/types/SetupBuildInfo.dhall + +source-repository head + type: git + location: https://github.com/ocharles/dhall-to-cabal + +library + exposed-modules: + DhallToCabal + build-depends: + Cabal ^>=2.0, + base ^>=4.10, + bytestring ^>=0.10, + containers ^>=0.5, + dhall ^>=1.12.0, + formatting ^>=6.3.1, + hashable ^>=1.2.6.1, + insert-ordered-containers ^>=0.2.1.0, + text ^>=1.2, + transformers ^>=0.5.2, + trifecta ^>=1.7, + vector ^>=0.12 + default-language: Haskell2010 + other-extensions: ApplicativeDo GADTs GeneralizedNewtypeDeriving + LambdaCase OverloadedStrings RecordWildCards TypeApplications + hs-source-dirs: lib + other-modules: + DhallToCabal.ConfigTree + DhallToCabal.Diff + Dhall.Extra + ghc-options: -Wall -fno-warn-name-shadowing + +executable dhall-to-cabal + main-is: Main.hs + scope: public + build-depends: + Cabal ^>=2.0, + base ^>=4.10, + dhall ^>=1.12.0, + dhall-to-cabal -any, + optparse-applicative ^>=0.13.2 || ^>=0.14, + prettyprinter ^>=1.2.0.1, + text ^>=1.2 + default-language: Haskell2010 + other-extensions: NamedFieldPuns + hs-source-dirs: exe + +executable cabal-to-dhall + main-is: Main.hs + scope: public + build-depends: + Cabal ^>=2.0, + base ^>=4.10, + contravariant ^>=1.4, + dhall ^>=1.12.0, + hashable ^>=1.2.6.1, + dhall-to-cabal -any, + insert-ordered-containers ^>=0.2.1.0, + optparse-applicative ^>=0.13.2 || ^>=0.14, + prettyprinter ^>=1.2.0.1, + text ^>=1.2 + default-language: Haskell2010 + other-extensions: NamedFieldPuns + hs-source-dirs: cabal-to-dhall + +test-suite golden-tests + type: exitcode-stdio-1.0 + main-is: GoldenTests.hs + build-depends: + base ^>=4.10, + Cabal ^>=2.0, + Diff ^>=0.3.4, + bytestring ^>=0.10, + dhall-to-cabal -any, + filepath ^>=1.4, + tasty ^>=0.11, + tasty-golden ^>=2.3, + text ^>=1.2 + default-language: Haskell2010 + hs-source-dirs: golden-tests + diff --git a/golden-tests/dhall-to-cabal/dhall-to-cabal.dhall b/golden-tests/dhall-to-cabal/dhall-to-cabal.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/dhall-to-cabal.dhall @@ -0,0 +1,261 @@ + let prelude = ./dhall/prelude.dhall + +in let types = ./dhall/types.dhall + +in let v = prelude.v + +in let anyVersion = prelude.anyVersion + +in let OS = types.OS + +in let package = + λ(package : Text) + → λ(version-range : types.VersionRange) + → { bounds = version-range, package = package } + +in let majorVersions = prelude.utils.majorVersions + +in let deps = + { Cabal = + majorVersions "Cabal" [ v "2.0" ] + , Diff = + majorVersions "Diff" [ v "0.3.4" ] + , base = + majorVersions "base" [ v "4.10" ] + , bytestring = + majorVersions "bytestring" [ v "0.10" ] + , containers = + majorVersions "containers" [ v "0.5" ] + , dhall = + majorVersions "dhall" [ v "1.12.0" ] + , dhall-to-cabal = + package "dhall-to-cabal" anyVersion + , filepath = + majorVersions "filepath" [ v "1.4" ] + , insert-ordered-containers = + majorVersions "insert-ordered-containers" [ v "0.2.1.0" ] + , optparse-applicative = + majorVersions "optparse-applicative" [ v "0.13.2", v "0.14" ] + , prettyprinter = + majorVersions "prettyprinter" [ v "1.2.0.1" ] + , contravariant = + majorVersions "contravariant" [ v "1.4" ] + , hashable = + majorVersions "hashable" [ v "1.2.6.1" ] + , tasty = + majorVersions "tasty" [ v "0.11" ] + , tasty-golden = + majorVersions "tasty-golden" [ v "2.3" ] + , text = + majorVersions "text" [ v "1.2" ] + , formatting = + majorVersions "formatting" [ v "6.3.1" ] + , transformers = + majorVersions "transformers" [ v "0.5.2" ] + , trifecta = + majorVersions "trifecta" [ v "1.7" ] + , vector = + majorVersions "vector" [ v "0.12" ] + } + +in prelude.utils.GitHub-project + { owner = "ocharles", repo = "dhall-to-cabal" } + ⫽ { synopsis = + "Compile Dhall expressions to Cabal files" + , description = + '' + dhall-to-cabal takes Dhall expressions and compiles them into Cabal + files. All of the features of Dhall are supported, such as let + bindings and imports, and all features of Cabal are supported + (including conditional stanzas). + '' + , category = + "Distribution" + , maintainer = + "ollie@ocharles.org.uk" + , extra-source-files = + [ "Changelog.md" + , "dhall/defaults/BuildInfo.dhall" + , "dhall/defaults/Library.dhall" + , "dhall/defaults/CompilerOptions.dhall" + , "dhall/defaults/SourceRepo.dhall" + , "dhall/defaults/TestSuite.dhall" + , "dhall/defaults/Executable.dhall" + , "dhall/defaults/Package.dhall" + , "dhall/defaults/Benchmark.dhall" + , "dhall/unconditional.dhall" + , "dhall/GitHub-project.dhall" + , "dhall/prelude.dhall" + , "dhall/types/VersionRange.dhall" + , "dhall/types/OS.dhall" + , "dhall/types/Guarded.dhall" + , "dhall/types/License.dhall" + , "dhall/types/Library.dhall" + , "dhall/types/Version.dhall" + , "dhall/types/Language.dhall" + , "dhall/types/Extension.dhall" + , "dhall/types/CompilerOptions.dhall" + , "dhall/types/SourceRepo.dhall" + , "dhall/types/TestSuite.dhall" + , "dhall/types/Executable.dhall" + , "dhall/types/Dependency.dhall" + , "dhall/types/Mixin.dhall" + , "dhall/types/Compiler.dhall" + , "dhall/types/Config.dhall" + , "dhall/types/Package.dhall" + , "dhall/types/builtin.dhall" + , "dhall/types/BuildType.dhall" + , "dhall/types/RepoKind.dhall" + , "dhall/types/Version/v.dhall" + , "dhall/types/Arch.dhall" + , "dhall/types/Scope.dhall" + , "dhall/types/CustomSetup.dhall" + , "dhall/types/Benchmark.dhall" + , "dhall/types/Flag.dhall" + , "dhall/types/ForeignLibrary.dhall" + , "dhall/types/ModuleRenaming.dhall" + , "dhall/types/RepoType.dhall" + , "dhall/types/TestType.dhall" + , "dhall/types/VersionRange/IntersectVersionRanges.dhall" + , "dhall/types/VersionRange/WithinVersion.dhall" + , "dhall/types/VersionRange/InvertVersionRange.dhall" + , "dhall/types/VersionRange/EarlierVersion.dhall" + , "dhall/types/VersionRange/DifferenceVersionRanges.dhall" + , "dhall/types/VersionRange/ThisVersion.dhall" + , "dhall/types/VersionRange/OrLaterVersion.dhall" + , "dhall/types/VersionRange/OrEarlierVersion.dhall" + , "dhall/types/VersionRange/AnyVersion.dhall" + , "dhall/types/VersionRange/NotThisVersion.dhall" + , "dhall/types/VersionRange/LaterVersion.dhall" + , "dhall/types/VersionRange/NoVersion.dhall" + , "dhall/types/VersionRange/MajorBoundVersion.dhall" + , "dhall/types/VersionRange/UnionVersionRanges.dhall" + , "dhall/types/SetupBuildInfo.dhall" + ] + , license = + prelude.types.Licenses.MIT {=} + , license-files = + [ "LICENSE" ] + , version = + v "1.0.0" + , library = + prelude.unconditional.library + ( prelude.defaults.Library + ⫽ { build-depends = + [ deps.Cabal + , deps.base + , deps.bytestring + , deps.containers + , deps.dhall + , deps.formatting + , deps.hashable + , deps.insert-ordered-containers + , deps.text + , deps.transformers + , deps.trifecta + , deps.vector + ] + , compiler-options = + prelude.defaults.CompilerOptions + ⫽ { GHC = [ "-Wall", "-fno-warn-name-shadowing" ] } + , exposed-modules = + [ "DhallToCabal" ] + , hs-source-dirs = + [ "lib" ] + , other-extensions = + [ prelude.types.Extensions.ApplicativeDo True + , prelude.types.Extensions.GADTs True + , prelude.types.Extensions.GeneralizedNewtypeDeriving True + , prelude.types.Extensions.LambdaCase True + , prelude.types.Extensions.OverloadedStrings True + , prelude.types.Extensions.RecordWildCards True + , prelude.types.Extensions.TypeApplications True + ] + , other-modules = + [ "DhallToCabal.ConfigTree" + , "DhallToCabal.Diff" + , "Dhall.Extra" + ] + , default-language = + [ prelude.types.Languages.Haskell2010 {=} ] : Optional + types.Language + } + ) + , executables = + [ prelude.unconditional.executable + "dhall-to-cabal" + ( prelude.defaults.Executable + ⫽ { build-depends = + [ deps.Cabal + , deps.base + , deps.dhall + , deps.dhall-to-cabal + , deps.optparse-applicative + , deps.prettyprinter + , deps.text + ] + , hs-source-dirs = + [ "exe" ] + , main-is = + "Main.hs" + , other-extensions = + [ prelude.types.Extensions.NamedFieldPuns True ] + , default-language = + [ prelude.types.Languages.Haskell2010 {=} ] : Optional + types.Language + } + ) + , prelude.unconditional.executable + "cabal-to-dhall" + ( prelude.defaults.Executable + ⫽ { build-depends = + [ deps.Cabal + , deps.base + , deps.contravariant + , deps.dhall + , deps.hashable + , deps.dhall-to-cabal + , deps.insert-ordered-containers + , deps.optparse-applicative + , deps.prettyprinter + , deps.text + ] + , hs-source-dirs = + [ "cabal-to-dhall" ] + , main-is = + "Main.hs" + , other-extensions = + [ prelude.types.Extensions.NamedFieldPuns True ] + , default-language = + [ prelude.types.Languages.Haskell2010 {=} ] : Optional + types.Language + } + ) + ] + , test-suites = + [ prelude.unconditional.test-suite + "golden-tests" + ( prelude.defaults.TestSuite + ⫽ { build-depends = + [ deps.base + , deps.Cabal + , deps.Diff + , deps.bytestring + , deps.dhall-to-cabal + , deps.filepath + , deps.tasty + , deps.tasty-golden + , deps.text + ] + , hs-source-dirs = + [ "golden-tests" ] + , type = + prelude.types.TestTypes.exitcode-stdio + { main-is = "GoldenTests.hs" } + , default-language = + [ prelude.types.Languages.Haskell2010 {=} ] : Optional + types.Language + } + ) + ] + } diff --git a/golden-tests/dhall-to-cabal/empty-package.cabal b/golden-tests/dhall-to-cabal/empty-package.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/empty-package.cabal @@ -0,0 +1,10 @@ +name: Name +version: 1 +cabal-version: 2.0 +build-type: Simple +license: UnspecifiedLicense + +executable foo + main-is: Main.hs + scope: public + diff --git a/golden-tests/dhall-to-cabal/empty-package.dhall b/golden-tests/dhall-to-cabal/empty-package.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/empty-package.dhall @@ -0,0 +1,15 @@ + ./dhall/defaults/Package.dhall +⫽ { name = + "Name" + , version = + ./dhall/types/Version/v.dhall "1" + , executables = + [ { name = + "foo" + , executable = + λ(config : ./dhall/types/Config.dhall) + → ./dhall/defaults/Executable.dhall + ⫽ { main-is = "Main.hs" } + } + ] + } diff --git a/golden-tests/dhall-to-cabal/gh-53.cabal b/golden-tests/dhall-to-cabal/gh-53.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/gh-53.cabal @@ -0,0 +1,23 @@ +name: wai-servlet +version: 0.1.5.0 +cabal-version: 2.0 +build-type: Simple +license: UnspecifiedLicense + +flag wai-servlet-debug + description: + print debug output. not suitable for production + default: False + +library + + if impl(ghc >=0.0.9) + c-sources: + java/Utils.java + else + + if flag(wai-servlet-debug) + cpp-options: -DWAI_SERVLET_DEBUG + else + + diff --git a/golden-tests/dhall-to-cabal/gh-53.dhall b/golden-tests/dhall-to-cabal/gh-53.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/gh-53.dhall @@ -0,0 +1,47 @@ + let prelude = ./dhall/prelude.dhall + +in let types = ./dhall/types.dhall + +in prelude.defaults.Package + ⫽ { cabal-version = + prelude.v "2.0" + , name = + "wai-servlet" + , version = + prelude.v "0.1.5.0" + , flags = + [ { default = + False + , description = + "print debug output. not suitable for production" + , manual = + False + , name = + "wai-servlet-debug" + } + ] + , library = + [ λ ( config + : types.Config + ) + → if config.impl + (prelude.types.Compilers.GHC {=}) + (prelude.orLaterVersion (prelude.v "0.0.9")) + then if config.flag "wai-servlet-debug" + then prelude.defaults.Library + ⫽ { c-sources = + [ "java/Utils.java" ] + , cpp-options = + [ "-DWAI_SERVLET_DEBUG" ] + } + + else prelude.defaults.Library + ⫽ { c-sources = [ "java/Utils.java" ] } + + else if config.flag "wai-servlet-debug" + then prelude.defaults.Library + ⫽ { cpp-options = [ "-DWAI_SERVLET_DEBUG" ] } + + else prelude.defaults.Library + ] : Optional (types.Config → types.Library) + } diff --git a/golden-tests/dhall-to-cabal/gh-55.cabal b/golden-tests/dhall-to-cabal/gh-55.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/gh-55.cabal @@ -0,0 +1,19 @@ +name: Name +version: 1 +cabal-version: 2.0 +build-type: Simple +license: UnspecifiedLicense + +library + + if impl(ghc >=7.1.3) + exposed-modules: + Module2 + cpp-options: -DCOND1 + other-modules: + OtherModule + else + exposed-modules: + Module1 + + diff --git a/golden-tests/dhall-to-cabal/gh-55.dhall b/golden-tests/dhall-to-cabal/gh-55.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/gh-55.dhall @@ -0,0 +1,32 @@ + let prelude = ./dhall/prelude.dhall + +in let types = ./dhall/types.dhall + +in let v = prelude.v + +in let ghcImpl = + \ ( cfg : types.Config ) -> \ ( ver : types.VersionRange ) + -> cfg.impl ( prelude.types.Compilers.GHC {=} ) ver + +in ./dhall/defaults/Package.dhall +// { name = + "Name" + , version = + ./dhall/types/Version/v.dhall "1" + , library = + [ \ ( config : types.Config ) + -> prelude.defaults.Library + // { exposed-modules = + [ "Module1" ] + # ( if ghcImpl config ( prelude.orLaterVersion ( v "7.1.3" ) ) + then [ "Module2" ] else [ ] : List Text ) + , other-modules = + ( if ghcImpl config ( prelude.orLaterVersion ( v "7.1.3" ) ) + then [ "OtherModule" ] else [ ] : List Text ) + , cpp-options = + ( if ghcImpl config ( prelude.orLaterVersion ( v "7.1.3" ) ) + then [ "-DCOND1" ] else [ ] : List Text ) + } + ] : Optional ( ./dhall/types/Guarded.dhall types.Library ) + + } diff --git a/golden-tests/dhall-to-cabal/nested-conditions.cabal b/golden-tests/dhall-to-cabal/nested-conditions.cabal new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/nested-conditions.cabal @@ -0,0 +1,22 @@ +name: foo +version: 0 +cabal-version: 2.0 +build-type: Simple +license: UnspecifiedLicense + +library + + if impl(ghc >=8.2) + + if impl(ghc >=8.4) + ghc-options: -Weverything -Wno-redundant-constraints -Wno-missing-export-lists + else + ghc-options: -Weverything -Wno-redundant-constraints + else + + if impl(ghc >=8.4) + ghc-options: -Weverything -Wno-missing-export-lists + else + ghc-options: -Weverything + + diff --git a/golden-tests/dhall-to-cabal/nested-conditions.dhall b/golden-tests/dhall-to-cabal/nested-conditions.dhall new file mode 100644 --- /dev/null +++ b/golden-tests/dhall-to-cabal/nested-conditions.dhall @@ -0,0 +1,20 @@ + let prelude = ./dhall/prelude.dhall +in let types = ./dhall/types.dhall +in let v = prelude.v +in prelude.defaults.Package + // { name = "foo" + , version = v "0" + , library = + [ \ (config : types.Config) -> prelude.defaults.Library + // { compiler-options = prelude.defaults.CompilerOptions + // { GHC = [ "-Weverything" ] + # (if config.impl (prelude.types.Compilers.GHC {=}) (prelude.orLaterVersion (v "8.2")) + then [ "-Wno-redundant-constraints" ] : List Text + else [] : List Text) + # (if config.impl (prelude.types.Compilers.GHC {=}) (prelude.orLaterVersion (v "8.4")) + then [ "-Wno-missing-export-lists" ] : List Text + else [] : List Text) + } + } + ] : Optional (types.Config -> types.Library) + } diff --git a/lib/CabalToDhall.hs b/lib/CabalToDhall.hs new file mode 100644 --- /dev/null +++ b/lib/CabalToDhall.hs @@ -0,0 +1,1298 @@ +{-# language FlexibleInstances #-} +{-# language GeneralizedNewtypeDeriving #-} +{-# language LambdaCase #-} +{-# language NamedFieldPuns #-} +{-# language OverloadedStrings #-} +{-# language ViewPatterns #-} + +module CabalToDhall + ( cabalToDhall + ) where + +import Control.Monad ( join ) +import Data.Foldable ( foldMap ) +import Data.Functor.Contravariant ( (>$<), Contravariant( contramap ) ) +import Data.Monoid ( First(..) ) +import Data.Semigroup ( Semigroup ) +import GHC.Stack +import Numeric.Natural ( Natural ) + +import qualified Data.ByteString as ByteString +import qualified Data.HashMap.Strict.InsOrd as Map +import qualified Data.Text.Lazy as LazyText +import qualified Dhall +import qualified Dhall.Core +import qualified Dhall.Core as Expr ( Expr(..) ) +import qualified Dhall.Parser +import qualified Dhall.TypeCheck +import qualified Distribution.Compiler as Cabal +import qualified Distribution.License as Cabal +import qualified Distribution.ModuleName as Cabal +import qualified Distribution.PackageDescription.Parsec as Cabal +import qualified Distribution.SPDX as SPDX +import qualified Distribution.System as Cabal +import qualified Distribution.Text as Cabal +import qualified Distribution.Types.Benchmark as Cabal +import qualified Distribution.Types.BenchmarkInterface as Cabal +import qualified Distribution.Types.BuildInfo as Cabal +import qualified Distribution.Types.BuildType as Cabal +import qualified Distribution.Types.CondTree as Cabal +import qualified Distribution.Types.Condition as Cabal +import qualified Distribution.Types.Dependency as Cabal +import qualified Distribution.Types.ExeDependency as Cabal +import qualified Distribution.Types.Executable as Cabal +import qualified Distribution.Types.ExecutableScope as Cabal +import qualified Distribution.Types.ForeignLib as Cabal +import qualified Distribution.Types.ForeignLibOption as Cabal +import qualified Distribution.Types.ForeignLibType as Cabal +import qualified Distribution.Types.GenericPackageDescription as Cabal +import qualified Distribution.Types.IncludeRenaming as Cabal +import qualified Distribution.Types.LegacyExeDependency as Cabal +import qualified Distribution.Types.Library as Cabal +import qualified Distribution.Types.Mixin as Cabal +import qualified Distribution.Types.ModuleReexport as Cabal +import qualified Distribution.Types.ModuleRenaming as Cabal +import qualified Distribution.Types.PackageDescription as Cabal +import qualified Distribution.Types.PackageId as Cabal +import qualified Distribution.Types.PackageName as Cabal +import qualified Distribution.Types.PkgconfigDependency as Cabal +import qualified Distribution.Types.PkgconfigName as Cabal +import qualified Distribution.Types.SetupBuildInfo as Cabal +import qualified Distribution.Types.SourceRepo as Cabal +import qualified Distribution.Types.TestSuite as Cabal +import qualified Distribution.Types.TestSuiteInterface as Cabal +import qualified Distribution.Types.UnqualComponentName as Cabal +import qualified Distribution.Version as Cabal +import qualified Language.Haskell.Extension as Cabal + +import DhallLocation ( DhallLocation(..) ) +import DhallToCabal ( sortExpr ) +import DhallToCabal.ConfigTree ( ConfigTree(..) ) + + +type DhallExpr = + Dhall.Core.Expr Dhall.Parser.Src Dhall.TypeCheck.X + + +cabalToDhall :: DhallLocation -> ByteString.ByteString -> IO ( Expr.Expr Dhall.Parser.Src Dhall.Core.Import ) +cabalToDhall dhallLocation source = + case Cabal.runParseResult ( Cabal.parseGenericPackageDescription source ) of + (_warnings, Left e) -> do + putStrLn "Could not parse Cabal file: " + + error ( show e ) + + (_warnings, Right genericPackageDescription) -> do + let + dhall = + Expr.Let "prelude" Nothing ( Expr.Embed ( preludeLocation dhallLocation ) ) + $ Expr.Let "types" Nothing ( Expr.Embed ( typesLocation dhallLocation ) ) + $ Dhall.TypeCheck.absurd <$> + Dhall.embed + genericPackageDescriptionToDhall + genericPackageDescription + + return dhall + + +newtype RecordInputType a = + RecordInputType + { unRecordInputType :: + Map.InsOrdHashMap Dhall.Text ( Dhall.InputType a ) + } + deriving ( Semigroup, Monoid ) + + +instance Contravariant RecordInputType where + contramap f ( RecordInputType map ) = + RecordInputType ( fmap ( contramap f ) map ) + + +recordField :: Dhall.Text -> Dhall.InputType a -> RecordInputType a +recordField k v = + RecordInputType ( Map.singleton k v ) + + +runRecordInputType :: RecordInputType a -> Dhall.InputType a +runRecordInputType ( RecordInputType m ) = + Dhall.InputType + { Dhall.embed = + \a -> sortExpr ( Expr.RecordLit ( fmap ( \t -> Dhall.embed t a ) m ) ) + , Dhall.declared = sortExpr ( Expr.Record ( fmap Dhall.declared m ) ) + } + + +genericPackageDescriptionToDhall + :: Dhall.InputType Cabal.GenericPackageDescription +genericPackageDescriptionToDhall = + let + named k v = + listOf + ( runRecordInputType + ( mconcat + [ fst >$< recordField "name" unqualComponentName + , snd >$< recordField k v + ] + ) + ) + + in + runRecordInputType + ( mconcat + [ Cabal.packageDescription >$< packageDescriptionToRecord + , recordField "flags" ( Cabal.genPackageFlags >$< ( listOf flag ) ) + , recordField "library" ( Cabal.condLibrary >$< maybeToDhall ( condTree library ) ) + , recordField "sub-libraries" ( Cabal.condSubLibraries >$< named "library" ( condTree library ) ) + , recordField "foreign-libraries" ( Cabal.condForeignLibs >$< named "foreign-lib" ( condTree foreignLibrary ) ) + , recordField "executables" ( Cabal.condExecutables >$< named "executable" ( condTree executable ) ) + , recordField "test-suites" ( Cabal.condTestSuites >$< named "test-suite" ( condTree testSuite ) ) + , recordField "benchmarks" ( Cabal.condBenchmarks >$< named "benchmark" ( condTree benchmark ) ) + ] + ) + + +packageDescriptionToRecord + :: RecordInputType Cabal.PackageDescription +packageDescriptionToRecord = + mconcat + [ contramap Cabal.package packageIdentifierToRecord + , recordField "source-repos" ( contramap Cabal.sourceRepos ( listOf sourceRepo ) ) + , recordField "cabal-version" ( contramap Cabal.specVersionRaw specVersion ) + , recordField "build-type" ( contramap Cabal.buildTypeRaw ( maybeToDhall buildType ) ) + , recordField "license" ( contramap Cabal.licenseRaw licenseToDhall ) + , recordField "license-files" ( contramap Cabal.licenseFiles ( listOf stringToDhall ) ) + , recordField "copyright" ( contramap Cabal.copyright stringToDhall ) + , recordField "maintainer" ( contramap Cabal.maintainer stringToDhall ) + , recordField "author" ( contramap Cabal.author stringToDhall ) + , recordField "stability" ( contramap Cabal.stability stringToDhall ) + , recordField "tested-with" ( contramap Cabal.testedWith ( listOf compiler ) ) + , recordField "homepage" ( contramap Cabal.homepage stringToDhall ) + , recordField "package-url" ( contramap Cabal.pkgUrl stringToDhall ) + , recordField "bug-reports" ( contramap Cabal.bugReports stringToDhall ) + , recordField "synopsis" ( contramap Cabal.synopsis stringToDhall ) + , recordField "description" ( contramap Cabal.description stringToDhall ) + , recordField "category" ( contramap Cabal.category stringToDhall ) + , recordField "custom-setup" ( contramap Cabal.setupBuildInfo ( maybeToDhall setupBuildInfo ) ) + , recordField "data-files" ( contramap Cabal.dataFiles ( listOf stringToDhall ) ) + , recordField "data-dir" ( contramap Cabal.dataDir stringToDhall ) + , recordField "extra-source-files" ( contramap Cabal.extraSrcFiles ( listOf stringToDhall ) ) + , recordField "extra-tmp-files" ( contramap Cabal.extraTmpFiles ( listOf stringToDhall ) ) + , recordField "extra-doc-files" ( contramap Cabal.extraDocFiles ( listOf stringToDhall ) ) + , recordField + "x-fields" + ( Cabal.customFieldsPD + >$< + listOf + ( runRecordInputType + ( mconcat + [ fst >$< recordField "_1" stringToDhall + , snd >$< recordField "_2" stringToDhall + ] + ) + ) + ) + ] + + +packageIdentifierToRecord + :: RecordInputType Cabal.PackageIdentifier +packageIdentifierToRecord = + mconcat + [ recordField "name" ( contramap Cabal.pkgName packageNameToDhall ) + , recordField "version" ( contramap Cabal.pkgVersion versionToDhall ) + ] + + +packageNameToDhall :: Dhall.InputType Cabal.PackageName +packageNameToDhall = + contramap Cabal.unPackageName stringToDhall + + +versionToDhall :: Dhall.InputType Cabal.Version +versionToDhall = + Dhall.InputType + { Dhall.embed = + Expr.App ( Expr.Var "prelude" `Expr.Field` "v" ) + . Dhall.embed stringToDhall + . show + . Cabal.disp + , Dhall.declared = + Expr.Var "types" `Expr.Field` "Version" + } + + +stringToDhall :: Dhall.InputType String +stringToDhall = + contramap LazyText.pack Dhall.inject + + +licenseToDhall :: Dhall.InputType (Either SPDX.License Cabal.License) +licenseToDhall = + ( runUnion + ( mconcat + [ gpl + , agpl + , lgpl + , bsd2 + , bsd3 + , bsd4 + , mit + , isc + , mpl + , apache + , publicDomain + , allRightsReserved + , unspecified + , other + , spdxLicense + -- , unknown + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "License" + } + + where + + gpl = + unionAlt "GPL" ( \l -> case l of Right ( Cabal.GPL v ) -> Just v; _ -> Nothing ) ( maybeToDhall versionToDhall ) + + agpl = + unionAlt "AGPL" ( \l -> case l of Right ( Cabal.AGPL v ) -> Just v ; _ -> Nothing ) ( maybeToDhall versionToDhall ) + + lgpl = + unionAlt "LGPL" ( \l -> case l of Right ( Cabal.LGPL v ) -> Just v ; _ -> Nothing ) ( maybeToDhall versionToDhall ) + + bsd2 = + unionAlt "BSD2" ( \l -> case l of Right Cabal.BSD2 -> Just () ; _ -> Nothing ) Dhall.inject + + bsd3 = + unionAlt "BSD3" ( \l -> case l of Right Cabal.BSD3 -> Just () ; _ -> Nothing ) Dhall.inject + + bsd4 = + unionAlt "BSD4" ( \l -> case l of Right Cabal.BSD4 -> Just () ; _ -> Nothing ) Dhall.inject + + mit = + unionAlt "MIT" ( \l -> case l of Right Cabal.MIT -> Just () ; _ -> Nothing ) Dhall.inject + + isc = + unionAlt "ISC" ( \l -> case l of Right Cabal.ISC -> Just () ; _ -> Nothing ) Dhall.inject + + mpl = + unionAlt "MPL" ( \l -> case l of Right ( Cabal.MPL v ) -> Just v ; _ -> Nothing ) versionToDhall + + apache = + unionAlt "Apache" ( \l -> case l of Right ( Cabal.Apache v ) -> Just v ; _ -> Nothing ) ( maybeToDhall versionToDhall ) + + publicDomain = + unionAlt "PublicDomain" ( \l -> case l of Right Cabal.PublicDomain -> Just () ; _ -> Nothing ) Dhall.inject + + allRightsReserved = + unionAlt "AllRightsReserved" ( \l -> case l of Right Cabal.AllRightsReserved -> Just () ; Left SPDX.NONE -> Just() ; _ -> Nothing ) Dhall.inject + + unspecified = + unionAlt + "Unspecified" + ( \l -> + case l of + Right Cabal.UnspecifiedLicense -> + Just () + + Right ( Cabal.UnknownLicense "UnspecifiedLicense" ) -> + Just () + + _ -> + Nothing + ) + Dhall.inject + + other = + unionAlt "Other" ( \l -> case l of Right Cabal.OtherLicense -> Just () ; _ -> Nothing ) Dhall.inject + + unknown = + unionAlt "Unknown" ( \l -> case l of Right ( Cabal.UnknownLicense s ) -> Just s ; _ -> Nothing ) stringToDhall + + spdxLicense = + unionAlt "SPDX" ( \l -> case l of Left ( SPDX.License x ) -> Just x ; _ -> Nothing ) spdxLicenseExpressionToDhall + +spdxLicenseExpressionToDhall :: Dhall.InputType SPDX.LicenseExpression +spdxLicenseExpressionToDhall = + Dhall.InputType + { Dhall.embed = + let + go lexp = case lexp of + SPDX.ELicense ( SPDX.ELicenseId ident ) exceptionMay -> + Expr.App + ( Expr.App + ( Expr.Var "prelude" `Expr.Field` "SPDX" `Expr.Field` "license" ) + ( Dhall.embed spdxLicenseIdToDhall ident ) + ) + ( Dhall.embed ( maybeToDhall spdxLicenseExceptionIdToDhall ) exceptionMay ) + SPDX.ELicense (SPDX.ELicenseIdPlus ident) exceptionMay -> + Expr.App + ( Expr.App + ( Expr.Var "prelude" `Expr.Field` "SPDX" `Expr.Field` "licenseVersionOrLater" ) + ( Dhall.embed spdxLicenseIdToDhall ident ) + ) + ( Dhall.embed ( maybeToDhall spdxLicenseExceptionIdToDhall ) exceptionMay ) + SPDX.ELicense (SPDX.ELicenseRef ref) exceptionMay -> + case SPDX.licenseDocumentRef ref of + Nothing -> + Expr.App + ( Expr.App + ( Expr.Var "prelude" `Expr.Field` "SPDX" `Expr.Field` "ref" ) + ( Dhall.embed stringToDhall ( SPDX.licenseRef ref ) ) + ) + ( Dhall.embed ( maybeToDhall spdxLicenseExceptionIdToDhall ) exceptionMay ) + Just file -> + Expr.App + ( Expr.App + ( Expr.App + ( Expr.Var "prelude" `Expr.Field` "SPDX" `Expr.Field` "refWithFile" ) + ( Dhall.embed stringToDhall ( SPDX.licenseRef ref ) ) + ) + ( Dhall.embed stringToDhall file ) + ) + ( Dhall.embed ( maybeToDhall spdxLicenseExceptionIdToDhall ) exceptionMay ) + SPDX.EOr a b -> + Expr.App + ( Expr.App + ( Expr.Var "prelude" `Expr.Field` "SPDX" `Expr.Field` "or" ) + ( go a ) + ) + ( go b ) + SPDX.EAnd a b -> + Expr.App + ( Expr.App + ( Expr.Var "prelude" `Expr.Field` "SPDX" `Expr.Field` "and" ) + ( go a ) + ) + ( go b ) + in go + , Dhall.declared = + Expr.Var "types" `Expr.Field` "SPDX" + } + +spdxLicenseIdToDhall :: Dhall.InputType SPDX.LicenseId +spdxLicenseIdToDhall = + Dhall.InputType + { Dhall.embed = \ident -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "LicenseId" `Expr.Field` identName ident ) + ( Expr.RecordLit mempty ) + , Dhall.declared = + Expr.Var "types" `Expr.Field` "LicenseId" + } + + where + + identName :: SPDX.LicenseId -> LazyText.Text + identName e = + LazyText.pack ( show e ) + +spdxLicenseExceptionIdToDhall :: Dhall.InputType SPDX.LicenseExceptionId +spdxLicenseExceptionIdToDhall = + Dhall.InputType + { Dhall.embed = \ident -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "LicenseExceptionId" `Expr.Field` identName ident ) + ( Expr.RecordLit mempty ) + , Dhall.declared = + Expr.Var "types" `Expr.Field` "LicenseExceptionId" + } + + where + + identName :: SPDX.LicenseExceptionId -> LazyText.Text + identName e = + LazyText.pack ( show e ) + +newtype Union a = + Union + { unUnion :: + ( a -> + ( First ( Dhall.Text, DhallExpr ) + , Map.InsOrdHashMap Dhall.Text DhallExpr + ) + , Map.InsOrdHashMap Dhall.Text DhallExpr + ) + } + deriving ( Semigroup, Monoid ) + + +runUnion :: ( HasCallStack, Show a ) => Union a -> Dhall.InputType a +runUnion ( Union ( f, t ) ) = + Dhall.InputType + { Dhall.embed = + \a -> + case f a of + ( First Nothing, _ ) -> + error $ "Union did not match anything. Given " ++ show a + + ( First ( Just ( k, v ) ), alts ) -> + Expr.UnionLit k v alts + , Dhall.declared = + sortExpr ( Expr.Union t ) + } + + +unionAlt :: Dhall.Text -> ( a -> Maybe b ) -> Dhall.InputType b -> Union a +unionAlt k f t = + Union + ( \a -> + case f a of + Nothing -> + ( mempty, Map.singleton k ( Dhall.declared t ) ) + + Just b -> + ( First ( fmap ( \b -> ( k, Dhall.embed t b ) ) ( f a ) ), mempty ) + , Map.singleton k ( Dhall.declared t ) + ) + + +maybeToDhall :: Dhall.InputType a -> Dhall.InputType ( Maybe a ) +maybeToDhall t = + Dhall.InputType + { Dhall.embed = + \a -> Expr.OptionalLit ( Dhall.declared t ) ( Dhall.embed t <$> a ) + , Dhall.declared = Expr.App Expr.Optional ( Dhall.declared t ) + } + + +listOf :: Dhall.InputType a -> Dhall.InputType [ a ] +listOf t = + Dhall.InputType + { Dhall.embed = + \a -> + Expr.ListLit + ( foldl ( \_ _ -> Nothing ) ( Just ( Dhall.declared t ) ) a ) + ( foldMap ( pure . Dhall.embed t ) a ) + , Dhall.declared = Expr.App Expr.List ( Dhall.declared t ) + } + + +compiler :: Dhall.InputType ( Cabal.CompilerFlavor, Cabal.VersionRange ) +compiler = + runRecordInputType + ( mconcat + [ recordField "compiler" ( contramap fst compilerFlavor ) + , recordField "version" ( contramap snd versionRange ) + ] + ) + + +instance {-# OVERLAPS #-} Dhall.Inject [Char] where + injectWith _ = stringToDhall + +instance Dhall.Inject Cabal.CompilerFlavor + + +compilerFlavor :: Dhall.InputType Cabal.CompilerFlavor +compilerFlavor = + let + constructor k v = + Expr.App ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "Compilers" `Expr.Field` k ) v + + in + Dhall.InputType + { Dhall.embed = \case + Cabal.GHC -> + constructor "GHC" ( Expr.RecordLit mempty ) + + Cabal.GHCJS -> + constructor "GHCJS" ( Expr.RecordLit mempty ) + + Cabal.HBC -> + constructor "HBC" ( Expr.RecordLit mempty ) + + Cabal.HaskellSuite v -> + constructor "HaskellSuite" ( Expr.Record ( Map.singleton "_1" ( Dhall.embed Dhall.inject v ) ) ) + + Cabal.Helium -> + constructor "Helium" ( Expr.RecordLit mempty ) + + Cabal.Hugs -> + constructor "Hugs" ( Expr.RecordLit mempty ) + + Cabal.JHC -> + constructor "JHC" ( Expr.RecordLit mempty ) + + Cabal.LHC -> + constructor "LHC" ( Expr.RecordLit mempty ) + + Cabal.NHC -> + constructor "NHC" ( Expr.RecordLit mempty ) + + Cabal.OtherCompiler v -> + constructor "OtherCompiler" ( Expr.Record ( Map.singleton "_1" ( Dhall.embed Dhall.inject v ) ) ) + + Cabal.UHC -> + constructor "UHC" ( Expr.RecordLit mempty ) + + Cabal.YHC -> + constructor "YHC" ( Expr.RecordLit mempty ) + , Dhall.declared = + Expr.Var "types" `Expr.Field` "Compiler" + } + + +versionRange :: Dhall.InputType Cabal.VersionRange +versionRange = + Dhall.InputType + { Dhall.embed = + \versionRange0 -> + let + go = Cabal.foldVersionRange + -- AnyVersion + ( Expr.Var "prelude" `Expr.Field` "anyVersion" ) + -- ThisVersion + ( \v -> Expr.App + ( Expr.Var "prelude" `Expr.Field` "thisVersion" ) + ( Dhall.embed versionToDhall v ) + ) + -- LaterVersion + ( \v -> Expr.App + ( Expr.Var "prelude" `Expr.Field` "laterVersion" ) + ( Dhall.embed versionToDhall v ) + ) + -- EarlierVersion + ( \v -> Expr.App + ( Expr.Var "prelude" `Expr.Field` "earlierVersion" ) + ( Dhall.embed versionToDhall v ) + ) + -- UnionVersionRanges + ( \a b -> Expr.App + ( Expr.App + ( Expr.Var "prelude" `Expr.Field` "unionVersionRanges" ) + a + ) + b + ) + -- IntersectVersionRanges + ( \a b -> Expr.App + ( Expr.App + ( Expr.Var "prelude" `Expr.Field` "intersectVersionRanges" ) + a + ) + b + ) + + in + go ( Cabal.fromVersionIntervals ( Cabal.toVersionIntervals versionRange0 ) ) + , Dhall.declared = + Expr.Var "types" `Expr.Field` "VersionRange" + } + + +sourceRepo :: Dhall.InputType Cabal.SourceRepo +sourceRepo = + runRecordInputType + ( 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 ) ) + ] + ) + + +repoKind :: Dhall.InputType Cabal.RepoKind +repoKind = + ( runUnion + ( mconcat + [ unionAlt "RepoThis" ( \x -> case x of Cabal.RepoThis -> Just () ; _ -> Nothing) Dhall.inject + , unionAlt "RepoKindUnknown" ( \x -> case x of Cabal.RepoKindUnknown str -> Just str ; _ -> Nothing) ( runRecordInputType ( recordField "_1" stringToDhall ) ) + , unionAlt "RepoHead" ( \x -> case x of Cabal.RepoHead -> Just () ; _ -> Nothing) Dhall.inject + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "RepoKind" + } + + +repoType :: Dhall.InputType Cabal.RepoType +repoType = + ( runUnion + ( mconcat + [ unionAlt "Darcs" ( \x -> case x of Cabal.Darcs -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Git" ( \x -> case x of Cabal.Git -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "SVN" ( \x -> case x of Cabal.SVN -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "CVS" ( \x -> case x of Cabal.CVS -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Mercurial" ( \x -> case x of Cabal.Mercurial -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "GnuArch" ( \x -> case x of Cabal.GnuArch -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Monotone" ( \x -> case x of Cabal.Monotone -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "OtherRepoType" ( \x -> case x of Cabal.OtherRepoType s -> Just s ; _ -> Nothing ) ( runRecordInputType ( recordField "_1" stringToDhall ) ) + , unionAlt "Bazaar" ( \x -> case x of Cabal.Bazaar -> Just () ; _ -> Nothing ) Dhall.inject + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "RepoType" + } + + +specVersion :: Dhall.InputType ( Either Cabal.Version Cabal.VersionRange ) +specVersion = + Dhall.InputType + { Dhall.embed = either ( Dhall.embed versionToDhall ) ( error "Only exact cabal-versions are supported" ) + , Dhall.declared = Dhall.declared versionToDhall + } + + +buildType :: Dhall.InputType Cabal.BuildType +buildType = + Dhall.InputType + { Dhall.embed = \case + Cabal.Simple -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "Simple" ) + ( Expr.RecordLit mempty ) + + Cabal.Configure -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "Configure" ) + ( Expr.RecordLit mempty ) + + Cabal.Custom -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "Custom" ) + ( Expr.RecordLit mempty ) + + Cabal.Make -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "BuildTypes" `Expr.Field` "Make" ) + ( Expr.RecordLit mempty ) + + , Dhall.declared = + Expr.Var "types" `Expr.Field` "BuildType" + } + + +setupBuildInfo :: Dhall.InputType Cabal.SetupBuildInfo +setupBuildInfo = + ( runRecordInputType + ( mconcat + [ recordField "setup-depends" ( contramap Cabal.setupDepends ( listOf dependency ) ) + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "CustomSetup" + } + + +dependency :: Dhall.InputType Cabal.Dependency +dependency = + runRecordInputType + ( mconcat + [ recordField "package" ( contramap ( \( Cabal.Dependency p _ ) -> p ) packageNameToDhall ) + , recordField "bounds" ( contramap ( \( Cabal.Dependency _ a ) -> a ) versionRange ) + ] + ) + + +flag :: Dhall.InputType Cabal.Flag +flag = + runRecordInputType + ( mconcat + [ recordField "name" ( contramap Cabal.flagName flagName ) + , recordField "default" ( contramap Cabal.flagDefault Dhall.inject ) + , recordField "description" ( contramap Cabal.flagDescription stringToDhall ) + , recordField "manual" ( contramap Cabal.flagManual Dhall.inject ) + ] + ) + + +flagName :: Dhall.InputType Cabal.FlagName +flagName = + contramap Cabal.unFlagName stringToDhall + + +library :: Dhall.InputType Cabal.Library +library = + ( runRecordInputType + ( mconcat + [ contramap Cabal.libBuildInfo buildInfoRecord + , recordField + "exposed-modules" + ( contramap Cabal.exposedModules ( listOf moduleName ) ) + , recordField + "reexported-modules" + ( contramap Cabal.reexportedModules ( listOf moduleReexport ) ) + , recordField + "signatures" + ( contramap Cabal.signatures ( listOf moduleName ) ) + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "Library" + } + + +unifyCondTree + :: ( Monoid a ) + => Cabal.CondTree v x a + -> ConfigTree ( Cabal.Condition v ) a +unifyCondTree = + let + branch + :: ( Monoid a ) + => Cabal.CondBranch v x a + -> ConfigTree ( Cabal.Condition v ) a + branch ( Cabal.CondBranch cond true false ) = + Branch cond ( tree true ) ( maybe mempty tree false ) + + tree + :: ( Monoid a ) + => Cabal.CondTree v x a + -> ConfigTree ( Cabal.Condition v ) a + tree ( Cabal.CondNode acc _ branches) = + return acc `mappend` foldMap branch branches + in + tree + + +condTree + :: ( Monoid a, Monoid x ) + => Dhall.InputType a + -> Dhall.InputType ( Cabal.CondTree Cabal.ConfVar x a ) +condTree t = + let + go = \case + Leaf a -> + Dhall.embed t a + + Branch cond a b -> + Expr.BoolIf + ( Dhall.embed condBranchCondition cond ) + ( go a ) + ( go b ) + + configRecord = + Expr.Var "types" `Expr.Field` "Config" + + in + Dhall.InputType + { Dhall.embed = + Expr.Lam "config" configRecord + . go + . unifyCondTree + , Dhall.declared = + Expr.Pi "_" configRecord ( Dhall.declared t ) + } + + +moduleName :: Dhall.InputType Cabal.ModuleName +moduleName = + contramap ( show . Cabal.disp ) stringToDhall + + +condBranchCondition :: Dhall.InputType (Cabal.Condition Cabal.ConfVar) +condBranchCondition = + Dhall.InputType + { Dhall.declared = Expr.Bool + , Dhall.embed = + \a -> + case a of + Cabal.Var ( Cabal.OS os0 ) -> + Expr.App ( Expr.Field ( Expr.Var "config" ) "os" ) ( Dhall.embed os os0 ) + + Cabal.Var ( Cabal.Arch arch0 ) -> + Expr.App ( Expr.Field ( Expr.Var "config" ) "arch" ) ( Dhall.embed arch arch0 ) + + Cabal.Var ( Cabal.Flag flagName0 ) -> + Expr.App ( Expr.Field ( Expr.Var "config" ) "flag" ) ( Dhall.embed flagName flagName0 ) + + Cabal.Var ( Cabal.Impl c v ) -> + Expr.App ( Expr.App ( Expr.Field ( Expr.Var "config" ) "impl" ) ( Dhall.embed compilerFlavor c ) ) ( Dhall.embed versionRange v ) + + Cabal.Lit b -> + Expr.BoolLit b + + Cabal.CNot c -> + Expr.BoolEQ ( Expr.BoolLit False ) ( Dhall.embed condBranchCondition c ) + + Cabal.CAnd a b -> + Expr.BoolAnd ( Dhall.embed condBranchCondition a ) ( Dhall.embed condBranchCondition b ) + + Cabal.COr a b -> + Expr.BoolOr ( Dhall.embed condBranchCondition a ) ( Dhall.embed condBranchCondition b ) + } + + +os :: Dhall.InputType Cabal.OS +os = + Dhall.InputType + { Dhall.embed = \case + Cabal.Linux -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Linux" ) + ( Expr.RecordLit mempty ) + + Cabal.Windows -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Windows" ) + ( Expr.RecordLit mempty ) + + Cabal.OSX -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "OSX" ) + ( Expr.RecordLit mempty ) + + Cabal.FreeBSD -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "FreeBSD" ) + ( Expr.RecordLit mempty ) + + Cabal.OpenBSD -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "OpenBSD" ) + ( Expr.RecordLit mempty ) + + Cabal.NetBSD -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "NetBSD" ) + ( Expr.RecordLit mempty ) + + Cabal.DragonFly -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "DragonFly" ) + ( Expr.RecordLit mempty ) + + Cabal.Solaris -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Solaris" ) + ( Expr.RecordLit mempty ) + + Cabal.AIX -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "AIX" ) + ( Expr.RecordLit mempty ) + + Cabal.HPUX -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "HPUX" ) + ( Expr.RecordLit mempty ) + + Cabal.IRIX -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "IRIX" ) + ( Expr.RecordLit mempty ) + + Cabal.HaLVM -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "HaLVM" ) + ( Expr.RecordLit mempty ) + + Cabal.Hurd -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Hurd" ) + ( Expr.RecordLit mempty ) + + Cabal.IOS -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "IOS" ) + ( Expr.RecordLit mempty ) + + Cabal.Android -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Android" ) + ( Expr.RecordLit mempty ) + + Cabal.Ghcjs -> + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OSs" `Expr.Field` "Ghcjs" ) + ( Expr.RecordLit mempty ) + + , Dhall.declared = + Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "OS" + } + + +arch :: Dhall.InputType Cabal.Arch +arch = + runUnion + ( mconcat + [ unionAlt "I386" ( \x -> case x of Cabal.I386 -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "X86_64" ( \x -> case x of Cabal.X86_64 -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "PPC" ( \x -> case x of Cabal.PPC -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "PPC64" ( \x -> case x of Cabal.PPC64 -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Sparc" ( \x -> case x of Cabal.Sparc -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Arm" ( \x -> case x of Cabal.Arm -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Mips" ( \x -> case x of Cabal.Mips -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "SH" ( \x -> case x of Cabal.SH -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "IA64" ( \x -> case x of Cabal.IA64 -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "S390" ( \x -> case x of Cabal.S390 -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Alpha" ( \x -> case x of Cabal.Alpha -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Hppa" ( \x -> case x of Cabal.Hppa -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Rs6000" ( \x -> case x of Cabal.Rs6000 -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "M68k" ( \x -> case x of Cabal.M68k -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Vax" ( \x -> case x of Cabal.Vax -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "JavaScript" ( \x -> case x of Cabal.JavaScript -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "OtherArch" ( \x -> case x of Cabal.OtherArch s -> Just s ; _ -> Nothing ) ( runRecordInputType ( recordField "_1" stringToDhall ) ) + ] + ) + + +buildInfoRecord :: RecordInputType Cabal.BuildInfo +buildInfoRecord = + mconcat + [ recordField "buildable" ( contramap Cabal.buildable Dhall.inject ) + , recordField "build-tools" ( contramap Cabal.buildTools ( listOf legacyExeDependency ) ) + , recordField "build-tool-depends" ( contramap Cabal.buildToolDepends ( listOf exeDependency ) ) + , recordField "cpp-options" ( contramap Cabal.cppOptions ( listOf stringToDhall ) ) + , recordField "cc-options" ( contramap Cabal.ccOptions ( listOf stringToDhall ) ) + , recordField "ld-options" ( contramap Cabal.ldOptions ( listOf stringToDhall ) ) + , recordField "pkgconfig-depends" ( contramap Cabal.pkgconfigDepends ( listOf pkgconfigDependency ) ) + , recordField "frameworks" ( contramap Cabal.frameworks ( listOf stringToDhall ) ) + , recordField "extra-framework-dirs" ( contramap Cabal.extraFrameworkDirs ( listOf stringToDhall ) ) + , recordField "c-sources" ( contramap Cabal.cSources ( listOf stringToDhall ) ) + , recordField "js-sources" ( contramap Cabal.jsSources ( listOf stringToDhall ) ) + , recordField "hs-source-dirs" ( contramap Cabal.hsSourceDirs ( listOf stringToDhall ) ) + , recordField "other-modules" ( contramap Cabal.otherModules ( listOf moduleName ) ) + , recordField "autogen-modules" ( contramap Cabal.autogenModules ( listOf moduleName ) ) + , recordField "default-language" ( contramap Cabal.defaultLanguage ( maybeToDhall language ) ) + , recordField "other-languages" ( contramap Cabal.otherLanguages ( listOf language ) ) + , recordField "default-extensions" ( Cabal.defaultExtensions >$< listOf extension ) + , recordField "other-extensions" ( Cabal.otherExtensions >$< listOf extension ) + , recordField "extra-libraries" ( Cabal.extraLibs >$< listOf stringToDhall ) + , recordField "extra-ghci-libraries" ( Cabal.extraGHCiLibs >$< listOf stringToDhall ) + , recordField "extra-lib-dirs" ( Cabal.extraLibDirs >$< listOf stringToDhall ) + , recordField "include-dirs" ( Cabal.includeDirs >$< listOf stringToDhall ) + , recordField "includes" ( Cabal.includes >$< listOf stringToDhall ) + , recordField "install-includes" ( Cabal.installIncludes >$< listOf stringToDhall ) + , recordField "compiler-options" ( Cabal.options >$< compilerOptions ) + , recordField "profiling-options" ( Cabal.profOptions >$< compilerOptions ) + , recordField "shared-options" ( Cabal.sharedOptions >$< compilerOptions ) + , recordField "static-options" ( Cabal.staticOptions >$< compilerOptions ) + , recordField "build-depends" ( Cabal.targetBuildDepends >$< listOf dependency ) + , recordField "mixins" ( Cabal.mixins >$< listOf mixin ) + , recordField "asm-options" ( Cabal.asmOptions >$< listOf stringToDhall) + , recordField "asm-sources" ( Cabal.asmSources >$< listOf stringToDhall) + , recordField "cmm-options" ( Cabal.cmmOptions >$< listOf stringToDhall ) + , recordField "cmm-sources" ( Cabal.cmmSources >$< listOf stringToDhall ) + , recordField "cxx-options" ( Cabal.cxxOptions >$< listOf stringToDhall ) + , recordField "cxx-sources" ( Cabal.cxxSources >$< listOf stringToDhall) + , recordField "virtual-modules" ( Cabal.virtualModules >$< listOf moduleName ) + , recordField "extra-lib-flavours" ( Cabal.extraLibFlavours >$< listOf stringToDhall ) + , recordField "extra-bundled-libs" ( Cabal.extraBundledLibs >$< listOf stringToDhall ) + ] + + +moduleReexport :: Dhall.InputType Cabal.ModuleReexport +moduleReexport = + runRecordInputType + ( mconcat + [ recordField "original" + ( ( \a -> ( Cabal.moduleReexportOriginalPackage a, Cabal.moduleReexportOriginalName a ) ) >$< + runRecordInputType + ( mconcat + [ recordField "package" ( fst >$< maybeToDhall packageNameToDhall ) + , recordField "name" ( snd >$< moduleName ) + ] + ) + ) + , recordField "name" ( Cabal.moduleReexportName >$< moduleName ) + ] + ) + + +legacyExeDependency :: Dhall.InputType Cabal.LegacyExeDependency +legacyExeDependency = + runRecordInputType + ( mconcat + [ recordField "exe" ( ( \( Cabal.LegacyExeDependency exe _ ) -> exe ) >$< stringToDhall ) + , recordField "version" ( ( \( Cabal.LegacyExeDependency _ version ) -> version ) >$< versionRange ) + ] + ) + +exeDependency :: Dhall.InputType Cabal.ExeDependency +exeDependency = + runRecordInputType + ( mconcat + [ recordField "package" ( ( \( Cabal.ExeDependency packageName _ _ ) -> packageName ) >$< packageNameToDhall ) + , recordField "component" ( ( \( Cabal.ExeDependency _ component _ ) -> component ) >$< unqualComponentName ) + , recordField "version" ( ( \( Cabal.ExeDependency _ _ version ) -> version ) >$< versionRange ) + ] + ) + + +unqualComponentName :: Dhall.InputType Cabal.UnqualComponentName +unqualComponentName = + show . Cabal.disp >$< stringToDhall + + +pkgconfigDependency :: Dhall.InputType Cabal.PkgconfigDependency +pkgconfigDependency = + runRecordInputType + ( mconcat + [ recordField "name" ( ( \( Cabal.PkgconfigDependency a _version ) -> a ) >$< pkgconfigName ) + , recordField "version" ( ( \( Cabal.PkgconfigDependency _name a ) -> a ) >$< versionRange ) + ] + ) + + +pkgconfigName :: Dhall.InputType Cabal.PkgconfigName +pkgconfigName = + show . Cabal.disp >$< stringToDhall + + +language :: Dhall.InputType Cabal.Language +language = + ( runUnion + ( mconcat + [ unionAlt "Haskell2010" ( \x -> case x of Cabal.Haskell2010 -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "UnknownLanguage" ( \x -> case x of Cabal.UnknownLanguage s -> Just s ; _ -> Nothing ) ( runRecordInputType ( recordField "_1" stringToDhall ) ) + , unionAlt "Haskell98" ( \x -> case x of Cabal.Haskell98 -> Just () ; _ -> Nothing ) Dhall.inject + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "Language" + } + +extension :: Dhall.InputType Cabal.Extension +extension = + Dhall.InputType + { Dhall.embed = + \a -> + case a of + Cabal.EnableExtension ext -> + extWith True ext + + Cabal.DisableExtension ext -> + extWith False ext + + _ -> + error "Unknown extension" + , Dhall.declared = + Expr.Var "types" `Expr.Field` "Extension" + } + + where + + extName :: Cabal.KnownExtension -> LazyText.Text + extName e = + LazyText.pack ( show e ) + + extWith trueFalse ext = + Expr.App + ( Expr.Var "prelude" `Expr.Field` "types" `Expr.Field` "Extensions" `Expr.Field` extName ext ) + ( Expr.BoolLit trueFalse ) + + +compilerOptions :: Dhall.InputType [ ( Cabal.CompilerFlavor, [ String ] ) ] +compilerOptions = + Dhall.InputType + { Dhall.embed = \l -> + case filter ( not . null . snd ) l of + [] -> + Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` "CompilerOptions" + + xs -> + Expr.Prefer + ( Expr.Var "prelude" `Expr.Field` "defaults" `Expr.Field` "compiler-options" ) + ( Expr.RecordLit + ( Map.fromList + ( map + ( \( c, opts ) -> + ( LazyText.pack ( show c ), Dhall.embed Dhall.inject opts ) + ) + xs + ) + ) + ) + , Dhall.declared = + Expr.Var "types" `Expr.Field` "CompilerOptions" + } + + where + + field c = + recordField ( LazyText.pack ( show c ) ) ( filtering c ) + + filtering c = + contramap + ( \l -> join [ opts | ( c', opts ) <- l, c == c' ] ) + ( listOf stringToDhall ) + + +mixin :: Dhall.InputType Cabal.Mixin +mixin = + ( runRecordInputType + ( mconcat + [ recordField "package" ( Cabal.mixinPackageName >$< packageNameToDhall ) + , recordField "renaming" ( Cabal.mixinIncludeRenaming >$< includeRenaming ) + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "Mixin" + + } + + +includeRenaming :: Dhall.InputType Cabal.IncludeRenaming +includeRenaming = + runRecordInputType + ( mconcat + [ recordField "provides" ( Cabal.includeProvidesRn >$< moduleRenaming ) + , recordField "requires" ( Cabal.includeRequiresRn >$< moduleRenaming ) + ] + ) + + +moduleRenaming :: Dhall.InputType Cabal.ModuleRenaming +moduleRenaming = + ( \( Cabal.ModuleRenaming a ) -> a ) >$< + listOf + ( runRecordInputType + ( mconcat + [ recordField "rename" ( ( \( a, _ ) -> a ) >$< moduleName ) + , recordField "to" ( ( \( _, a ) -> a ) >$< moduleName ) + ] + ) + ) + + +benchmark :: Dhall.InputType Cabal.Benchmark +benchmark = + ( runRecordInputType + ( mconcat + [ recordField "main-is" ( ( \( Cabal.BenchmarkExeV10 _ s ) -> s ) . Cabal.benchmarkInterface >$< stringToDhall ) + , Cabal.benchmarkBuildInfo >$< buildInfoRecord + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "Benchmark" + } + + +testSuite :: Dhall.InputType Cabal.TestSuite +testSuite = + ( runRecordInputType + ( mconcat + [ recordField "type" ( Cabal.testInterface >$< testSuiteInterface ) + , Cabal.testBuildInfo >$< buildInfoRecord + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "TestSuite" + } + + +testSuiteInterface :: Dhall.InputType Cabal.TestSuiteInterface +testSuiteInterface = + runUnion + ( mconcat + [ unionAlt + "exitcode-stdio" + ( \x -> + case x of + Cabal.TestSuiteExeV10 _ main -> + Just main + + _ -> + Nothing + ) + ( runRecordInputType ( recordField "main-is" stringToDhall ) ) + , unionAlt + "detailed" + ( \x -> + case x of + Cabal.TestSuiteLibV09 _ m -> + Just m + + _ -> + Nothing + ) + ( runRecordInputType ( recordField "module" moduleName ) ) + ] + ) + + +executable :: Dhall.InputType Cabal.Executable +executable = + ( runRecordInputType + ( mconcat + [ recordField "main-is" ( Cabal.modulePath >$< stringToDhall ) + , recordField "scope" ( Cabal.exeScope >$< executableScope ) + , Cabal.buildInfo >$< buildInfoRecord + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "Executable" + } + + +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 + ] + ) + + +foreignLibrary :: Dhall.InputType Cabal.ForeignLib +foreignLibrary = + ( runRecordInputType + ( mconcat + [ recordField "type" ( Cabal.foreignLibType >$< foreignLibType ) + , recordField "options" ( Cabal.foreignLibOptions >$< ( listOf foreignLibOption ) ) + , Cabal.foreignLibBuildInfo >$< buildInfoRecord + , recordField "lib-version-info" ( Cabal.foreignLibVersionInfo >$< maybeToDhall versionInfo ) + , recordField "lib-version-linux" ( Cabal.foreignLibVersionLinux >$< maybeToDhall versionToDhall ) + , recordField "mod-def-files" ( Cabal.foreignLibModDefFile >$< listOf stringToDhall ) + ] + ) + ) + { Dhall.declared = + Expr.Var "types" `Expr.Field` "ForeignLibrary" + } + + +versionInfo :: Dhall.InputType Cabal.LibVersionInfo +versionInfo = + Cabal.libVersionInfoCRA >$< + runRecordInputType + ( mconcat + [ recordField "current" ( ( \( a, _, _ ) -> fromIntegral a :: Natural ) >$< ( Dhall.inject ) ) + , recordField "revision" ( ( \( _, a, _ ) -> fromIntegral a :: Natural ) >$< ( Dhall.inject ) ) + , recordField "age" ( ( \( _, _, a ) -> fromIntegral a :: Natural ) >$< ( Dhall.inject ) ) + ] + ) + + +foreignLibOption :: Dhall.InputType Cabal.ForeignLibOption +foreignLibOption = + runUnion + ( unionAlt "Standalone" ( \x -> case x of Cabal.ForeignLibStandalone -> Just () ) Dhall.inject + ) + + +foreignLibType :: Dhall.InputType Cabal.ForeignLibType +foreignLibType = + runUnion + ( mconcat + [ unionAlt "Shared" ( \x -> case x of Cabal.ForeignLibNativeShared -> Just () ; _ -> Nothing ) Dhall.inject + , unionAlt "Static" ( \x -> case x of Cabal.ForeignLibNativeStatic -> Just () ; _ -> Nothing ) Dhall.inject + ] + ) diff --git a/lib/DhallLocation.hs b/lib/DhallLocation.hs new file mode 100644 --- /dev/null +++ b/lib/DhallLocation.hs @@ -0,0 +1,69 @@ +{-# language OverloadedStrings #-} + +module DhallLocation + ( DhallLocation(..) + , dhallFromGitHub + ) + where + +import Data.Version ( showVersion ) + +import qualified Data.Text.Lazy as LazyText +import qualified Dhall.Core + +import qualified Paths_dhall_to_cabal as Paths + + +data DhallLocation = DhallLocation + { preludeLocation :: Dhall.Core.Import + , typesLocation :: Dhall.Core.Import + } + + +version :: LazyText.Text +version = LazyText.pack ( showVersion Paths.version ) + + +dhallFromGitHub :: DhallLocation +dhallFromGitHub = + DhallLocation + { preludeLocation = + Dhall.Core.Import + { Dhall.Core.importHashed = + Dhall.Core.ImportHashed + { Dhall.Core.hash = + Nothing + , Dhall.Core.importType = + Dhall.Core.URL + "https://raw.githubusercontent.com" + ( Dhall.Core.File + ( Dhall.Core.Directory [ "dhall", version, "dhall-to-cabal", "dhall-lang" ] ) + "prelude.dhall" + ) + "" + Nothing + } + , Dhall.Core.importMode = + Dhall.Core.Code + } + + , typesLocation = + Dhall.Core.Import + { Dhall.Core.importHashed = + Dhall.Core.ImportHashed + { Dhall.Core.hash = + Nothing + , Dhall.Core.importType = + Dhall.Core.URL + "https://raw.githubusercontent.com" + ( Dhall.Core.File + ( Dhall.Core.Directory [ "dhall", version, "dhall-to-cabal", "dhall-lang" ] ) + "types.dhall" + ) + "" + Nothing + } + , Dhall.Core.importMode = + Dhall.Core.Code + } + } diff --git a/lib/DhallToCabal.hs b/lib/DhallToCabal.hs --- a/lib/DhallToCabal.hs +++ b/lib/DhallToCabal.hs @@ -23,6 +23,9 @@ , compilerFlavor , language , license + , spdxLicense + , spdxLicenseId + , spdxLicenseExceptionId , executable , testSuite , benchmark @@ -31,6 +34,7 @@ , versionRange , version , configRecordType + , buildInfoType , sortExpr ) where @@ -41,7 +45,6 @@ import Data.Maybe ( fromMaybe ) import Data.Monoid ( (<>) ) import Formatting.Buildable ( Buildable(..) ) -import Text.Trifecta.Delta ( Delta(..) ) import qualified Data.ByteString.Lazy as LazyByteString import qualified Data.HashMap.Strict.InsOrd as Map @@ -59,6 +62,7 @@ import qualified Distribution.License as Cabal import qualified Distribution.ModuleName as Cabal import qualified Distribution.PackageDescription as Cabal +import qualified Distribution.SPDX as SPDX import qualified Distribution.System as Cabal ( Arch(..), OS(..) ) import qualified Distribution.Text as Cabal ( simpleParse ) import qualified Distribution.Types.CondTree as Cabal @@ -140,10 +144,10 @@ specVersionRaw <- Left <$> keyValue "cabal-version" version - buildType <- + buildTypeRaw <- keyValue "build-type" ( Dhall.maybe buildType ) - license <- + licenseRaw <- keyValue "license" license licenseFiles <- @@ -354,6 +358,9 @@ sharedOptions <- keyValue "shared-options" compilerOptions + staticOptions <- + keyValue "static-options" compilerOptions + customFieldsBI <- pure [] @@ -363,10 +370,41 @@ mixins <- keyValue "mixins" ( Dhall.list mixin ) + asmOptions <- + keyValue "asm-options" ( Dhall.list Dhall.string ) + + asmSources <- + keyValue "asm-sources" ( Dhall.list Dhall.string ) + + cmmOptions <- + keyValue "cmm-options" ( Dhall.list Dhall.string ) + + cmmSources <- + keyValue "cmm-sources" ( Dhall.list Dhall.string ) + + cxxOptions <- + keyValue "cxx-options" ( Dhall.list Dhall.string ) + + cxxSources <- + keyValue "cxx-sources" ( Dhall.list Dhall.string ) + + virtualModules <- + keyValue "virtual-modules" ( Dhall.list moduleName ) + + extraLibFlavours <- + keyValue "extra-lib-flavours" ( Dhall.list Dhall.string ) + + extraBundledLibs <- + keyValue "extra-bundled-libs" ( Dhall.list Dhall.string ) + return Cabal.BuildInfo { .. } +buildInfoType :: Expr.Expr Dhall.Parser.Src Dhall.TypeCheck.X +buildInfoType = + Dhall.expected ( makeRecord buildInfo ) + testSuite :: Dhall.Type Cabal.TestSuite testSuite = makeRecord $ do @@ -554,12 +592,8 @@ input :: FilePath -> LazyText.Text -> Dhall.Type a -> IO a input fileName source t = do - let - delta = - Directed ( StrictText.encodeUtf8 ( StrictText.pack fileName ) ) 0 0 0 0 - expr <- - throws ( Dhall.Parser.exprFromText delta source ) + throws ( Dhall.Parser.exprFromText fileName source ) expr' <- Dhall.Import.load expr @@ -569,8 +603,6 @@ Dhall.expected t & build & Builder.toLazyText - & LazyText.encodeUtf8 - & LazyByteString.toStrict let annot = @@ -611,6 +643,7 @@ +pattern V0 :: Dhall.Text -> Expr.Expr s a pattern V0 v = Expr.Var ( Expr.V v 0 ) @@ -717,29 +750,120 @@ -license :: Dhall.Type Cabal.License +license :: Dhall.Type (Either SPDX.License Cabal.License) license = makeUnion ( Map.fromList - [ ( "GPL", Cabal.GPL <$> Dhall.maybe version ) - , ( "AGPL", Cabal.AGPL <$> Dhall.maybe version ) - , ( "LGPL", Cabal.LGPL <$> Dhall.maybe version ) - , ( "BSD2", Cabal.BSD2 <$ Dhall.unit ) - , ( "BSD3", Cabal.BSD3 <$ Dhall.unit ) - , ( "BSD4", Cabal.BSD4 <$ Dhall.unit ) - , ( "MIT", Cabal.MIT <$ Dhall.unit ) - , ( "ISC", Cabal.ISC <$ Dhall.unit ) - , ( "MPL", Cabal.MPL <$> version ) - , ( "Apache", Cabal.Apache <$> Dhall.maybe version ) - , ( "PublicDomain", Cabal.PublicDomain <$ Dhall.unit ) - , ( "AllRightsReserved", Cabal.AllRightsReserved<$ Dhall.unit ) - , ( "Unspecified", Cabal.UnspecifiedLicense <$ Dhall.unit ) - , ( "Other", Cabal.OtherLicense <$ Dhall.unit ) + [ ( "GPL", Right . Cabal.GPL <$> Dhall.maybe version ) + , ( "AGPL", Right . Cabal.AGPL <$> Dhall.maybe version ) + , ( "LGPL", Right . Cabal.LGPL <$> Dhall.maybe version ) + , ( "BSD2", Right Cabal.BSD2 <$ Dhall.unit ) + , ( "BSD3", Right Cabal.BSD3 <$ Dhall.unit ) + , ( "BSD4", Right Cabal.BSD4 <$ Dhall.unit ) + , ( "MIT", Right Cabal.MIT <$ Dhall.unit ) + , ( "ISC", Right Cabal.ISC <$ Dhall.unit ) + , ( "MPL", Right . Cabal.MPL <$> version ) + , ( "Apache", Right . Cabal.Apache <$> Dhall.maybe version ) + , ( "PublicDomain", Right Cabal.PublicDomain <$ Dhall.unit ) + , ( "AllRightsReserved", Right Cabal.AllRightsReserved<$ Dhall.unit ) + , ( "Unspecified", Right Cabal.UnspecifiedLicense <$ Dhall.unit ) + , ( "Other", Right Cabal.OtherLicense <$ Dhall.unit ) + , ( "SPDX", Left . SPDX.License <$> spdxLicense ) ] ) +spdxLicense :: Dhall.Type SPDX.LicenseExpression +spdxLicense = + let + extract = + \case + LamArr _spdx (LamArr _licenseExactVersion (LamArr _licenseVersionOrLater (LamArr _licenseRef (LamArr _licenseRefWithFile (LamArr _licenseAnd (LamArr _licenseOr license)))))) -> + go license + _ -> + Nothing + + go = + \case + Expr.App ( Expr.App ( V0 "license" ) identM ) exceptionMayM -> do + ident <- Dhall.extract spdxLicenseId identM + exceptionMay <- Dhall.extract ( Dhall.maybe spdxLicenseExceptionId ) exceptionMayM + return ( SPDX.ELicense ( SPDX.ELicenseId ident ) exceptionMay ) + + Expr.App ( Expr.App ( V0 "licenseVersionOrLater" ) identM ) exceptionMayM -> do + ident <- Dhall.extract spdxLicenseId identM + exceptionMay <- Dhall.extract ( Dhall.maybe spdxLicenseExceptionId ) exceptionMayM + return ( SPDX.ELicense ( SPDX.ELicenseIdPlus ident ) exceptionMay ) + + Expr.App ( Expr.App ( V0 "ref" ) identM ) exceptionMayM -> do + ident <- Dhall.extract Dhall.string identM + exceptionMay <- Dhall.extract ( Dhall.maybe spdxLicenseExceptionId ) exceptionMayM + return ( SPDX.ELicense ( SPDX.ELicenseRef ( SPDX.mkLicenseRef' Nothing ident ) ) exceptionMay ) + + Expr.App ( Expr.App ( Expr.App ( V0 "refWithFile" ) identM ) filenameM) exceptionMayM -> do + ident <- Dhall.extract Dhall.string identM + filename <- Dhall.extract Dhall.string filenameM + exceptionMay <- Dhall.extract ( Dhall.maybe spdxLicenseExceptionId ) exceptionMayM + return ( SPDX.ELicense ( SPDX.ELicenseRef ( SPDX.mkLicenseRef' ( Just filename ) ident ) ) exceptionMay ) + + Expr.App ( Expr.App ( V0 "and" ) a ) b -> + SPDX.EAnd <$> go a <*> go b + + Expr.App ( Expr.App ( V0 "or" ) a ) b -> + SPDX.EOr <$> go a <*> go b + + _ -> + Nothing + + expected = + let + licenseType = + V0 "SPDX" + + licenseIdAndException + = Expr.Pi "id" ( Dhall.expected spdxLicenseId ) + $ Expr.Pi "exception" ( Dhall.expected ( Dhall.maybe spdxLicenseExceptionId ) ) + $ licenseType + + licenseRef + = Expr.Pi "ref" ( Dhall.expected Dhall.string ) + $ Expr.Pi "exception" ( Dhall.expected ( Dhall.maybe spdxLicenseExceptionId ) ) + $ licenseType + + licenseRefWithFile + = Expr.Pi "ref" ( Dhall.expected Dhall.string ) + $ Expr.Pi "file" ( Dhall.expected Dhall.string ) + $ Expr.Pi "exception" ( Dhall.expected ( Dhall.maybe spdxLicenseExceptionId ) ) + $ licenseType + + combine = + Expr.Pi "_" licenseType ( Expr.Pi "_" licenseType licenseType ) + + in + Expr.Pi "SPDX" ( Expr.Const Expr.Type ) + $ Expr.Pi "license" licenseIdAndException + $ Expr.Pi "licenseVersionOrLater" licenseIdAndException + $ Expr.Pi "ref" licenseRef + $ Expr.Pi "refWithFile" licenseRefWithFile + $ Expr.Pi "and" combine + $ Expr.Pi "or" combine + $ licenseType + + in Dhall.Type { .. } + + + +spdxLicenseId :: Dhall.Type SPDX.LicenseId +spdxLicenseId = Dhall.genericAuto + + + +spdxLicenseExceptionId :: Dhall.Type SPDX.LicenseExceptionId +spdxLicenseExceptionId = Dhall.genericAuto + + + compiler :: Dhall.Type ( Cabal.CompilerFlavor, Cabal.VersionRange ) compiler = makeRecord $ @@ -964,7 +1088,7 @@ error ( "Unexpected guard expression. This is a bug, please report this! I'm stuck on: " ++ show body ) extract expr = - configTreeToCondTree [] <$> extractConfigTree ( toConfigTree expr ) + configTreeToCondTree [] [] <$> extractConfigTree ( toConfigTree expr ) extractConfigTree ( Leaf a ) = Leaf <$> Dhall.extract t a @@ -972,33 +1096,34 @@ extractConfigTree ( Branch cond a b ) = Branch <$> extractConfVar cond <*> extractConfigTree a <*> extractConfigTree b - configTreeToCondTree confVars = \case + configTreeToCondTree confVarsTrue confVarsFalse = \case Leaf a -> Cabal.CondNode a mempty mempty -- The condition has already been shown to hold. Consider only the true -- branch and discard the false branch. - Branch confVar a _impossible | confVar `elem` confVars -> - configTreeToCondTree confVars a + Branch confVar a _impossible | confVar `elem` confVarsTrue -> + configTreeToCondTree confVarsTrue confVarsFalse a + -- ...and here, the condition has been shown *not* to hold. + Branch confVar _impossible b | confVar `elem` confVarsFalse -> + configTreeToCondTree confVarsTrue confVarsFalse b + Branch confVar a b -> let - confVars' = - pure confVar <> confVars - true = - configTreeToCondTree confVars' a + configTreeToCondTree ( pure confVar <> confVarsTrue ) confVarsFalse a false = - configTreeToCondTree confVars' b + configTreeToCondTree confVarsTrue ( pure confVar <> confVarsFalse ) b ( common, true', false' ) = diff ( Cabal.condTreeData true ) ( Cabal.condTreeData false ) ( duplicates, true'', false'' ) = diff - ( Cabal.condTreeComponents false ) ( Cabal.condTreeComponents true ) + ( Cabal.condTreeComponents false ) in Cabal.CondNode diff --git a/lib/DhallToCabal/ConfigTree.hs b/lib/DhallToCabal/ConfigTree.hs --- a/lib/DhallToCabal/ConfigTree.hs +++ b/lib/DhallToCabal/ConfigTree.hs @@ -5,6 +5,7 @@ module DhallToCabal.ConfigTree ( ConfigTree(..), toConfigTree ) where import Control.Monad +import Data.Semigroup ( Semigroup ( (<>) ) ) import Dhall.Core hiding ( Const ) @@ -26,6 +27,12 @@ Leaf a >>= f = f a Branch cond l r >>= f = Branch cond ( l >>= f ) ( r >>= f ) +instance ( Semigroup a ) => Semigroup ( ConfigTree cond a ) where + (<>) = liftM2 (<>) + +instance ( Monoid a ) => Monoid ( ConfigTree cond a ) where + mempty = pure mempty + mappend = liftM2 mappend -- | Given a Dhall expression that is of the form @λ( config : Config ) -> a@,