Move Platform into its own module.

This commit is contained in:
Robin Heggelund Hansen 2022-08-19 15:28:00 +02:00
parent 963c9b3ce4
commit 32d5d29fcb
7 changed files with 72 additions and 40 deletions

View File

@ -26,6 +26,7 @@ import File qualified
import Gren.Constraint qualified as C import Gren.Constraint qualified as C
import Gren.Outline qualified as Outline import Gren.Outline qualified as Outline
import Gren.Package qualified as Pkg import Gren.Package qualified as Pkg
import Gren.Platform qualified as Platform
import Gren.Version qualified as V import Gren.Version qualified as V
import Json.Decode qualified as D import Json.Decode qualified as D
import Reporting.Exit qualified as Exit import Reporting.Exit qualified as Exit
@ -68,7 +69,7 @@ data Details
verify :: verify ::
Dirs.PackageCache -> Dirs.PackageCache ->
Outline.Platform -> Platform.Platform ->
Map.Map Pkg.Name C.Constraint -> Map.Map Pkg.Name C.Constraint ->
IO (Result (Map.Map Pkg.Name Details)) IO (Result (Map.Map Pkg.Name Details))
verify cache rootPlatform constraints = verify cache rootPlatform constraints =
@ -145,14 +146,14 @@ getTransitive constraints solution unvisited visited =
-- TRY -- 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 = try rootPlatform constraints =
exploreGoals (Goals (NE.List rootPlatform []) constraints Map.empty) exploreGoals (Goals (NE.List rootPlatform []) constraints Map.empty)
-- EXPLORE GOALS -- EXPLORE GOALS
data Goals = Goals data Goals = Goals
{ _compatible_platforms :: NE.List Outline.Platform, { _compatible_platforms :: NE.List Platform.Platform,
_pending :: Map.Map Pkg.Name C.Constraint, _pending :: Map.Map Pkg.Name C.Constraint,
_solved :: Map.Map Pkg.Name V.Version _solved :: Map.Map Pkg.Name V.Version
} }

View File

@ -43,6 +43,7 @@ import Gren.Kernel qualified as Kernel
import Gren.ModuleName qualified as ModuleName import Gren.ModuleName qualified as ModuleName
import Gren.Outline qualified as Outline import Gren.Outline qualified as Outline
import Gren.Package qualified as Pkg import Gren.Package qualified as Pkg
import Gren.Platform qualified as Platform
import Gren.Version qualified as V import Gren.Version qualified as V
import Json.Encode qualified as E import Json.Encode qualified as E
import Parse.Module qualified as Parse import Parse.Module qualified as Parse
@ -212,7 +213,7 @@ checkAppDeps (Outline.AppOutline _ _ _ direct indirect) =
verifyConstraints :: verifyConstraints ::
Env -> Env ->
Outline.Platform -> Platform.Platform ->
Map.Map Pkg.Name Con.Constraint -> Map.Map Pkg.Name Con.Constraint ->
Task (Map.Map Pkg.Name Solver.Details) Task (Map.Map Pkg.Name Solver.Details)
verifyConstraints (Env _ _ _ cache) rootPlatform constraints = verifyConstraints (Env _ _ _ cache) rootPlatform constraints =

View File

@ -8,7 +8,6 @@ module Gren.Outline
PkgOutline (..), PkgOutline (..),
Exposed (..), Exposed (..),
SrcDir (..), SrcDir (..),
Platform (..),
read, read,
write, write,
encode, encode,
@ -34,6 +33,7 @@ import Gren.Constraint qualified as Con
import Gren.Licenses qualified as Licenses import Gren.Licenses qualified as Licenses
import Gren.ModuleName qualified as ModuleName import Gren.ModuleName qualified as ModuleName
import Gren.Package qualified as Pkg import Gren.Package qualified as Pkg
import Gren.Platform qualified as Platform
import Gren.Version qualified as V import Gren.Version qualified as V
import Json.Decode qualified as D import Json.Decode qualified as D
import Json.Encode ((==>)) import Json.Encode ((==>))
@ -54,7 +54,7 @@ data Outline
data AppOutline = AppOutline data AppOutline = AppOutline
{ _app_gren_version :: V.Version, { _app_gren_version :: V.Version,
_app_platform :: Platform, _app_platform :: Platform.Platform,
_app_source_dirs :: NE.List SrcDir, _app_source_dirs :: NE.List SrcDir,
_app_deps_direct :: Map.Map Pkg.Name V.Version, _app_deps_direct :: Map.Map Pkg.Name V.Version,
_app_deps_indirect :: 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_exposed :: Exposed,
_pkg_deps :: Map.Map Pkg.Name Con.Constraint, _pkg_deps :: Map.Map Pkg.Name Con.Constraint,
_pkg_gren_version :: Con.Constraint, _pkg_gren_version :: Con.Constraint,
_pkg_platform :: Platform _pkg_platform :: Platform.Platform
} }
data Exposed data Exposed
@ -79,11 +79,6 @@ data SrcDir
= AbsoluteSrcDir FilePath = AbsoluteSrcDir FilePath
| RelativeSrcDir FilePath | RelativeSrcDir FilePath
data Platform
= Common
| Browser
| Node
-- DEFAULTS -- DEFAULTS
defaultSummary :: Json.String defaultSummary :: Json.String
@ -114,7 +109,7 @@ encode outline =
App (AppOutline gren platform srcDirs depsDirect depsTrans) -> App (AppOutline gren platform srcDirs depsDirect depsTrans) ->
E.object E.object
[ "type" ==> E.chars "application", [ "type" ==> E.chars "application",
"platform" ==> encodePlatform platform, "platform" ==> Platform.encode platform,
"source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs), "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs),
"gren-version" ==> V.encode gren, "gren-version" ==> V.encode gren,
"dependencies" "dependencies"
@ -126,7 +121,7 @@ encode outline =
Pkg (PkgOutline name summary license version exposed deps gren platform) -> Pkg (PkgOutline name summary license version exposed deps gren platform) ->
E.object E.object
[ "type" ==> E.string (Json.fromChars "package"), [ "type" ==> E.string (Json.fromChars "package"),
"platform" ==> encodePlatform platform, "platform" ==> Platform.encode platform,
"name" ==> Pkg.encode name, "name" ==> Pkg.encode name,
"summary" ==> E.string summary, "summary" ==> E.string summary,
"license" ==> Licenses.encode license, "license" ==> Licenses.encode license,
@ -158,13 +153,6 @@ encodeSrcDir srcDir =
AbsoluteSrcDir dir -> E.chars dir AbsoluteSrcDir dir -> E.chars dir
RelativeSrcDir 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 -- PARSE AND VERIFY
read :: FilePath -> IO (Either Exit.Outline Outline) read :: FilePath -> IO (Either Exit.Outline Outline)
@ -272,7 +260,7 @@ appDecoder :: Decoder AppOutline
appDecoder = appDecoder =
AppOutline AppOutline
<$> D.field "gren-version" versionDecoder <$> D.field "gren-version" versionDecoder
<*> D.field "platform" platformDecoder <*> D.field "platform" Platform.decoder
<*> D.field "source-directories" dirsDecoder <*> D.field "source-directories" dirsDecoder
<*> D.field "dependencies" (D.field "direct" (depsDecoder versionDecoder)) <*> D.field "dependencies" (D.field "direct" (depsDecoder versionDecoder))
<*> D.field "dependencies" (D.field "indirect" (depsDecoder versionDecoder)) <*> D.field "dependencies" (D.field "indirect" (depsDecoder versionDecoder))
@ -287,7 +275,7 @@ pkgDecoder =
<*> D.field "exposed-modules" exposedDecoder <*> D.field "exposed-modules" exposedDecoder
<*> D.field "dependencies" (depsDecoder constraintDecoder) <*> D.field "dependencies" (depsDecoder constraintDecoder)
<*> D.field "gren-version" constraintDecoder <*> D.field "gren-version" constraintDecoder
<*> D.field "platform" platformDecoder <*> D.field "platform" Platform.decoder
-- JSON DECODE HELPERS -- JSON DECODE HELPERS
@ -309,19 +297,6 @@ constraintDecoder :: Decoder Con.Constraint
constraintDecoder = constraintDecoder =
D.mapError Exit.OP_BadConstraint Con.decoder 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 :: Decoder a -> Decoder (Map.Map Pkg.Name a)
depsDecoder valueDecoder = depsDecoder valueDecoder =
D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder

View File

@ -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

View File

@ -85,6 +85,7 @@ Common gren-common
-- Gren things -- Gren things
Gren.Outline Gren.Outline
Gren.Platform
Gren.Details Gren.Details
-- --
Gren.Compiler.Imports Gren.Compiler.Imports

View File

@ -15,6 +15,7 @@ import Gren.Constraint qualified as Con
import Gren.Licenses qualified as Licenses import Gren.Licenses qualified as Licenses
import Gren.Outline qualified as Outline import Gren.Outline qualified as Outline
import Gren.Package qualified as Pkg import Gren.Package qualified as Pkg
import Gren.Platform qualified as Platform
import Gren.Version qualified as V import Gren.Version qualified as V
import Json.String qualified as Json import Json.String qualified as Json
import Reporting qualified import Reporting qualified
@ -85,7 +86,7 @@ init flags =
return $ Left $ Exit.InitNoCompatibleDependencies $ Just gitError return $ Left $ Exit.InitNoCompatibleDependencies $ Just gitError
Right deps -> do Right deps -> do
-- TODO: Make root platform customizable -- TODO: Make root platform customizable
result <- Solver.verify cache Outline.Browser deps result <- Solver.verify cache Platform.Browser deps
case result of case result of
Solver.Err exit -> Solver.Err exit ->
return (Left (Exit.InitSolverProblem exit)) return (Left (Exit.InitSolverProblem exit))
@ -115,7 +116,7 @@ pkgOutline deps =
(Outline.ExposedList []) (Outline.ExposedList [])
deps deps
Con.defaultGren Con.defaultGren
Outline.Browser Platform.Browser
appOutlineFromSolverDetails :: (Map.Map Pkg.Name Solver.Details) -> Outline.Outline appOutlineFromSolverDetails :: (Map.Map Pkg.Name Solver.Details) -> Outline.Outline
appOutlineFromSolverDetails details = appOutlineFromSolverDetails details =
@ -126,7 +127,7 @@ appOutlineFromSolverDetails details =
in Outline.App $ in Outline.App $
Outline.AppOutline Outline.AppOutline
V.compiler V.compiler
Outline.Browser Platform.Browser
(NE.List (Outline.RelativeSrcDir "src") []) (NE.List (Outline.RelativeSrcDir "src") [])
directs directs
indirects indirects

View File

@ -42,6 +42,7 @@ import Gren.Licenses qualified as Licenses
import Gren.ModuleName qualified as ModuleName import Gren.ModuleName qualified as ModuleName
import Gren.Outline qualified as Outline import Gren.Outline qualified as Outline
import Gren.Package qualified as Pkg import Gren.Package qualified as Pkg
import Gren.Platform qualified as Platform
import Gren.Version qualified as V import Gren.Version qualified as V
import Parse.Declaration qualified as PD import Parse.Declaration qualified as PD
import Parse.Expression qualified as PE import Parse.Expression qualified as PE
@ -523,7 +524,7 @@ getRoot =
(Outline.ExposedList []) (Outline.ExposedList [])
compatibleDeps compatibleDeps
C.defaultGren C.defaultGren
Outline.Browser Platform.Browser
return root return root