mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 08:45:42 +03:00
Move Platform into its own module.
This commit is contained in:
parent
963c9b3ce4
commit
32d5d29fcb
@ -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
|
||||||
}
|
}
|
||||||
|
@ -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 =
|
||||||
|
@ -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
|
||||||
|
52
builder/src/Gren/Platform.hs
Normal file
52
builder/src/Gren/Platform.hs
Normal 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
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user