diff --git a/builder/src/Deps/Solver.hs b/builder/src/Deps/Solver.hs index dacfd559..d98a6ffd 100644 --- a/builder/src/Deps/Solver.hs +++ b/builder/src/Deps/Solver.hs @@ -26,6 +26,7 @@ import File qualified import Gren.Constraint qualified as C import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg +import Gren.Platform qualified as Platform import Gren.Version qualified as V import Json.Decode qualified as D import Reporting.Exit qualified as Exit @@ -68,7 +69,7 @@ data Details verify :: Dirs.PackageCache -> - Outline.Platform -> + Platform.Platform -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details)) verify cache rootPlatform constraints = @@ -145,14 +146,14 @@ getTransitive constraints solution unvisited visited = -- TRY -try :: Outline.Platform -> Map.Map Pkg.Name C.Constraint -> Solver (Map.Map Pkg.Name V.Version) +try :: Platform.Platform -> Map.Map Pkg.Name C.Constraint -> Solver (Map.Map Pkg.Name V.Version) try rootPlatform constraints = exploreGoals (Goals (NE.List rootPlatform []) constraints Map.empty) -- EXPLORE GOALS data Goals = Goals - { _compatible_platforms :: NE.List Outline.Platform, + { _compatible_platforms :: NE.List Platform.Platform, _pending :: Map.Map Pkg.Name C.Constraint, _solved :: Map.Map Pkg.Name V.Version } diff --git a/builder/src/Gren/Details.hs b/builder/src/Gren/Details.hs index f0fd0468..2d8aa2d6 100644 --- a/builder/src/Gren/Details.hs +++ b/builder/src/Gren/Details.hs @@ -43,6 +43,7 @@ import Gren.Kernel qualified as Kernel import Gren.ModuleName qualified as ModuleName import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg +import Gren.Platform qualified as Platform import Gren.Version qualified as V import Json.Encode qualified as E import Parse.Module qualified as Parse @@ -212,7 +213,7 @@ checkAppDeps (Outline.AppOutline _ _ _ direct indirect) = verifyConstraints :: Env -> - Outline.Platform -> + Platform.Platform -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details) verifyConstraints (Env _ _ _ cache) rootPlatform constraints = diff --git a/builder/src/Gren/Outline.hs b/builder/src/Gren/Outline.hs index e1da2f14..603eda00 100644 --- a/builder/src/Gren/Outline.hs +++ b/builder/src/Gren/Outline.hs @@ -8,7 +8,6 @@ module Gren.Outline PkgOutline (..), Exposed (..), SrcDir (..), - Platform (..), read, write, encode, @@ -34,6 +33,7 @@ import Gren.Constraint qualified as Con import Gren.Licenses qualified as Licenses import Gren.ModuleName qualified as ModuleName import Gren.Package qualified as Pkg +import Gren.Platform qualified as Platform import Gren.Version qualified as V import Json.Decode qualified as D import Json.Encode ((==>)) @@ -54,7 +54,7 @@ data Outline data AppOutline = AppOutline { _app_gren_version :: V.Version, - _app_platform :: Platform, + _app_platform :: Platform.Platform, _app_source_dirs :: NE.List SrcDir, _app_deps_direct :: Map.Map Pkg.Name V.Version, _app_deps_indirect :: Map.Map Pkg.Name V.Version @@ -68,7 +68,7 @@ data PkgOutline = PkgOutline _pkg_exposed :: Exposed, _pkg_deps :: Map.Map Pkg.Name Con.Constraint, _pkg_gren_version :: Con.Constraint, - _pkg_platform :: Platform + _pkg_platform :: Platform.Platform } data Exposed @@ -79,11 +79,6 @@ data SrcDir = AbsoluteSrcDir FilePath | RelativeSrcDir FilePath -data Platform - = Common - | Browser - | Node - -- DEFAULTS defaultSummary :: Json.String @@ -114,7 +109,7 @@ encode outline = App (AppOutline gren platform srcDirs depsDirect depsTrans) -> E.object [ "type" ==> E.chars "application", - "platform" ==> encodePlatform platform, + "platform" ==> Platform.encode platform, "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs), "gren-version" ==> V.encode gren, "dependencies" @@ -126,7 +121,7 @@ encode outline = Pkg (PkgOutline name summary license version exposed deps gren platform) -> E.object [ "type" ==> E.string (Json.fromChars "package"), - "platform" ==> encodePlatform platform, + "platform" ==> Platform.encode platform, "name" ==> Pkg.encode name, "summary" ==> E.string summary, "license" ==> Licenses.encode license, @@ -158,13 +153,6 @@ encodeSrcDir srcDir = AbsoluteSrcDir dir -> E.chars dir RelativeSrcDir dir -> E.chars dir -encodePlatform :: Platform -> E.Value -encodePlatform platform = - case platform of - Common -> E.chars "common" - Browser -> E.chars "browser" - Node -> E.chars "node" - -- PARSE AND VERIFY read :: FilePath -> IO (Either Exit.Outline Outline) @@ -272,7 +260,7 @@ appDecoder :: Decoder AppOutline appDecoder = AppOutline <$> D.field "gren-version" versionDecoder - <*> D.field "platform" platformDecoder + <*> D.field "platform" Platform.decoder <*> D.field "source-directories" dirsDecoder <*> D.field "dependencies" (D.field "direct" (depsDecoder versionDecoder)) <*> D.field "dependencies" (D.field "indirect" (depsDecoder versionDecoder)) @@ -287,7 +275,7 @@ pkgDecoder = <*> D.field "exposed-modules" exposedDecoder <*> D.field "dependencies" (depsDecoder constraintDecoder) <*> D.field "gren-version" constraintDecoder - <*> D.field "platform" platformDecoder + <*> D.field "platform" Platform.decoder -- JSON DECODE HELPERS @@ -309,19 +297,6 @@ constraintDecoder :: Decoder Con.Constraint constraintDecoder = D.mapError Exit.OP_BadConstraint Con.decoder -platformDecoder :: Decoder Platform -platformDecoder = - let common = Json.fromChars "common" - browser = Json.fromChars "browser" - node = Json.fromChars "node" - in do - platform <- D.string - if - | platform == common -> D.succeed Common - | platform == browser -> D.succeed Browser - | platform == node -> D.succeed Node - | otherwise -> D.failure Exit.OP_BadPlatform - depsDecoder :: Decoder a -> Decoder (Map.Map Pkg.Name a) depsDecoder valueDecoder = D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder diff --git a/builder/src/Gren/Platform.hs b/builder/src/Gren/Platform.hs new file mode 100644 index 00000000..bcf533d0 --- /dev/null +++ b/builder/src/Gren/Platform.hs @@ -0,0 +1,52 @@ +module Gren.Platform + ( Platform (..), + -- + compatible, + -- + encode, + decoder, + ) +where + +import Json.Decode qualified as D +import Json.Encode qualified as E +import Json.String qualified as Json +import Reporting.Exit qualified as Exit + +data Platform + = Common + | Browser + | Node + deriving (Eq) + +-- COMPATIBILITY + +compatible :: Platform -> Platform -> Bool +compatible rootPlatform comparison = + rootPlatform == comparison || comparison == Common + +-- JSON + +encode :: Platform -> E.Value +encode platform = + case platform of + Common -> E.chars "common" + Browser -> E.chars "browser" + Node -> E.chars "node" + +decoder :: D.Decoder Exit.OutlineProblem Platform +decoder = + let common = Json.fromChars "common" + browser = Json.fromChars "browser" + node = Json.fromChars "node" + in do + platform <- D.string + if platform == common + then D.succeed Common + else + if platform == browser + then D.succeed Browser + else + if platform == node + then D.succeed Node + else D.failure Exit.OP_BadPlatform diff --git a/gren.cabal b/gren.cabal index 7512713d..bc47156f 100644 --- a/gren.cabal +++ b/gren.cabal @@ -85,6 +85,7 @@ Common gren-common -- Gren things Gren.Outline + Gren.Platform Gren.Details -- Gren.Compiler.Imports diff --git a/terminal/src/Init.hs b/terminal/src/Init.hs index 423a860e..e716bf46 100644 --- a/terminal/src/Init.hs +++ b/terminal/src/Init.hs @@ -15,6 +15,7 @@ import Gren.Constraint qualified as Con import Gren.Licenses qualified as Licenses import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg +import Gren.Platform qualified as Platform import Gren.Version qualified as V import Json.String qualified as Json import Reporting qualified @@ -85,7 +86,7 @@ init flags = return $ Left $ Exit.InitNoCompatibleDependencies $ Just gitError Right deps -> do -- TODO: Make root platform customizable - result <- Solver.verify cache Outline.Browser deps + result <- Solver.verify cache Platform.Browser deps case result of Solver.Err exit -> return (Left (Exit.InitSolverProblem exit)) @@ -115,7 +116,7 @@ pkgOutline deps = (Outline.ExposedList []) deps Con.defaultGren - Outline.Browser + Platform.Browser appOutlineFromSolverDetails :: (Map.Map Pkg.Name Solver.Details) -> Outline.Outline appOutlineFromSolverDetails details = @@ -126,7 +127,7 @@ appOutlineFromSolverDetails details = in Outline.App $ Outline.AppOutline V.compiler - Outline.Browser + Platform.Browser (NE.List (Outline.RelativeSrcDir "src") []) directs indirects diff --git a/terminal/src/Repl.hs b/terminal/src/Repl.hs index e89b0697..6fcc59e0 100644 --- a/terminal/src/Repl.hs +++ b/terminal/src/Repl.hs @@ -42,6 +42,7 @@ import Gren.Licenses qualified as Licenses import Gren.ModuleName qualified as ModuleName import Gren.Outline qualified as Outline import Gren.Package qualified as Pkg +import Gren.Platform qualified as Platform import Gren.Version qualified as V import Parse.Declaration qualified as PD import Parse.Expression qualified as PE @@ -523,7 +524,7 @@ getRoot = (Outline.ExposedList []) compatibleDeps C.defaultGren - Outline.Browser + Platform.Browser return root