diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index 925d66903..420365e2f 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -1,6 +1,5 @@ module Builder.Build exposing ( Artifacts(..) - , Dependencies , DocsGoal(..) , Module(..) , ReplArtifacts(..) @@ -38,8 +37,6 @@ import Compiler.Json.Decode as D import Compiler.Json.Encode as E import Compiler.Parse.Module as Parse import Compiler.Reporting.Error as Error -import Compiler.Reporting.Error.Import as Import -import Compiler.Reporting.Error.Syntax as Syntax import Compiler.Reporting.Render.Type.Localizer as L import Data.Graph as Graph import Data.Map as Dict exposing (Dict) @@ -117,9 +114,29 @@ fork encoder work = ) -forkWithKey : (k -> comparable) -> (k -> k -> Order) -> (b -> Encode.Value) -> (k -> a -> IO b) -> Dict comparable k a -> IO (Dict comparable k (T.MVar b)) -forkWithKey toComparable keyComparison encoder func dict = - Utils.mapTraverseWithKey toComparable keyComparison (\k v -> fork encoder (func k v)) dict +fork_BB_BResult : IO T.BB_BResult -> IO T.MVar_BB_BResult +fork_BB_BResult work = + Utils.newEmptyMVar_BB_BResult + |> IO.bind + (\mvar -> + Utils.forkIO (IO.bind (Utils.putMVar_BB_BResult mvar) work) + |> IO.fmap (\_ -> mvar) + ) + + +fork_BB_Status : IO T.BB_Status -> IO T.MVar_BB_Status +fork_BB_Status work = + Utils.newEmptyMVar_BB_Status + |> IO.bind + (\mvar -> + Utils.forkIO (IO.bind (Utils.putMVar_BB_Status mvar) work) + |> IO.fmap (\_ -> mvar) + ) + + +forkWithKey_BB_BResult : (k -> comparable) -> (k -> k -> Order) -> (k -> a -> IO T.BB_BResult) -> Dict comparable k a -> IO (Dict comparable k T.MVar_BB_BResult) +forkWithKey_BB_BResult toComparable keyComparison func dict = + Utils.mapTraverseWithKey toComparable keyComparison (\k v -> fork_BB_BResult (func k v)) dict @@ -137,24 +154,24 @@ fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e |> IO.bind (\dmvar -> -- crawl - Utils.newEmptyMVar + Utils.newEmptyMVar_BB_StatusDict |> IO.bind (\mvar -> let - docsNeed : DocsNeed + docsNeed : T.BB_DocsNeed docsNeed = toDocsNeed docsGoal in - Map.fromKeysA identity (fork statusEncoder << crawlModule env mvar docsNeed) (e :: es) + Map.fromKeysA identity (fork_BB_Status << crawlModule env mvar docsNeed) (e :: es) |> IO.bind (\roots -> - Utils.putMVar statusDictEncoder mvar roots + Utils.putMVar_BB_StatusDict mvar roots |> IO.bind (\_ -> - Utils.dictMapM_ compare (Utils.readMVar statusDecoder) roots + Utils.dictMapM_ compare Utils.readMVar_BB_Status roots |> IO.bind (\_ -> - IO.bind (Utils.mapTraverse identity compare (Utils.readMVar statusDecoder)) (Utils.readMVar statusDictDecoder mvar) + IO.bind (Utils.mapTraverse identity compare Utils.readMVar_BB_Status) (Utils.readMVar_BB_StatusDict mvar) |> IO.bind (\statuses -> -- compile @@ -169,13 +186,13 @@ fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e Utils.newEmptyMVar |> IO.bind (\rmvar -> - forkWithKey identity compare bResultEncoder (checkModule env foreigns rmvar) statuses + forkWithKey_BB_BResult identity compare (checkModule env foreigns rmvar) statuses |> IO.bind (\resultMVars -> Utils.putMVar dictRawMVarBResultEncoder rmvar resultMVars |> IO.bind (\_ -> - Utils.mapTraverse identity compare (Utils.readMVar bResultDecoder) resultMVars + Utils.mapTraverse identity compare Utils.readMVar_BB_BResult resultMVars |> IO.bind (\results -> writeDetails root details results @@ -202,7 +219,7 @@ fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e type Artifacts - = Artifacts T.CEP_Name Dependencies (NE.Nonempty Root) (List Module) + = Artifacts T.CEP_Name T.BB_Dependencies (NE.Nonempty Root) (List Module) type Module @@ -210,10 +227,6 @@ type Module | Cached T.CEMN_Raw Bool (T.MVar T.BB_CachedInterface) -type alias Dependencies = - Dict (List String) T.CEMN_Canonical I.DependencyInterface - - fromPaths : Reporting.Style -> T.FilePath -> Details.Details -> NE.Nonempty T.FilePath -> IO (Result Exit.BuildProblem Artifacts) fromPaths style root details paths = Reporting.trackBuild artifactsDecoder artifactsEncoder style <| @@ -233,7 +246,7 @@ fromPaths style root details paths = Details.loadInterfaces root details |> IO.bind (\dmvar -> - Utils.newMVar statusDictEncoder Dict.empty + Utils.newMVar_BB_StatusDict Dict.empty |> IO.bind (\smvar -> Utils.nonEmptyListTraverse (fork rootStatusEncoder << crawlRoot env smvar) lroots @@ -242,7 +255,7 @@ fromPaths style root details paths = Utils.nonEmptyListTraverse (Utils.readMVar rootStatusDecoder) srootMVars |> IO.bind (\sroots -> - IO.bind (Utils.mapTraverse identity compare (Utils.readMVar statusDecoder)) (Utils.readMVar statusDictDecoder smvar) + IO.bind (Utils.mapTraverse identity compare Utils.readMVar_BB_Status) (Utils.readMVar_BB_StatusDict smvar) |> IO.bind (\statuses -> checkMidpointAndRoots dmvar statuses sroots @@ -257,7 +270,7 @@ fromPaths style root details paths = Utils.newEmptyMVar |> IO.bind (\rmvar -> - forkWithKey identity compare bResultEncoder (checkModule env foreigns rmvar) statuses + forkWithKey_BB_BResult identity compare (checkModule env foreigns rmvar) statuses |> IO.bind (\resultsMVars -> Utils.putMVar resultDictEncoder rmvar resultsMVars @@ -266,7 +279,7 @@ fromPaths style root details paths = Utils.nonEmptyListTraverse (fork rootResultEncoder << checkRoot env resultsMVars) sroots |> IO.bind (\rrootMVars -> - Utils.mapTraverse identity compare (Utils.readMVar bResultDecoder) resultsMVars + Utils.mapTraverse identity compare Utils.readMVar_BB_BResult resultsMVars |> IO.bind (\results -> writeDetails root details results @@ -312,27 +325,14 @@ getRootName root = -- CRAWL -type alias StatusDict = - Dict String T.CEMN_Raw (T.MVar Status) - - -type Status - = SCached T.BED_Local - | SChanged T.BED_Local String T.CASTS_Module DocsNeed - | SBadImport T.CREI_Problem - | SBadSyntax T.FilePath T.BF_Time String T.CRES_Error - | SForeign T.CEP_Name - | SKernel - - -crawlDeps : Env -> T.MVar StatusDict -> List T.CEMN_Raw -> a -> IO a +crawlDeps : Env -> T.MVar_BB_StatusDict -> List T.CEMN_Raw -> a -> IO a crawlDeps env mvar deps blockedValue = let - crawlNew : T.CEMN_Raw -> () -> IO (T.MVar Status) + crawlNew : T.CEMN_Raw -> () -> IO T.MVar_BB_Status crawlNew name () = - fork statusEncoder (crawlModule env mvar (DocsNeed False) name) + fork_BB_Status (crawlModule env mvar (T.BB_DocsNeed False) name) in - Utils.takeMVar statusDictDecoder mvar + Utils.takeMVar_BB_StatusDict mvar |> IO.bind (\statusDict -> let @@ -347,18 +347,18 @@ crawlDeps env mvar deps blockedValue = Utils.mapTraverseWithKey identity compare crawlNew newsDict |> IO.bind (\statuses -> - Utils.putMVar statusDictEncoder mvar (Dict.union statuses statusDict) + Utils.putMVar_BB_StatusDict mvar (Dict.union statuses statusDict) |> IO.bind (\_ -> - Utils.dictMapM_ compare (Utils.readMVar statusDecoder) statuses + Utils.dictMapM_ compare Utils.readMVar_BB_Status statuses |> IO.fmap (\_ -> blockedValue) ) ) ) -crawlModule : Env -> T.MVar StatusDict -> DocsNeed -> T.CEMN_Raw -> IO Status -crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mvar ((DocsNeed needsDocs) as docsNeed) name = +crawlModule : Env -> T.MVar_BB_StatusDict -> T.BB_DocsNeed -> T.CEMN_Raw -> IO T.BB_Status +crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mvar ((T.BB_DocsNeed needsDocs) as docsNeed) name = let fileName : String fileName = @@ -371,7 +371,7 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv [ path ] -> case Dict.get identity name foreigns of Just (Details.Foreign dep deps) -> - IO.pure <| SBadImport <| T.CREI_Ambiguous path [] dep deps + IO.pure <| T.BB_SBadImport <| T.CREI_Ambiguous path [] dep deps Nothing -> File.getTime path @@ -386,21 +386,21 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv crawlFile env mvar docsNeed name path newTime lastChange else - crawlDeps env mvar deps (SCached local) + crawlDeps env mvar deps (T.BB_SCached local) ) p1 :: p2 :: ps -> - IO.pure <| SBadImport <| T.CREI_AmbiguousLocal (Utils.fpMakeRelative root p1) (Utils.fpMakeRelative root p2) (List.map (Utils.fpMakeRelative root) ps) + IO.pure <| T.BB_SBadImport <| T.CREI_AmbiguousLocal (Utils.fpMakeRelative root p1) (Utils.fpMakeRelative root p2) (List.map (Utils.fpMakeRelative root) ps) [] -> case Dict.get identity name foreigns of Just (Details.Foreign dep deps) -> case deps of [] -> - IO.pure <| SForeign dep + IO.pure <| T.BB_SForeign dep d :: ds -> - IO.pure <| SBadImport <| T.CREI_AmbiguousForeign dep d ds + IO.pure <| T.BB_SBadImport <| T.CREI_AmbiguousForeign dep d ds Nothing -> if Name.isKernel name && Parse.isKernel projectType then @@ -408,30 +408,30 @@ crawlModule ((Env _ root projectType srcDirs buildID locals foreigns) as env) mv |> IO.fmap (\exists -> if exists then - SKernel + T.BB_SKernel else - SBadImport T.CREI_NotFound + T.BB_SBadImport T.CREI_NotFound ) else - IO.pure <| SBadImport T.CREI_NotFound + IO.pure <| T.BB_SBadImport T.CREI_NotFound ) -crawlFile : Env -> T.MVar StatusDict -> DocsNeed -> T.CEMN_Raw -> T.FilePath -> T.BF_Time -> T.BED_BuildID -> IO Status +crawlFile : Env -> T.MVar_BB_StatusDict -> T.BB_DocsNeed -> T.CEMN_Raw -> T.FilePath -> T.BF_Time -> T.BED_BuildID -> IO T.BB_Status crawlFile ((Env _ root projectType _ buildID _ _) as env) mvar docsNeed expectedName path time lastChange = File.readUtf8 (Utils.fpForwardSlash root path) |> IO.bind (\source -> case Parse.fromByteString projectType source of Err err -> - IO.pure <| SBadSyntax path time source err + IO.pure <| T.BB_SBadSyntax path time source err Ok ((T.CASTS_Module maybeActualName _ _ imports values _ _ _ _) as modul) -> case maybeActualName of Nothing -> - IO.pure <| SBadSyntax path time source (T.CRES_ModuleNameUnspecified expectedName) + IO.pure <| T.BB_SBadSyntax path time source (T.CRES_ModuleNameUnspecified expectedName) Just ((T.CRA_At _ actualName) as name) -> if expectedName == actualName then @@ -444,10 +444,10 @@ crawlFile ((Env _ root projectType _ buildID _ _) as env) mvar docsNeed expected local = T.BED_Local path time deps (List.any isMain values) lastChange buildID in - crawlDeps env mvar deps (SChanged local source modul docsNeed) + crawlDeps env mvar deps (T.BB_SChanged local source modul docsNeed) else - IO.pure <| SBadSyntax path time source (T.CRES_ModuleNameMismatch expectedName name) + IO.pure <| T.BB_SBadSyntax path time source (T.CRES_ModuleNameMismatch expectedName name) ) @@ -460,10 +460,10 @@ isMain (T.CRA_At _ (T.CASTS_Value (T.CRA_At _ name) _ _ _)) = -- CHECK MODULE -checkModule : Env -> Dependencies -> T.MVar T.BB_ResultDict -> T.CEMN_Raw -> Status -> IO T.BB_BResult +checkModule : Env -> T.BB_Dependencies -> T.MVar T.BB_ResultDict -> T.CEMN_Raw -> T.BB_Status -> IO T.BB_BResult checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name status = case status of - SCached ((T.BED_Local path time deps hasMain lastChange lastCompile) as local) -> + T.BB_SCached ((T.BED_Local path time deps hasMain lastChange lastCompile) as local) -> Utils.readMVar resultDictDecoder resultsMVar |> IO.bind (\results -> @@ -477,7 +477,7 @@ checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name (\source -> case Parse.fromByteString projectType source of Ok modul -> - compile env (DocsNeed False) local source ifaces modul + compile env (T.BB_DocsNeed False) local source ifaces modul Err err -> IO.pure <| @@ -512,7 +512,7 @@ checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name ) ) - SChanged ((T.BED_Local path time deps _ _ lastCompile) as local) source ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) docsNeed -> + T.BB_SChanged ((T.BED_Local path time deps _ _ lastCompile) as local) source ((T.CASTS_Module _ _ _ imports _ _ _ _ _) as modul) docsNeed -> Utils.readMVar resultDictDecoder resultsMVar |> IO.bind (\results -> @@ -546,24 +546,24 @@ checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name ) ) - SBadImport importProblem -> + T.BB_SBadImport importProblem -> IO.pure (T.BB_RNotFound importProblem) - SBadSyntax path time source err -> + T.BB_SBadSyntax path time source err -> IO.pure <| T.BB_RProblem <| T.CRE_Module name path time source <| T.CRE_BadSyntax err - SForeign home -> + T.BB_SForeign home -> case Utils.find ModuleName.toComparableCanonical (T.CEMN_Canonical home name) foreigns of - I.Public iface -> + T.CEI_Public iface -> IO.pure (T.BB_RForeign iface) - I.Private _ _ _ -> + T.CEI_Private _ _ _ -> crash <| "mistakenly seeing private interface for " ++ Pkg.toChars home ++ " " ++ name - SKernel -> + T.BB_SKernel -> IO.pure T.BB_RKernel @@ -595,7 +595,7 @@ checkDepsHelp : T.FilePath -> T.BB_ResultDict -> List T.CEMN_Raw -> List Dep -> checkDepsHelp root results deps new same cached importProblems isBlocked lastDepChange lastCompile = case deps of dep :: otherDeps -> - Utils.readMVar bResultDecoder (Utils.find identity dep results) + Utils.readMVar_BB_BResult (Utils.find identity dep results) |> IO.bind (\result -> case result of @@ -737,11 +737,11 @@ loadInterface root ( name, ciMvar ) = -- CHECK PROJECT -checkMidpoint : T.MVar (Maybe Dependencies) -> Dict String T.CEMN_Raw Status -> IO (Result Exit.BuildProjectProblem Dependencies) +checkMidpoint : T.MVar_Maybe_BB_Dependencies -> Dict String T.CEMN_Raw T.BB_Status -> IO (Result Exit.BuildProjectProblem T.BB_Dependencies) checkMidpoint dmvar statuses = case checkForCycles statuses of Nothing -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar_Maybe_BB_Dependencies dmvar |> IO.fmap (\maybeForeigns -> case maybeForeigns of @@ -753,17 +753,17 @@ checkMidpoint dmvar statuses = ) Just (NE.Nonempty name names) -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar_Maybe_BB_Dependencies dmvar |> IO.fmap (\_ -> Err (Exit.BP_Cycle name names)) -checkMidpointAndRoots : T.MVar (Maybe Dependencies) -> Dict String T.CEMN_Raw Status -> NE.Nonempty RootStatus -> IO (Result Exit.BuildProjectProblem Dependencies) +checkMidpointAndRoots : T.MVar_Maybe_BB_Dependencies -> Dict String T.CEMN_Raw T.BB_Status -> NE.Nonempty RootStatus -> IO (Result Exit.BuildProjectProblem T.BB_Dependencies) checkMidpointAndRoots dmvar statuses sroots = case checkForCycles statuses of Nothing -> case checkUniqueRoots statuses sroots of Nothing -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar_Maybe_BB_Dependencies dmvar |> IO.bind (\maybeForeigns -> case maybeForeigns of @@ -775,11 +775,11 @@ checkMidpointAndRoots dmvar statuses sroots = ) Just problem -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar_Maybe_BB_Dependencies dmvar |> IO.fmap (\_ -> Err problem) Just (NE.Nonempty name names) -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar_Maybe_BB_Dependencies dmvar |> IO.fmap (\_ -> Err (Exit.BP_Cycle name names)) @@ -787,7 +787,7 @@ checkMidpointAndRoots dmvar statuses sroots = -- CHECK FOR CYCLES -checkForCycles : Dict String T.CEMN_Raw Status -> Maybe (NE.Nonempty T.CEMN_Raw) +checkForCycles : Dict String T.CEMN_Raw T.BB_Status -> Maybe (NE.Nonempty T.CEMN_Raw) checkForCycles modules = let graph : List Node @@ -823,28 +823,28 @@ type alias Node = ( T.CEMN_Raw, T.CEMN_Raw, List T.CEMN_Raw ) -addToGraph : T.CEMN_Raw -> Status -> List Node -> List Node +addToGraph : T.CEMN_Raw -> T.BB_Status -> List Node -> List Node addToGraph name status graph = let dependencies : List T.CEMN_Raw dependencies = case status of - SCached (T.BED_Local _ _ deps _ _ _) -> + T.BB_SCached (T.BED_Local _ _ deps _ _ _) -> deps - SChanged (T.BED_Local _ _ deps _ _ _) _ _ _ -> + T.BB_SChanged (T.BED_Local _ _ deps _ _ _) _ _ _ -> deps - SBadImport _ -> + T.BB_SBadImport _ -> [] - SBadSyntax _ _ _ _ -> + T.BB_SBadSyntax _ _ _ _ -> [] - SForeign _ -> + T.BB_SForeign _ -> [] - SKernel -> + T.BB_SKernel -> [] in ( name, name, dependencies ) :: graph @@ -854,7 +854,7 @@ addToGraph name status graph = -- CHECK UNIQUE ROOTS -checkUniqueRoots : Dict String T.CEMN_Raw Status -> NE.Nonempty RootStatus -> Maybe Exit.BuildProjectProblem +checkUniqueRoots : Dict String T.CEMN_Raw T.BB_Status -> NE.Nonempty RootStatus -> Maybe Exit.BuildProjectProblem checkUniqueRoots insides sroots = let outsidesDict : Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.FilePath) @@ -897,25 +897,25 @@ checkOutside name paths = Err (Exit.BP_RootNameDuplicate name p1 p2) -checkInside : T.CEMN_Raw -> T.FilePath -> Status -> Result Exit.BuildProjectProblem () +checkInside : T.CEMN_Raw -> T.FilePath -> T.BB_Status -> Result Exit.BuildProjectProblem () checkInside name p1 status = case status of - SCached (T.BED_Local p2 _ _ _ _ _) -> + T.BB_SCached (T.BED_Local p2 _ _ _ _ _) -> Err (Exit.BP_RootNameDuplicate name p1 p2) - SChanged (T.BED_Local p2 _ _ _ _ _) _ _ _ -> + T.BB_SChanged (T.BED_Local p2 _ _ _ _ _) _ _ _ -> Err (Exit.BP_RootNameDuplicate name p1 p2) - SBadImport _ -> + T.BB_SBadImport _ -> Ok () - SBadSyntax _ _ _ _ -> + T.BB_SBadSyntax _ _ _ _ -> Ok () - SForeign _ -> + T.BB_SForeign _ -> Ok () - SKernel -> + T.BB_SKernel -> Ok () @@ -923,7 +923,7 @@ checkInside name p1 status = -- COMPILE MODULE -compile : Env -> DocsNeed -> T.BED_Local -> String -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> IO T.BB_BResult +compile : Env -> T.BB_DocsNeed -> T.BED_Local -> String -> Dict String T.CEMN_Raw T.CEI_Interface -> T.CASTS_Module -> IO T.BB_BResult compile (Env key root projectType _ buildID _ _) docsNeed (T.BED_Local path time deps main lastChange _) source ifaces modul = let pkg : T.CEP_Name @@ -1166,25 +1166,21 @@ ignoreDocs = IgnoreDocs () -type DocsNeed - = DocsNeed Bool - - -toDocsNeed : DocsGoal a -> DocsNeed +toDocsNeed : DocsGoal a -> T.BB_DocsNeed toDocsNeed goal = case goal of IgnoreDocs _ -> - DocsNeed False + T.BB_DocsNeed False WriteDocs _ -> - DocsNeed True + T.BB_DocsNeed True KeepDocs _ -> - DocsNeed True + T.BB_DocsNeed True -makeDocs : DocsNeed -> Can.Module -> Result T.CRED_Error (Maybe T.CED_Module) -makeDocs (DocsNeed isNeeded) modul = +makeDocs : T.BB_DocsNeed -> Can.Module -> Result T.CRED_Error (Maybe T.CED_Module) +makeDocs (T.BB_DocsNeed isNeeded) modul = if isNeeded then case Docs.fromModule modul of Ok docs -> @@ -1267,13 +1263,13 @@ fromRepl root details source = deps = List.map Src.getImportName imports in - Utils.newMVar statusDictEncoder Dict.empty + Utils.newMVar_BB_StatusDict Dict.empty |> IO.bind (\mvar -> crawlDeps env mvar deps () |> IO.bind (\_ -> - IO.bind (Utils.mapTraverse identity compare (Utils.readMVar statusDecoder)) (Utils.readMVar statusDictDecoder mvar) + IO.bind (Utils.mapTraverse identity compare Utils.readMVar_BB_Status) (Utils.readMVar_BB_StatusDict mvar) |> IO.bind (\statuses -> checkMidpoint dmvar statuses @@ -1287,13 +1283,13 @@ fromRepl root details source = Utils.newEmptyMVar |> IO.bind (\rmvar -> - forkWithKey identity compare bResultEncoder (checkModule env foreigns rmvar) statuses + forkWithKey_BB_BResult identity compare (checkModule env foreigns rmvar) statuses |> IO.bind (\resultMVars -> Utils.putMVar resultDictEncoder rmvar resultMVars |> IO.bind (\_ -> - Utils.mapTraverse identity compare (Utils.readMVar bResultDecoder) resultMVars + Utils.mapTraverse identity compare Utils.readMVar_BB_BResult resultMVars |> IO.bind (\results -> writeDetails root details results @@ -1568,20 +1564,20 @@ type RootStatus | SOutsideErr T.CRE_Module -crawlRoot : Env -> T.MVar StatusDict -> RootLocation -> IO RootStatus +crawlRoot : Env -> T.MVar_BB_StatusDict -> RootLocation -> IO RootStatus crawlRoot ((Env _ _ projectType _ buildID _ _) as env) mvar root = case root of LInside name -> - Utils.newEmptyMVar + Utils.newEmptyMVar_BB_Status |> IO.bind (\statusMVar -> - Utils.takeMVar statusDictDecoder mvar + Utils.takeMVar_BB_StatusDict mvar |> IO.bind (\statusDict -> - Utils.putMVar statusDictEncoder mvar (Dict.insert identity name statusMVar statusDict) + Utils.putMVar_BB_StatusDict mvar (Dict.insert identity name statusMVar statusDict) |> IO.bind (\_ -> - IO.bind (Utils.putMVar statusEncoder statusMVar) (crawlModule env mvar (DocsNeed False) name) + IO.bind (Utils.putMVar_BB_Status statusMVar) (crawlModule env mvar (T.BB_DocsNeed False) name) |> IO.fmap (\_ -> SInside name) ) ) @@ -1699,7 +1695,7 @@ type Root | Outside T.CEMN_Raw T.CEI_Interface T.CASTO_LocalGraph -toArtifacts : Env -> Dependencies -> Dict String T.CEMN_Raw T.BB_BResult -> NE.Nonempty RootResult -> Result Exit.BuildProblem Artifacts +toArtifacts : Env -> T.BB_Dependencies -> Dict String T.CEMN_Raw T.BB_BResult -> NE.Nonempty RootResult -> Result Exit.BuildProblem Artifacts toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults = case gatherProblemsOrMains results rootResults of Err (NE.Nonempty e es) -> @@ -1809,208 +1805,9 @@ addOutside root modules = -- ENCODERS and DECODERS -dictRawMVarBResultEncoder : Dict String T.CEMN_Raw (T.MVar T.BB_BResult) -> Encode.Value +dictRawMVarBResultEncoder : Dict String T.CEMN_Raw T.MVar_BB_BResult -> Encode.Value dictRawMVarBResultEncoder = - E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder - - -bResultEncoder : T.BB_BResult -> Encode.Value -bResultEncoder bResult = - case bResult of - T.BB_RNew local iface objects docs -> - Encode.object - [ ( "type", Encode.string "RNew" ) - , ( "local", Details.localEncoder local ) - , ( "iface", I.interfaceEncoder iface ) - , ( "objects", Opt.localGraphEncoder objects ) - , ( "docs" - , docs - |> Maybe.map Docs.jsonModuleEncoder - |> Maybe.withDefault Encode.null - ) - ] - - T.BB_RSame local iface objects docs -> - Encode.object - [ ( "type", Encode.string "RSame" ) - , ( "local", Details.localEncoder local ) - , ( "iface", I.interfaceEncoder iface ) - , ( "objects", Opt.localGraphEncoder objects ) - , ( "docs", E.maybe Docs.jsonModuleEncoder docs ) - ] - - T.BB_RCached main lastChange (T.MVar ref) -> - Encode.object - [ ( "type", Encode.string "RCached" ) - , ( "main", Encode.bool main ) - , ( "lastChange", Encode.int lastChange ) - , ( "mvar", Encode.int ref ) - ] - - T.BB_RNotFound importProblem -> - Encode.object - [ ( "type", Encode.string "RNotFound" ) - , ( "importProblem", Import.problemEncoder importProblem ) - ] - - T.BB_RProblem e -> - Encode.object - [ ( "type", Encode.string "RProblem" ) - , ( "e", Error.moduleEncoder e ) - ] - - T.BB_RBlocked -> - Encode.object [ ( "type", Encode.string "RBlocked" ) ] - - T.BB_RForeign iface -> - Encode.object - [ ( "type", Encode.string "RForeign" ) - , ( "iface", I.interfaceEncoder iface ) - ] - - T.BB_RKernel -> - Encode.object [ ( "type", Encode.string "RKernel" ) ] - - -bResultDecoder : Decode.Decoder T.BB_BResult -bResultDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "RNew" -> - Decode.map4 T.BB_RNew - (Decode.field "local" Details.localDecoder) - (Decode.field "iface" I.interfaceDecoder) - (Decode.field "objects" Opt.localGraphDecoder) - (Decode.field "docs" (Decode.maybe Docs.jsonModuleDecoder)) - - "RSame" -> - Decode.map4 T.BB_RSame - (Decode.field "local" Details.localDecoder) - (Decode.field "iface" I.interfaceDecoder) - (Decode.field "objects" Opt.localGraphDecoder) - (Decode.field "docs" (Decode.maybe Docs.jsonModuleDecoder)) - - "RCached" -> - Decode.map3 T.BB_RCached - (Decode.field "main" Decode.bool) - (Decode.field "lastChange" Decode.int) - (Decode.field "mvar" (Decode.map T.MVar Decode.int)) - - "RNotFound" -> - Decode.map T.BB_RNotFound - (Decode.field "importProblem" Import.problemDecoder) - - "RProblem" -> - Decode.map T.BB_RProblem - (Decode.field "e" Error.moduleDecoder) - - "RBlocked" -> - Decode.succeed T.BB_RBlocked - - "RForeign" -> - Decode.map T.BB_RForeign - (Decode.field "iface" I.interfaceDecoder) - - "RKernel" -> - Decode.succeed T.BB_RKernel - - _ -> - Decode.fail ("Failed to decode BResult's type: " ++ type_) - ) - - -statusDictEncoder : StatusDict -> Encode.Value -statusDictEncoder statusDict = - E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder statusDict - - -statusDictDecoder : Decode.Decoder StatusDict -statusDictDecoder = - D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder - - -statusEncoder : Status -> Encode.Value -statusEncoder status = - case status of - SCached local -> - Encode.object - [ ( "type", Encode.string "SCached" ) - , ( "local", Details.localEncoder local ) - ] - - SChanged local iface objects docs -> - Encode.object - [ ( "type", Encode.string "SChanged" ) - , ( "local", Details.localEncoder local ) - , ( "iface", Encode.string iface ) - , ( "objects", Src.moduleEncoder objects ) - , ( "docs", docsNeedEncoder docs ) - ] - - SBadImport importProblem -> - Encode.object - [ ( "type", Encode.string "SBadImport" ) - , ( "importProblem", Import.problemEncoder importProblem ) - ] - - SBadSyntax path time source err -> - Encode.object - [ ( "type", Encode.string "SBadSyntax" ) - , ( "path", Encode.string path ) - , ( "time", File.timeEncoder time ) - , ( "source", Encode.string source ) - , ( "err", Syntax.errorEncoder err ) - ] - - SForeign home -> - Encode.object - [ ( "type", Encode.string "SForeign" ) - , ( "home", Pkg.nameEncoder home ) - ] - - SKernel -> - Encode.object - [ ( "type", Encode.string "SKernel" ) - ] - - -statusDecoder : Decode.Decoder Status -statusDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "SCached" -> - Decode.map SCached (Decode.field "local" Details.localDecoder) - - "SChanged" -> - Decode.map4 SChanged - (Decode.field "local" Details.localDecoder) - (Decode.field "iface" Decode.string) - (Decode.field "objects" Src.moduleDecoder) - (Decode.field "docs" docsNeedDecoder) - - "SBadImport" -> - Decode.map SBadImport (Decode.field "importProblem" Import.problemDecoder) - - "SBadSyntax" -> - Decode.map4 SBadSyntax - (Decode.field "path" Decode.string) - (Decode.field "time" File.timeDecoder) - (Decode.field "source" Decode.string) - (Decode.field "err" Syntax.errorDecoder) - - "SForeign" -> - Decode.map SForeign (Decode.field "home" Pkg.nameDecoder) - - "SKernel" -> - Decode.succeed SKernel - - _ -> - Decode.fail ("Failed to decode Status's type: " ++ type_) - ) + E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder_BB_BResult rootStatusEncoder : RootStatus -> Encode.Value @@ -2062,12 +1859,12 @@ rootStatusDecoder = resultDictEncoder : T.BB_ResultDict -> Encode.Value resultDictEncoder = - E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder + E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder_BB_BResult resultDictDecoder : Decode.Decoder T.BB_ResultDict resultDictDecoder = - D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder + D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder_BB_BResult rootResultEncoder : RootResult -> Encode.Value @@ -2145,11 +1942,6 @@ depDecoder = D.jsonPair ModuleName.rawDecoder I.interfaceDecoder -maybeDependenciesDecoder : Decode.Decoder (Maybe Dependencies) -maybeDependenciesDecoder = - Decode.maybe (D.assocListDict ModuleName.toComparableCanonical ModuleName.canonicalDecoder I.dependencyInterfaceDecoder) - - resultBuildProjectProblemRootInfoEncoder : Result Exit.BuildProjectProblem RootInfo -> Encode.Value resultBuildProjectProblemRootInfoEncoder = E.result Exit.buildProjectProblemEncoder rootInfoEncoder @@ -2200,16 +1992,6 @@ cachedInterfaceDecoder = ) -docsNeedEncoder : DocsNeed -> Encode.Value -docsNeedEncoder (DocsNeed isNeeded) = - Encode.bool isNeeded - - -docsNeedDecoder : Decode.Decoder DocsNeed -docsNeedDecoder = - Decode.map DocsNeed Decode.bool - - artifactsEncoder : Artifacts -> Encode.Value artifactsEncoder (Artifacts pkg ifaces roots modules) = Encode.object @@ -2230,12 +2012,12 @@ artifactsDecoder = (Decode.field "modules" (Decode.list moduleDecoder)) -dependenciesEncoder : Dependencies -> Encode.Value +dependenciesEncoder : T.BB_Dependencies -> Encode.Value dependenciesEncoder = E.assocListDict ModuleName.compareCanonical ModuleName.canonicalEncoder I.dependencyInterfaceEncoder -dependenciesDecoder : Decode.Decoder Dependencies +dependenciesDecoder : Decode.Decoder T.BB_Dependencies dependenciesDecoder = D.assocListDict ModuleName.toComparableCanonical ModuleName.canonicalDecoder I.dependencyInterfaceDecoder diff --git a/src/Builder/Deps/Bump.elm b/src/Builder/Deps/Bump.elm index c35f5e07b..32d717594 100644 --- a/src/Builder/Deps/Bump.elm +++ b/src/Builder/Deps/Bump.elm @@ -1,9 +1,9 @@ module Builder.Deps.Bump exposing (getPossibilities) -import Builder.Deps.Registry exposing (KnownVersions(..)) import Compiler.Elm.Magnitude as M import Compiler.Elm.Version as V import List.Extra +import Types as T import Utils.Main as Utils @@ -11,18 +11,18 @@ import Utils.Main as Utils -- GET POSSIBILITIES -getPossibilities : KnownVersions -> List ( V.Version, V.Version, M.Magnitude ) -getPossibilities (KnownVersions latest previous) = +getPossibilities : T.BDR_KnownVersions -> List ( T.CEV_Version, T.CEV_Version, M.Magnitude ) +getPossibilities (T.BDR_KnownVersions latest previous) = let - allVersions : List V.Version + allVersions : List T.CEV_Version allVersions = List.reverse (latest :: previous) - minorPoints : List V.Version + minorPoints : List T.CEV_Version minorPoints = List.filterMap List.Extra.last (Utils.listGroupBy sameMajor allVersions) - patchPoints : List V.Version + patchPoints : List T.CEV_Version patchPoints = List.filterMap List.Extra.last (Utils.listGroupBy sameMinor allVersions) in @@ -31,11 +31,11 @@ getPossibilities (KnownVersions latest previous) = ++ List.map (\v -> ( v, V.bumpPatch v, M.PATCH )) patchPoints -sameMajor : V.Version -> V.Version -> Bool -sameMajor (V.Version major1 _ _) (V.Version major2 _ _) = +sameMajor : T.CEV_Version -> T.CEV_Version -> Bool +sameMajor (T.CEV_Version major1 _ _) (T.CEV_Version major2 _ _) = major1 == major2 -sameMinor : V.Version -> V.Version -> Bool -sameMinor (V.Version major1 minor1 _) (V.Version major2 minor2 _) = +sameMinor : T.CEV_Version -> T.CEV_Version -> Bool +sameMinor (T.CEV_Version major1 minor1 _) (T.CEV_Version major2 minor2 _) = major1 == major2 && minor1 == minor2 diff --git a/src/Builder/Deps/Diff.elm b/src/Builder/Deps/Diff.elm index b0b69b3ae..749adb2e4 100644 --- a/src/Builder/Deps/Diff.elm +++ b/src/Builder/Deps/Diff.elm @@ -17,7 +17,7 @@ import Builder.Stuff as Stuff import Compiler.Data.Name as Name import Compiler.Elm.Docs as Docs import Compiler.Elm.Magnitude as M -import Compiler.Elm.Version as V exposing (Version) +import Compiler.Elm.Version as V import Compiler.Json.Decode as D import Data.Map as Dict exposing (Dict) import Data.Set as EverySet @@ -328,7 +328,7 @@ categorizeVar name = -- MAGNITUDE -bump : PackageChanges -> Version -> Version +bump : PackageChanges -> T.CEV_Version -> T.CEV_Version bump changes version = case toMagnitude changes of M.PATCH -> @@ -393,7 +393,7 @@ changeMagnitude (Changes added changed removed) = -- GET DOCS -getDocs : Stuff.PackageCache -> Http.Manager -> T.CEP_Name -> V.Version -> IO (Result Exit.DocsProblem Docs.Documentation) +getDocs : T.BS_PackageCache -> T.BH_Manager -> T.CEP_Name -> T.CEV_Version -> IO (Result Exit.DocsProblem Docs.Documentation) getDocs cache manager name version = let home : String diff --git a/src/Builder/Deps/Registry.elm b/src/Builder/Deps/Registry.elm index 7c7584fa6..6518f0d06 100644 --- a/src/Builder/Deps/Registry.elm +++ b/src/Builder/Deps/Registry.elm @@ -1,7 +1,5 @@ module Builder.Deps.Registry exposing - ( KnownVersions(..) - , Registry(..) - , fetch + ( fetch , getVersions , getVersions_ , latest @@ -15,7 +13,6 @@ import Basics.Extra exposing (flip) import Builder.Deps.Website as Website import Builder.File as File import Builder.Http as Http -import Builder.Reporting.Exit as Exit import Builder.Stuff as Stuff import Compiler.Elm.Package as Pkg import Compiler.Elm.Version as V @@ -33,23 +30,15 @@ import Types as T -- REGISTRY -type Registry - = Registry Int (Dict ( String, String ) T.CEP_Name KnownVersions) - - -type KnownVersions - = KnownVersions V.Version (List V.Version) - - -knownVersionsDecoder : Decode.Decoder KnownVersions +knownVersionsDecoder : Decode.Decoder T.BDR_KnownVersions knownVersionsDecoder = - Decode.map2 KnownVersions + Decode.map2 T.BDR_KnownVersions (Decode.field "version" V.jsonDecoder) (Decode.field "versions" (Decode.list V.jsonDecoder)) -knownVersionsEncoder : KnownVersions -> Encode.Value -knownVersionsEncoder (KnownVersions version versions) = +knownVersionsEncoder : T.BDR_KnownVersions -> Encode.Value +knownVersionsEncoder (T.BDR_KnownVersions version versions) = Encode.object [ ( "version", V.jsonEncoder version ) , ( "versions", Encode.list V.jsonEncoder versions ) @@ -60,7 +49,7 @@ knownVersionsEncoder (KnownVersions version versions) = -- READ -read : Stuff.PackageCache -> IO (Maybe Registry) +read : T.BS_PackageCache -> IO (Maybe T.BDR_Registry) read cache = File.readBinary registryDecoder (Stuff.registry cache) @@ -69,7 +58,7 @@ read cache = -- FETCH -fetch : Http.Manager -> Stuff.PackageCache -> IO (Result Exit.RegistryProblem Registry) +fetch : T.BH_Manager -> T.BS_PackageCache -> IO (Result T.BRE_RegistryProblem T.BDR_Registry) fetch manager cache = post manager "/all-packages" allPkgsDecoder <| \versions -> @@ -78,9 +67,9 @@ fetch manager cache = size = Dict.foldr Pkg.compareName (\_ -> addEntry) 0 versions - registry : Registry + registry : T.BDR_Registry registry = - Registry size versions + T.BDR_Registry size versions path : String path = @@ -90,27 +79,27 @@ fetch manager cache = |> IO.fmap (\_ -> registry) -addEntry : KnownVersions -> Int -> Int -addEntry (KnownVersions _ vs) count = +addEntry : T.BDR_KnownVersions -> Int -> Int +addEntry (T.BDR_KnownVersions _ vs) count = count + 1 + List.length vs -allPkgsDecoder : D.Decoder () (Dict ( String, String ) T.CEP_Name KnownVersions) +allPkgsDecoder : D.Decoder () (Dict ( String, String ) T.CEP_Name T.BDR_KnownVersions) allPkgsDecoder = let keyDecoder : D.KeyDecoder () T.CEP_Name keyDecoder = Pkg.keyDecoder bail - versionsDecoder : D.Decoder () (List V.Version) + versionsDecoder : D.Decoder () (List T.CEV_Version) versionsDecoder = D.list (D.mapError (\_ -> ()) V.decoder) - toKnownVersions : List V.Version -> D.Decoder () KnownVersions + toKnownVersions : List T.CEV_Version -> D.Decoder () T.BDR_KnownVersions toKnownVersions versions = case List.sortWith (flip V.compare) versions of v :: vs -> - D.pure (KnownVersions v vs) + D.pure (T.BDR_KnownVersions v vs) [] -> D.failure () @@ -122,8 +111,8 @@ allPkgsDecoder = -- UPDATE -update : Http.Manager -> Stuff.PackageCache -> Registry -> IO (Result Exit.RegistryProblem Registry) -update manager cache ((Registry size packages) as oldRegistry) = +update : T.BH_Manager -> T.BS_PackageCache -> T.BDR_Registry -> IO (Result T.BRE_RegistryProblem T.BDR_Registry) +update manager cache ((T.BDR_Registry size packages) as oldRegistry) = post manager ("/all-packages/since/" ++ String.fromInt size) (D.list newPkgDecoder) <| \news -> case news of @@ -136,29 +125,29 @@ update manager cache ((Registry size packages) as oldRegistry) = newSize = size + List.length news - newPkgs : Dict ( String, String ) T.CEP_Name KnownVersions + newPkgs : Dict ( String, String ) T.CEP_Name T.BDR_KnownVersions newPkgs = List.foldr addNew packages news - newRegistry : Registry + newRegistry : T.BDR_Registry newRegistry = - Registry newSize newPkgs + T.BDR_Registry newSize newPkgs in File.writeBinary registryEncoder (Stuff.registry cache) newRegistry |> IO.fmap (\_ -> newRegistry) -addNew : ( T.CEP_Name, V.Version ) -> Dict ( String, String ) T.CEP_Name KnownVersions -> Dict ( String, String ) T.CEP_Name KnownVersions +addNew : ( T.CEP_Name, T.CEV_Version ) -> Dict ( String, String ) T.CEP_Name T.BDR_KnownVersions -> Dict ( String, String ) T.CEP_Name T.BDR_KnownVersions addNew ( name, version ) versions = let - add : Maybe KnownVersions -> KnownVersions + add : Maybe T.BDR_KnownVersions -> T.BDR_KnownVersions add maybeKnowns = case maybeKnowns of - Just (KnownVersions v vs) -> - KnownVersions version (v :: vs) + Just (T.BDR_KnownVersions v vs) -> + T.BDR_KnownVersions version (v :: vs) Nothing -> - KnownVersions version [] + T.BDR_KnownVersions version [] in Dict.update identity name (Just << add) versions @@ -167,12 +156,12 @@ addNew ( name, version ) versions = -- NEW PACKAGE DECODER -newPkgDecoder : D.Decoder () ( T.CEP_Name, V.Version ) +newPkgDecoder : D.Decoder () ( T.CEP_Name, T.CEV_Version ) newPkgDecoder = D.customString newPkgParser bail -newPkgParser : P.Parser () ( T.CEP_Name, V.Version ) +newPkgParser : P.Parser () ( T.CEP_Name, T.CEV_Version ) newPkgParser = P.specialize (\_ _ _ -> ()) Pkg.parser |> P.bind @@ -192,7 +181,7 @@ bail _ _ = -- LATEST -latest : Http.Manager -> Stuff.PackageCache -> IO (Result Exit.RegistryProblem Registry) +latest : T.BH_Manager -> T.BS_PackageCache -> IO (Result T.BRE_RegistryProblem T.BDR_Registry) latest manager cache = read cache |> IO.bind @@ -210,13 +199,13 @@ latest manager cache = -- GET VERSIONS -getVersions : T.CEP_Name -> Registry -> Maybe KnownVersions -getVersions name (Registry _ versions) = +getVersions : T.CEP_Name -> T.BDR_Registry -> Maybe T.BDR_KnownVersions +getVersions name (T.BDR_Registry _ versions) = Dict.get identity name versions -getVersions_ : T.CEP_Name -> Registry -> Result (List T.CEP_Name) KnownVersions -getVersions_ name (Registry _ versions) = +getVersions_ : T.CEP_Name -> T.BDR_Registry -> Result (List T.CEP_Name) T.BDR_KnownVersions +getVersions_ name (T.BDR_Registry _ versions) = case Dict.get identity name versions of Just kvs -> Ok kvs @@ -229,36 +218,36 @@ getVersions_ name (Registry _ versions) = -- POST -post : Http.Manager -> String -> D.Decoder x a -> (a -> IO b) -> IO (Result Exit.RegistryProblem b) +post : T.BH_Manager -> String -> D.Decoder x a -> (a -> IO b) -> IO (Result T.BRE_RegistryProblem b) post manager path decoder callback = let url : String url = Website.route path [] in - Http.post manager url [] Exit.RP_Http <| + Http.post manager url [] T.BRE_RP_Http <| \body -> case D.fromByteString decoder body of Ok a -> IO.fmap Ok (callback a) Err _ -> - IO.pure <| Err <| Exit.RP_Data url body + IO.pure <| Err <| T.BRE_RP_Data url body -- ENCODERS and DECODERS -registryDecoder : Decode.Decoder Registry +registryDecoder : Decode.Decoder T.BDR_Registry registryDecoder = - Decode.map2 Registry + Decode.map2 T.BDR_Registry (Decode.field "size" Decode.int) (Decode.field "packages" (D.assocListDict identity Pkg.nameDecoder knownVersionsDecoder)) -registryEncoder : Registry -> Encode.Value -registryEncoder (Registry size versions) = +registryEncoder : T.BDR_Registry -> Encode.Value +registryEncoder (T.BDR_Registry size versions) = Encode.object [ ( "size", Encode.int size ) , ( "packages", E.assocListDict Pkg.compareName Pkg.nameEncoder knownVersionsEncoder versions ) diff --git a/src/Builder/Deps/Solver.elm b/src/Builder/Deps/Solver.elm index d363278c5..84786fc16 100644 --- a/src/Builder/Deps/Solver.elm +++ b/src/Builder/Deps/Solver.elm @@ -1,8 +1,6 @@ module Builder.Deps.Solver exposing ( AppSolution(..) - , Connection(..) , Details(..) - , Env(..) , Solver , SolverResult(..) , State @@ -48,18 +46,13 @@ type InnerSolver a type State - = State Stuff.PackageCache Connection Registry.Registry (Dict ( ( String, String ), ( Int, Int, Int ) ) ( T.CEP_Name, V.Version ) Constraints) + = State T.BS_PackageCache T.BDS_Connection T.BDR_Registry (Dict ( ( String, String ), ( Int, Int, Int ) ) ( T.CEP_Name, T.CEV_Version ) Constraints) type Constraints = Constraints C.Constraint (Dict ( String, String ) T.CEP_Name C.Constraint) -type Connection - = Online Http.Manager - | Offline - - -- RESULT @@ -76,10 +69,10 @@ type SolverResult a type Details - = Details V.Version (Dict ( String, String ) T.CEP_Name C.Constraint) + = Details T.CEV_Version (Dict ( String, String ) T.CEP_Name C.Constraint) -verify : Stuff.PackageCache -> Connection -> Registry.Registry -> Dict ( String, String ) T.CEP_Name C.Constraint -> IO (SolverResult (Dict ( String, String ) T.CEP_Name Details)) +verify : T.BS_PackageCache -> T.BDS_Connection -> T.BDR_Registry -> Dict ( String, String ) T.CEP_Name C.Constraint -> IO (SolverResult (Dict ( String, String ) T.CEP_Name Details)) verify cache connection registry constraints = Stuff.withRegistryLock cache <| case try constraints of @@ -99,7 +92,7 @@ verify cache connection registry constraints = ) -addDeps : State -> T.CEP_Name -> V.Version -> Details +addDeps : State -> T.CEP_Name -> T.CEV_Version -> Details addDeps (State _ _ _ constraints) name vsn = case Dict.get (Tuple.mapSecond V.toComparable) ( name, vsn ) constraints of Just (Constraints _ deps) -> @@ -109,13 +102,13 @@ addDeps (State _ _ _ constraints) name vsn = crash "compiler bug manifesting in Deps.Solver.addDeps" -noSolution : Connection -> SolverResult a +noSolution : T.BDS_Connection -> SolverResult a noSolution connection = case connection of - Online _ -> + T.BDS_Online _ -> NoSolution - Offline -> + T.BDS_Offline -> NoOfflineSolution @@ -124,26 +117,26 @@ noSolution connection = type AppSolution - = AppSolution (Dict ( String, String ) T.CEP_Name V.Version) (Dict ( String, String ) T.CEP_Name V.Version) Outline.AppOutline + = AppSolution (Dict ( String, String ) T.CEP_Name T.CEV_Version) (Dict ( String, String ) T.CEP_Name T.CEV_Version) Outline.AppOutline -addToApp : Stuff.PackageCache -> Connection -> Registry.Registry -> T.CEP_Name -> Outline.AppOutline -> IO (SolverResult AppSolution) +addToApp : T.BS_PackageCache -> T.BDS_Connection -> T.BDR_Registry -> T.CEP_Name -> Outline.AppOutline -> IO (SolverResult AppSolution) addToApp cache connection registry pkg ((Outline.AppOutline _ _ direct indirect testDirect testIndirect) as outline) = Stuff.withRegistryLock cache <| let - allIndirects : Dict ( String, String ) T.CEP_Name V.Version + allIndirects : Dict ( String, String ) T.CEP_Name T.CEV_Version allIndirects = Dict.union indirect testIndirect - allDirects : Dict ( String, String ) T.CEP_Name V.Version + allDirects : Dict ( String, String ) T.CEP_Name T.CEV_Version allDirects = Dict.union direct testDirect - allDeps : Dict ( String, String ) T.CEP_Name V.Version + allDeps : Dict ( String, String ) T.CEP_Name T.CEV_Version allDeps = Dict.union allDirects allIndirects - attempt : (a -> C.Constraint) -> Dict ( String, String ) T.CEP_Name a -> Solver (Dict ( String, String ) T.CEP_Name V.Version) + attempt : (a -> C.Constraint) -> Dict ( String, String ) T.CEP_Name a -> Solver (Dict ( String, String ) T.CEP_Name T.CEV_Version) attempt toConstraint deps = try (Dict.insert identity pkg C.anything (Dict.map (\_ -> toConstraint) deps)) in @@ -172,29 +165,29 @@ addToApp cache connection registry pkg ((Outline.AppOutline _ _ direct indirect ) -toApp : State -> T.CEP_Name -> Outline.AppOutline -> Dict ( String, String ) T.CEP_Name V.Version -> Dict ( String, String ) T.CEP_Name V.Version -> AppSolution +toApp : State -> T.CEP_Name -> Outline.AppOutline -> Dict ( String, String ) T.CEP_Name T.CEV_Version -> Dict ( String, String ) T.CEP_Name T.CEV_Version -> AppSolution toApp (State _ _ _ constraints) pkg (Outline.AppOutline elm srcDirs direct _ testDirect _) old new = let - d : Dict ( String, String ) T.CEP_Name V.Version + d : Dict ( String, String ) T.CEP_Name T.CEV_Version d = Dict.intersection Pkg.compareName new (Dict.insert identity pkg V.one direct) - i : Dict ( String, String ) T.CEP_Name V.Version + i : Dict ( String, String ) T.CEP_Name T.CEV_Version i = Dict.diff (getTransitive constraints new (Dict.toList compare d) Dict.empty) d - td : Dict ( String, String ) T.CEP_Name V.Version + td : Dict ( String, String ) T.CEP_Name T.CEV_Version td = Dict.intersection Pkg.compareName new (Dict.remove identity pkg testDirect) - ti : Dict ( String, String ) T.CEP_Name V.Version + ti : Dict ( String, String ) T.CEP_Name T.CEV_Version ti = Dict.diff new (Utils.mapUnions [ d, i, td ]) in AppSolution old new (Outline.AppOutline elm srcDirs d i td ti) -getTransitive : Dict ( ( String, String ), ( Int, Int, Int ) ) ( T.CEP_Name, V.Version ) Constraints -> Dict ( String, String ) T.CEP_Name V.Version -> List ( T.CEP_Name, V.Version ) -> Dict ( String, String ) T.CEP_Name V.Version -> Dict ( String, String ) T.CEP_Name V.Version +getTransitive : Dict ( ( String, String ), ( Int, Int, Int ) ) ( T.CEP_Name, T.CEV_Version ) Constraints -> Dict ( String, String ) T.CEP_Name T.CEV_Version -> List ( T.CEP_Name, T.CEV_Version ) -> Dict ( String, String ) T.CEP_Name T.CEV_Version -> Dict ( String, String ) T.CEP_Name T.CEV_Version getTransitive constraints solution unvisited visited = case unvisited of [] -> @@ -209,11 +202,11 @@ getTransitive constraints solution unvisited visited = (Constraints _ newDeps) = Utils.find (Tuple.mapSecond V.toComparable) info constraints - newUnvisited : List ( T.CEP_Name, V.Version ) + newUnvisited : List ( T.CEP_Name, T.CEV_Version ) newUnvisited = Dict.toList compare (Dict.intersection Pkg.compareName solution (Dict.diff newDeps visited)) - newVisited : Dict ( String, String ) T.CEP_Name V.Version + newVisited : Dict ( String, String ) T.CEP_Name T.CEV_Version newVisited = Dict.insert identity pkg vsn visited in @@ -225,7 +218,7 @@ getTransitive constraints solution unvisited visited = -- TRY -try : Dict ( String, String ) T.CEP_Name C.Constraint -> Solver (Dict ( String, String ) T.CEP_Name V.Version) +try : Dict ( String, String ) T.CEP_Name C.Constraint -> Solver (Dict ( String, String ) T.CEP_Name T.CEV_Version) try constraints = exploreGoals (Goals constraints Dict.empty) @@ -235,10 +228,10 @@ try constraints = type Goals - = Goals (Dict ( String, String ) T.CEP_Name C.Constraint) (Dict ( String, String ) T.CEP_Name V.Version) + = Goals (Dict ( String, String ) T.CEP_Name C.Constraint) (Dict ( String, String ) T.CEP_Name T.CEV_Version) -exploreGoals : Goals -> Solver (Dict ( String, String ) T.CEP_Name V.Version) +exploreGoals : Goals -> Solver (Dict ( String, String ) T.CEP_Name T.CEV_Version) exploreGoals (Goals pending solved) = let compare : ( T.CEP_Name, C.Constraint ) -> T.CEP_Name @@ -255,7 +248,7 @@ exploreGoals (Goals pending solved) = goals1 = Goals otherPending solved - addVsn : V.Version -> Solver Goals + addVsn : T.CEV_Version -> Solver Goals addVsn = addVersion goals1 name in @@ -264,7 +257,7 @@ exploreGoals (Goals pending solved) = |> bind (\goals2 -> exploreGoals goals2) -addVersion : Goals -> T.CEP_Name -> V.Version -> Solver Goals +addVersion : Goals -> T.CEP_Name -> T.CEV_Version -> Solver Goals addVersion (Goals pending solved) name version = getConstraints name version |> bind @@ -281,7 +274,7 @@ addVersion (Goals pending solved) name version = ) -addConstraint : Dict ( String, String ) T.CEP_Name V.Version -> Dict ( String, String ) T.CEP_Name C.Constraint -> ( T.CEP_Name, C.Constraint ) -> Solver (Dict ( String, String ) T.CEP_Name C.Constraint) +addConstraint : Dict ( String, String ) T.CEP_Name T.CEV_Version -> Dict ( String, String ) T.CEP_Name C.Constraint -> ( T.CEP_Name, C.Constraint ) -> Solver (Dict ( String, String ) T.CEP_Name C.Constraint) addConstraint solved unsolved ( name, newConstraint ) = case Dict.get identity name solved of Just version -> @@ -313,12 +306,12 @@ addConstraint solved unsolved ( name, newConstraint ) = -- GET RELEVANT VERSIONS -getRelevantVersions : T.CEP_Name -> C.Constraint -> Solver ( V.Version, List V.Version ) +getRelevantVersions : T.CEP_Name -> C.Constraint -> Solver ( T.CEV_Version, List T.CEV_Version ) getRelevantVersions name constraint = Solver <| \((State _ _ registry _) as state) -> case Registry.getVersions name registry of - Just (Registry.KnownVersions newest previous) -> + Just (T.BDR_KnownVersions newest previous) -> case List.filter (C.satisfies constraint) (newest :: previous) of [] -> IO.pure (ISBack state) @@ -334,12 +327,12 @@ getRelevantVersions name constraint = -- GET CONSTRAINTS -getConstraints : T.CEP_Name -> V.Version -> Solver Constraints +getConstraints : T.CEP_Name -> T.CEV_Version -> Solver Constraints getConstraints pkg vsn = Solver <| \((State cache connection registry cDict) as state) -> let - key : ( T.CEP_Name, V.Version ) + key : ( T.CEP_Name, T.CEV_Version ) key = ( pkg, vsn ) in @@ -371,10 +364,10 @@ getConstraints pkg vsn = case D.fromByteString constraintsDecoder bytes of Ok cs -> case connection of - Online _ -> + T.BDS_Online _ -> IO.pure (ISOk (toNewState cs) cs) - Offline -> + T.BDS_Offline -> Utils.dirDoesDirectoryExist (Stuff.package cache pkg vsn ++ "/src") |> IO.fmap (\srcExists -> @@ -392,10 +385,10 @@ getConstraints pkg vsn = else case connection of - Offline -> + T.BDS_Offline -> IO.pure (ISBack state) - Online manager -> + T.BDS_Online manager -> let url : String url = @@ -439,11 +432,7 @@ constraintsDecoder = -- ENVIRONMENT -type Env - = Env Stuff.PackageCache Http.Manager Connection Registry.Registry - - -initEnv : IO (Result Exit.RegistryProblem Env) +initEnv : IO (Result T.BRE_RegistryProblem T.BDS_Env) initEnv = Utils.newEmptyMVar |> IO.bind @@ -468,7 +457,7 @@ initEnv = (\eitherRegistry -> case eitherRegistry of Ok latestRegistry -> - Ok <| Env cache manager (Online manager) latestRegistry + Ok <| T.BDS_Env cache manager (T.BDS_Online manager) latestRegistry Err problem -> Err problem @@ -480,10 +469,10 @@ initEnv = (\eitherRegistry -> case eitherRegistry of Ok latestRegistry -> - Ok <| Env cache manager (Online manager) latestRegistry + Ok <| T.BDS_Env cache manager (T.BDS_Online manager) latestRegistry Err _ -> - Ok <| Env cache manager Offline cachedRegistry + Ok <| T.BDS_Env cache manager T.BDS_Offline cachedRegistry ) ) ) @@ -586,8 +575,8 @@ foldM f b = -- ENCODERS and DECODERS -envEncoder : Env -> Encode.Value -envEncoder (Env cache manager connection registry) = +envEncoder : T.BDS_Env -> Encode.Value +envEncoder (T.BDS_Env cache manager connection registry) = Encode.object [ ( "cache", Stuff.packageCacheEncoder cache ) , ( "manager", Http.managerEncoder manager ) @@ -596,41 +585,41 @@ envEncoder (Env cache manager connection registry) = ] -envDecoder : Decode.Decoder Env +envDecoder : Decode.Decoder T.BDS_Env envDecoder = - Decode.map4 Env + Decode.map4 T.BDS_Env (Decode.field "cache" Stuff.packageCacheDecoder) (Decode.field "manager" Http.managerDecoder) (Decode.field "connection" connectionDecoder) (Decode.field "registry" Registry.registryDecoder) -connectionEncoder : Connection -> Encode.Value +connectionEncoder : T.BDS_Connection -> Encode.Value connectionEncoder connection = case connection of - Online manager -> + T.BDS_Online manager -> Encode.object [ ( "type", Encode.string "Online" ) , ( "manager", Http.managerEncoder manager ) ] - Offline -> + T.BDS_Offline -> Encode.object [ ( "type", Encode.string "Offline" ) ] -connectionDecoder : Decode.Decoder Connection +connectionDecoder : Decode.Decoder T.BDS_Connection connectionDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Online" -> - Decode.map Online (Decode.field "manager" Http.managerDecoder) + Decode.map T.BDS_Online (Decode.field "manager" Http.managerDecoder) "Offline" -> - Decode.succeed Offline + Decode.succeed T.BDS_Offline _ -> Decode.fail ("Failed to decode Connection's type: " ++ type_) diff --git a/src/Builder/Deps/Website.elm b/src/Builder/Deps/Website.elm index da53d834b..fe716d107 100644 --- a/src/Builder/Deps/Website.elm +++ b/src/Builder/Deps/Website.elm @@ -19,6 +19,6 @@ route path params = Http.toUrl (domain ++ path) params -metadata : T.CEP_Name -> V.Version -> String -> String +metadata : T.CEP_Name -> T.CEV_Version -> String -> String metadata name version file = domain ++ "/packages/" ++ Pkg.toUrl name ++ "/" ++ V.toChars version ++ "/" ++ file diff --git a/src/Builder/Elm/Details.elm b/src/Builder/Elm/Details.elm index 4f236a74d..892235a09 100644 --- a/src/Builder/Elm/Details.elm +++ b/src/Builder/Elm/Details.elm @@ -14,7 +14,6 @@ module Builder.Elm.Details exposing ) import Builder.BackgroundWriter as BW -import Builder.Deps.Registry as Registry import Builder.Deps.Solver as Solver import Builder.Deps.Website as Website import Builder.Elm.Outline as Outline @@ -61,7 +60,7 @@ type Details type ValidOutline = ValidApp (NE.Nonempty Outline.SrcDir) - | ValidPkg T.CEP_Name (List T.CEMN_Raw) (Dict ( String, String ) T.CEP_Name V.Version {- for docs in reactor -}) + | ValidPkg T.CEP_Name (List T.CEMN_Raw) (Dict ( String, String ) T.CEP_Name T.CEV_Version {- for docs in reactor -}) type Foreign @@ -74,14 +73,14 @@ type Extras type alias Interfaces = - Dict (List String) T.CEMN_Canonical I.DependencyInterface + Dict (List String) T.CEMN_Canonical T.CEI_DependencyInterface -- LOAD ARTIFACTS -loadObjects : T.FilePath -> Details -> IO (T.MVar (Maybe T.CASTO_GlobalGraph)) +loadObjects : T.FilePath -> Details -> IO T.MVar_Maybe_CASTO_GlobalGraph loadObjects root (Details _ _ _ _ _ extras) = case extras of ArtifactsFresh _ o -> @@ -91,22 +90,22 @@ loadObjects root (Details _ _ _ _ _ extras) = fork_Maybe_CASTO_GlobalGraph (File.readBinary Opt.globalGraphDecoder (Stuff.objects root)) -loadInterfaces : T.FilePath -> Details -> IO (T.MVar (Maybe Interfaces)) +loadInterfaces : T.FilePath -> Details -> IO T.MVar_Maybe_BB_Dependencies loadInterfaces root (Details _ _ _ _ _ extras) = case extras of ArtifactsFresh i _ -> - Utils.newMVar (Utils.maybeEncoder interfacesEncoder) (Just i) + Utils.newMVar_Maybe_BB_Dependencies (Just i) ArtifactsCached -> - fork (Utils.maybeEncoder interfacesEncoder) (File.readBinary interfacesDecoder (Stuff.interfaces root)) + fork_Maybe_BB_Dependencies (File.readBinary interfacesDecoder (Stuff.interfaces root)) -- VERIFY INSTALL -- used by Install -verifyInstall : BW.Scope -> T.FilePath -> Solver.Env -> Outline.Outline -> IO (Result Exit.Details ()) -verifyInstall scope root (Solver.Env cache manager connection registry) outline = +verifyInstall : BW.Scope -> T.FilePath -> T.BDS_Env -> Outline.Outline -> IO (Result Exit.Details ()) +verifyInstall scope root (T.BDS_Env cache manager connection registry) outline = File.getTime (root ++ "/elm.json") |> IO.bind (\time -> @@ -185,12 +184,12 @@ generate style scope root time = type Env - = Env Reporting.DKey BW.Scope T.FilePath Stuff.PackageCache Http.Manager Solver.Connection Registry.Registry + = Env Reporting.DKey BW.Scope T.FilePath T.BS_PackageCache T.BH_Manager T.BDS_Connection T.BDR_Registry initEnv : Reporting.DKey -> BW.Scope -> T.FilePath -> IO (Result Exit.Details ( Env, Outline.Outline )) initEnv key scope root = - fork resultRegistryProblemEnvEncoder Solver.initEnv + fork_ResultRegistryProblemEnv Solver.initEnv |> IO.bind (\mvar -> Outline.read root @@ -201,14 +200,14 @@ initEnv key scope root = IO.pure (Err (Exit.DetailsBadOutline problem)) Ok outline -> - Utils.readMVar resultRegistryProblemEnvDecoder mvar + Utils.readMVar_ResultRegistryProblemEnv mvar |> IO.fmap (\maybeEnv -> case maybeEnv of Err problem -> Err (Exit.DetailsCannotGetRegistry problem) - Ok (Solver.Env cache manager connection registry) -> + Ok (T.BDS_Env cache manager connection registry) -> Ok ( Env key scope root cache manager connection registry, outline ) ) ) @@ -235,7 +234,7 @@ verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect elm) exposedList = Outline.flattenExposed exposed - exactDeps : Dict ( String, String ) T.CEP_Name V.Version + exactDeps : Dict ( String, String ) T.CEP_Name T.CEV_Version exactDeps = Dict.map (\_ (Solver.Details v _) -> v) solution @@ -269,7 +268,7 @@ verifyApp env time ((Outline.AppOutline elmVersion srcDirs direct _ _ _) as outl Task.throw (Exit.DetailsBadElmInAppOutline elmVersion) -checkAppDeps : Outline.AppOutline -> Task (Dict ( String, String ) T.CEP_Name V.Version) +checkAppDeps : Outline.AppOutline -> Task (Dict ( String, String ) T.CEP_Name T.CEV_Version) checkAppDeps (Outline.AppOutline _ _ direct indirect testDirect testIndirect) = union identity Pkg.compareName allowEqualDups indirect testDirect |> Task.bind @@ -339,27 +338,27 @@ allowEqualDups _ v1 v2 = -- FORK -fork : (a -> Encode.Value) -> IO a -> IO (T.MVar a) -fork encoder work = - Utils.newEmptyMVar +fork_Maybe_BED_Status : IO (Maybe T.BED_Status) -> IO T.MVar_Maybe_BED_Status +fork_Maybe_BED_Status work = + Utils.newEmptyMVar_Maybe_BED_Status |> IO.bind (\mvar -> - Utils.forkIO (IO.bind (Utils.putMVar encoder mvar) work) + Utils.forkIO (IO.bind (Utils.putMVar_Maybe_BED_Status mvar) work) |> IO.fmap (\_ -> mvar) ) -fork_Maybe_BED_Status : IO (Maybe T.BED_Status) -> IO (T.MVar (Maybe T.BED_Status)) -fork_Maybe_BED_Status work = - Utils.newEmptyMVar_Maybe_BED_Status +fork_Maybe_BED_DResult : IO (Maybe T.BED_DResult) -> IO T.MVar_Maybe_BED_DResult +fork_Maybe_BED_DResult work = + Utils.newEmptyMVar_Maybe_BED_DResult |> IO.bind (\mvar -> - Utils.forkIO (IO.bind (Utils.putMVar_Maybe_BED_Status mvar) work) + Utils.forkIO (IO.bind (Utils.putMVar_Maybe_BED_DResult mvar) work) |> IO.fmap (\_ -> mvar) ) -fork_Maybe_CASTO_GlobalGraph : IO (Maybe T.CASTO_GlobalGraph) -> IO (T.MVar (Maybe T.CASTO_GlobalGraph)) +fork_Maybe_CASTO_GlobalGraph : IO (Maybe T.CASTO_GlobalGraph) -> IO T.MVar_Maybe_CASTO_GlobalGraph fork_Maybe_CASTO_GlobalGraph work = Utils.newEmptyMVar_Maybe_CASTO_GlobalGraph |> IO.bind @@ -369,6 +368,36 @@ fork_Maybe_CASTO_GlobalGraph work = ) +fork_ResultRegistryProblemEnv : IO (Result T.BRE_RegistryProblem T.BDS_Env) -> IO T.MVar_ResultRegistryProblemEnv +fork_ResultRegistryProblemEnv work = + Utils.newEmptyMVar_ResultRegistryProblemEnv + |> IO.bind + (\mvar -> + Utils.forkIO (IO.bind (Utils.putMVar_ResultRegistryProblemEnv mvar) work) + |> IO.fmap (\_ -> mvar) + ) + + +fork_CED_Dep : IO T.CED_Dep -> IO T.MVar_CED_Dep +fork_CED_Dep work = + Utils.newEmptyMVar_CED_Dep + |> IO.bind + (\mvar -> + Utils.forkIO (IO.bind (Utils.putMVar_CED_Dep mvar) work) + |> IO.fmap (\_ -> mvar) + ) + + +fork_Maybe_BB_Dependencies : IO (Maybe T.BB_Dependencies) -> IO T.MVar_Maybe_BB_Dependencies +fork_Maybe_BB_Dependencies work = + Utils.newEmptyMVar_Maybe_BB_Dependencies + |> IO.bind + (\mvar -> + Utils.forkIO (IO.bind (Utils.putMVar_Maybe_BB_Dependencies mvar) work) + |> IO.fmap (\_ -> mvar) + ) + + -- VERIFY DEPENDENCIES @@ -381,13 +410,13 @@ verifyDependencies ((Env key scope root cache _ _ _) as env) time outline soluti |> IO.bind (\mvar -> Stuff.withRegistryLock cache - (Utils.mapTraverseWithKey identity Pkg.compareName (\k v -> fork depEncoder (verifyDep env mvar solution k v)) solution) + (Utils.mapTraverseWithKey identity Pkg.compareName (\k v -> fork_CED_Dep (verifyDep env mvar solution k v)) solution) |> IO.bind (\mvars -> Utils.putMVar dictNameMVarDepEncoder mvar mvars |> IO.bind (\_ -> - Utils.mapTraverse identity Pkg.compareName (Utils.readMVar depDecoder) mvars + Utils.mapTraverse identity Pkg.compareName Utils.readMVar_CED_Dep mvars |> IO.bind (\deps -> case Utils.sequenceDictResult identity Pkg.compareName deps of @@ -430,13 +459,13 @@ verifyDependencies ((Env key scope root cache _ _ _) as env) time outline soluti ) -addObjects : Artifacts -> T.CASTO_GlobalGraph -> T.CASTO_GlobalGraph -addObjects (Artifacts _ objs) graph = +addObjects : T.CED_Artifacts -> T.CASTO_GlobalGraph -> T.CASTO_GlobalGraph +addObjects (T.CED_Artifacts _ objs) graph = Opt.addGlobalGraph objs graph -addInterfaces : Dict ( String, String ) T.CEP_Name a -> T.CEP_Name -> Artifacts -> Interfaces -> Interfaces -addInterfaces directDeps pkg (Artifacts ifaces _) dependencyInterfaces = +addInterfaces : Dict ( String, String ) T.CEP_Name a -> T.CEP_Name -> T.CED_Artifacts -> Interfaces -> Interfaces +addInterfaces directDeps pkg (T.CED_Artifacts ifaces _) dependencyInterfaces = Dict.union dependencyInterfaces (Dict.fromList ModuleName.toComparableCanonical @@ -453,16 +482,16 @@ addInterfaces directDeps pkg (Artifacts ifaces _) dependencyInterfaces = ) -gatherForeigns : T.CEP_Name -> Artifacts -> Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.CEP_Name) -> Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.CEP_Name) -gatherForeigns pkg (Artifacts ifaces _) foreigns = +gatherForeigns : T.CEP_Name -> T.CED_Artifacts -> Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.CEP_Name) -> Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.CEP_Name) +gatherForeigns pkg (T.CED_Artifacts ifaces _) foreigns = let - isPublic : I.DependencyInterface -> Maybe (OneOrMore.OneOrMore T.CEP_Name) + isPublic : T.CEI_DependencyInterface -> Maybe (OneOrMore.OneOrMore T.CEP_Name) isPublic di = case di of - I.Public _ -> + T.CEI_Public _ -> Just (OneOrMore.one pkg) - I.Private _ _ _ -> + T.CEI_Private _ _ _ -> Nothing in Utils.mapUnionWith identity compare OneOrMore.more foreigns (Utils.mapMapMaybe identity compare isPublic ifaces) @@ -472,18 +501,10 @@ gatherForeigns pkg (Artifacts ifaces _) foreigns = -- VERIFY DEPENDENCY -type Artifacts - = Artifacts (Dict String T.CEMN_Raw I.DependencyInterface) T.CASTO_GlobalGraph - - -type alias Dep = - Result (Maybe Exit.DetailsBadDep) Artifacts - - -verifyDep : Env -> T.MVar (Dict ( String, String ) T.CEP_Name (T.MVar Dep)) -> Dict ( String, String ) T.CEP_Name Solver.Details -> T.CEP_Name -> Solver.Details -> IO Dep +verifyDep : Env -> T.MVar (Dict ( String, String ) T.CEP_Name T.MVar_CED_Dep) -> Dict ( String, String ) T.CEP_Name Solver.Details -> T.CEP_Name -> Solver.Details -> IO T.CED_Dep verifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg ((Solver.Details vsn directDeps) as details) = let - fingerprint : Dict ( String, String ) T.CEP_Name V.Version + fingerprint : Dict ( String, String ) T.CEP_Name T.CEV_Version fingerprint = Utils.mapIntersectionWith identity Pkg.compareName (\(Solver.Details v _) _ -> v) solution directDeps in @@ -520,7 +541,7 @@ verifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg ((Solver.Details case result of Err problem -> Reporting.report key (Reporting.DFailed pkg vsn) - |> IO.fmap (\_ -> Err (Just (Exit.BD_BadDownload pkg vsn problem))) + |> IO.fmap (\_ -> Err (Just (T.BRE_BD_BadDownload pkg vsn problem))) Ok () -> Reporting.report key (Reporting.DReceived pkg vsn) @@ -535,11 +556,11 @@ verifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg ((Solver.Details type ArtifactCache - = ArtifactCache (EverySet (List ( ( String, String ), ( Int, Int, Int ) )) Fingerprint) Artifacts + = ArtifactCache (EverySet (List ( ( String, String ), ( Int, Int, Int ) )) Fingerprint) T.CED_Artifacts type alias Fingerprint = - Dict ( String, String ) T.CEP_Name V.Version + Dict ( String, String ) T.CEP_Name T.CEV_Version toComparableFingerprint : Fingerprint -> List ( ( String, String ), ( Int, Int, Int ) ) @@ -552,7 +573,7 @@ toComparableFingerprint fingerprint = -- BUILD -build : Reporting.DKey -> Stuff.PackageCache -> T.MVar (Dict ( String, String ) T.CEP_Name (T.MVar Dep)) -> T.CEP_Name -> Solver.Details -> Fingerprint -> EverySet (List ( ( String, String ), ( Int, Int, Int ) )) Fingerprint -> IO Dep +build : Reporting.DKey -> T.BS_PackageCache -> T.MVar (Dict ( String, String ) T.CEP_Name T.MVar_CED_Dep) -> T.CEP_Name -> Solver.Details -> Fingerprint -> EverySet (List ( ( String, String ), ( Int, Int, Int ) )) Fingerprint -> IO T.CED_Dep build key cache depsMVar pkg (Solver.Details vsn _) f fs = Outline.read (Stuff.package cache pkg vsn) |> IO.bind @@ -560,17 +581,17 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = case eitherOutline of Err _ -> Reporting.report key Reporting.DBroken - |> IO.fmap (\_ -> Err (Just (Exit.BD_BadBuild pkg vsn f))) + |> IO.fmap (\_ -> Err (Just (T.BRE_BD_BadBuild pkg vsn f))) Ok (Outline.App _) -> Reporting.report key Reporting.DBroken - |> IO.fmap (\_ -> Err (Just (Exit.BD_BadBuild pkg vsn f))) + |> IO.fmap (\_ -> Err (Just (T.BRE_BD_BadBuild pkg vsn f))) Ok (Outline.Pkg (Outline.PkgOutline _ _ _ _ exposed deps _ _)) -> Utils.readMVar dictPkgNameMVarDepDecoder depsMVar |> IO.bind (\allDeps -> - Utils.mapTraverse identity Pkg.compareName (Utils.readMVar depDecoder) (Dict.intersection compare allDeps deps) + Utils.mapTraverse identity Pkg.compareName Utils.readMVar_CED_Dep (Dict.intersection compare allDeps deps) |> IO.bind (\directDeps -> case Utils.sequenceDictResult identity Pkg.compareName directDeps of @@ -609,23 +630,23 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = case Utils.sequenceDictMaybe identity compare maybeStatuses of Nothing -> Reporting.report key Reporting.DBroken - |> IO.fmap (\_ -> Err (Just (Exit.BD_BadBuild pkg vsn f))) + |> IO.fmap (\_ -> Err (Just (T.BRE_BD_BadBuild pkg vsn f))) Just statuses -> Utils.newEmptyMVar |> IO.bind (\rmvar -> - Utils.mapTraverse identity compare (fork (E.maybe dResultEncoder) << compile pkg rmvar) statuses + Utils.mapTraverse identity compare (fork_Maybe_BED_DResult << compile pkg rmvar) statuses |> IO.bind (\rmvars -> Utils.putMVar dictRawMVarMaybeDResultEncoder rmvar rmvars - |> IO.bind (\_ -> Utils.mapTraverse identity compare (Utils.readMVar (Decode.maybe dResultDecoder)) rmvars) + |> IO.bind (\_ -> Utils.mapTraverse identity compare Utils.readMVar_Maybe_BED_DResult rmvars) |> IO.bind (\maybeResults -> case Utils.sequenceDictMaybe identity compare maybeResults of Nothing -> Reporting.report key Reporting.DBroken - |> IO.fmap (\_ -> Err (Just (Exit.BD_BadBuild pkg vsn f))) + |> IO.fmap (\_ -> Err (Just (T.BRE_BD_BadBuild pkg vsn f))) Just results -> let @@ -633,7 +654,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = path = Stuff.package cache pkg vsn ++ "/artifacts.json" - ifaces : Dict String T.CEMN_Raw I.DependencyInterface + ifaces : Dict String T.CEMN_Raw T.CEI_DependencyInterface ifaces = gatherInterfaces exposedDict results @@ -641,9 +662,9 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = objects = gatherObjects results - artifacts : Artifacts + artifacts : T.CED_Artifacts artifacts = - Artifacts ifaces objects + T.CED_Artifacts ifaces objects fingerprints : EverySet (List ( ( String, String ), ( Int, Int, Int ) )) Fingerprint fingerprints = @@ -669,41 +690,41 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = -- GATHER -gatherObjects : Dict String T.CEMN_Raw DResult -> T.CASTO_GlobalGraph +gatherObjects : Dict String T.CEMN_Raw T.BED_DResult -> T.CASTO_GlobalGraph gatherObjects results = Dict.foldr compare addLocalGraph Opt.empty results -addLocalGraph : T.CEMN_Raw -> DResult -> T.CASTO_GlobalGraph -> T.CASTO_GlobalGraph +addLocalGraph : T.CEMN_Raw -> T.BED_DResult -> T.CASTO_GlobalGraph -> T.CASTO_GlobalGraph addLocalGraph name status graph = case status of - RLocal _ objs _ -> + T.BED_RLocal _ objs _ -> Opt.addLocalGraph objs graph - RForeign _ -> + T.BED_RForeign _ -> graph - RKernelLocal cs -> + T.BED_RKernelLocal cs -> Opt.addKernel (Name.getKernel name) cs graph - RKernelForeign -> + T.BED_RKernelForeign -> graph -gatherInterfaces : Dict String T.CEMN_Raw () -> Dict String T.CEMN_Raw DResult -> Dict String T.CEMN_Raw I.DependencyInterface +gatherInterfaces : Dict String T.CEMN_Raw () -> Dict String T.CEMN_Raw T.BED_DResult -> Dict String T.CEMN_Raw T.CEI_DependencyInterface gatherInterfaces exposed artifacts = let onLeft : a -> b -> c -> d onLeft _ _ _ = crash "compiler bug manifesting in Elm.Details.gatherInterfaces" - onBoth : comparable -> () -> DResult -> Dict comparable comparable I.DependencyInterface -> Dict comparable comparable I.DependencyInterface + onBoth : comparable -> () -> T.BED_DResult -> Dict comparable comparable T.CEI_DependencyInterface -> Dict comparable comparable T.CEI_DependencyInterface onBoth k () iface = toLocalInterface I.public iface |> Maybe.map (Dict.insert identity k) |> Maybe.withDefault identity - onRight : comparable -> DResult -> Dict comparable comparable I.DependencyInterface -> Dict comparable comparable I.DependencyInterface + onRight : comparable -> T.BED_DResult -> Dict comparable comparable T.CEI_DependencyInterface -> Dict comparable comparable T.CEI_DependencyInterface onRight k iface = toLocalInterface I.private iface |> Maybe.map (Dict.insert identity k) @@ -712,19 +733,19 @@ gatherInterfaces exposed artifacts = Dict.merge compare onLeft onBoth onRight exposed artifacts Dict.empty -toLocalInterface : (T.CEI_Interface -> a) -> DResult -> Maybe a +toLocalInterface : (T.CEI_Interface -> a) -> T.BED_DResult -> Maybe a toLocalInterface func result = case result of - RLocal iface _ _ -> + T.BED_RLocal iface _ _ -> Just (func iface) - RForeign _ -> + T.BED_RForeign _ -> Nothing - RKernelLocal _ -> + T.BED_RKernelLocal _ -> Nothing - RKernelForeign -> + T.BED_RKernelForeign -> Nothing @@ -737,7 +758,7 @@ type ForeignInterface | ForeignSpecific T.CEI_Interface -gatherForeignInterfaces : Dict ( String, String ) T.CEP_Name Artifacts -> Dict String T.CEMN_Raw ForeignInterface +gatherForeignInterfaces : Dict ( String, String ) T.CEP_Name T.CED_Artifacts -> Dict String T.CEMN_Raw ForeignInterface gatherForeignInterfaces directArtifacts = let finalize : T.CEI_Interface -> List T.CEI_Interface -> ForeignInterface @@ -749,17 +770,17 @@ gatherForeignInterfaces directArtifacts = _ :: _ -> ForeignAmbiguous - gather : T.CEP_Name -> Artifacts -> Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.CEI_Interface) -> Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.CEI_Interface) - gather _ (Artifacts ifaces _) buckets = + gather : T.CEP_Name -> T.CED_Artifacts -> Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.CEI_Interface) -> Dict String T.CEMN_Raw (OneOrMore.OneOrMore T.CEI_Interface) + gather _ (T.CED_Artifacts ifaces _) buckets = Utils.mapUnionWith identity compare OneOrMore.more buckets (Utils.mapMapMaybe identity compare isPublic ifaces) - isPublic : I.DependencyInterface -> Maybe (OneOrMore.OneOrMore T.CEI_Interface) + isPublic : T.CEI_DependencyInterface -> Maybe (OneOrMore.OneOrMore T.CEI_Interface) isPublic di = case di of - I.Public iface -> + T.CEI_Public iface -> Just (OneOrMore.one iface) - I.Private _ _ _ -> + T.CEI_Private _ _ _ -> Nothing in Dict.map (\_ -> OneOrMore.destruct finalize) <| @@ -888,21 +909,14 @@ getDepHome fi = -- COMPILE -type DResult - = RLocal T.CEI_Interface T.CASTO_LocalGraph (Maybe T.CED_Module) - | RForeign T.CEI_Interface - | RKernelLocal (List T.CEK_Chunk) - | RKernelForeign - - -compile : T.CEP_Name -> T.MVar (Dict String T.CEMN_Raw (T.MVar (Maybe DResult))) -> T.BED_Status -> IO (Maybe DResult) +compile : T.CEP_Name -> T.MVar (Dict String T.CEMN_Raw T.MVar_Maybe_BED_DResult) -> T.BED_Status -> IO (Maybe T.BED_DResult) compile pkg mvar status = case status of T.BED_SLocal docsStatus deps modul -> Utils.readMVar moduleNameRawMVarMaybeDResultDecoder mvar |> IO.bind (\resultsDict -> - Utils.mapTraverse identity compare (Utils.readMVar (Decode.maybe dResultDecoder)) (Dict.intersection compare resultsDict deps) + Utils.mapTraverse identity compare Utils.readMVar_Maybe_BED_DResult (Dict.intersection compare resultsDict deps) |> IO.bind (\maybeResults -> case Utils.sequenceDictMaybe identity compare maybeResults of @@ -924,7 +938,7 @@ compile pkg mvar status = docs = makeDocs docsStatus canonical in - Just (RLocal ifaces objects docs) + Just (T.BED_RLocal ifaces objects docs) ) Nothing -> @@ -933,28 +947,28 @@ compile pkg mvar status = ) T.BED_SForeign iface -> - IO.pure (Just (RForeign iface)) + IO.pure (Just (T.BED_RForeign iface)) T.BED_SKernelLocal chunks -> - IO.pure (Just (RKernelLocal chunks)) + IO.pure (Just (T.BED_RKernelLocal chunks)) T.BED_SKernelForeign -> - IO.pure (Just RKernelForeign) + IO.pure (Just T.BED_RKernelForeign) -getInterface : DResult -> Maybe T.CEI_Interface +getInterface : T.BED_DResult -> Maybe T.CEI_Interface getInterface result = case result of - RLocal iface _ _ -> + T.BED_RLocal iface _ _ -> Just iface - RForeign iface -> + T.BED_RForeign iface -> Just iface - RKernelLocal _ -> + T.BED_RKernelLocal _ -> Nothing - RKernelForeign -> + T.BED_RKernelForeign -> Nothing @@ -962,7 +976,7 @@ getInterface result = -- MAKE DOCS -getDocsStatus : Stuff.PackageCache -> T.CEP_Name -> V.Version -> IO T.BED_DocsStatus +getDocsStatus : T.BS_PackageCache -> T.CEP_Name -> T.CEV_Version -> IO T.BED_DocsStatus getDocsStatus cache pkg vsn = File.exists (Stuff.package cache pkg vsn ++ "/docs.json") |> IO.fmap @@ -990,7 +1004,7 @@ makeDocs status modul = Nothing -writeDocs : Stuff.PackageCache -> T.CEP_Name -> V.Version -> T.BED_DocsStatus -> Dict String T.CEMN_Raw DResult -> IO () +writeDocs : T.BS_PackageCache -> T.CEP_Name -> T.CEV_Version -> T.BED_DocsStatus -> Dict String T.CEMN_Raw T.BED_DResult -> IO () writeDocs cache pkg vsn status results = case status of T.BED_DocsNeeded -> @@ -1001,19 +1015,19 @@ writeDocs cache pkg vsn status results = IO.pure () -toDocs : DResult -> Maybe T.CED_Module +toDocs : T.BED_DResult -> Maybe T.CED_Module toDocs result = case result of - RLocal _ _ docs -> + T.BED_RLocal _ _ docs -> docs - RForeign _ -> + T.BED_RForeign _ -> Nothing - RKernelLocal _ -> + T.BED_RKernelLocal _ -> Nothing - RKernelForeign -> + T.BED_RKernelForeign -> Nothing @@ -1021,7 +1035,7 @@ toDocs result = -- DOWNLOAD PACKAGE -downloadPackage : Stuff.PackageCache -> Http.Manager -> T.CEP_Name -> V.Version -> IO (Result Exit.PackageProblem ()) +downloadPackage : T.BS_PackageCache -> T.BH_Manager -> T.CEP_Name -> T.CEV_Version -> IO (Result T.BRE_PackageProblem ()) downloadPackage cache manager pkg vsn = let url : String @@ -1033,21 +1047,21 @@ downloadPackage cache manager pkg vsn = (\eitherByteString -> case eitherByteString of Err err -> - IO.pure (Err (Exit.PP_BadEndpointRequest err)) + IO.pure (Err (T.BRE_PP_BadEndpointRequest err)) Ok byteString -> case D.fromByteString endpointDecoder byteString of Err _ -> - IO.pure (Err (Exit.PP_BadEndpointContent url)) + IO.pure (Err (T.BRE_PP_BadEndpointContent url)) Ok ( endpoint, expectedHash ) -> - Http.getArchive manager endpoint Exit.PP_BadArchiveRequest (Exit.PP_BadArchiveContent endpoint) <| + Http.getArchive manager endpoint T.BRE_PP_BadArchiveRequest (T.BRE_PP_BadArchiveContent endpoint) <| \( sha, archive ) -> if expectedHash == Http.shaToChars sha then IO.fmap Ok (File.writePackage (Stuff.package cache pkg vsn) archive) else - IO.pure (Err (Exit.PP_BadArchiveHash endpoint expectedHash (Http.shaToChars sha))) + IO.pure (Err (T.BRE_PP_BadArchiveHash endpoint expectedHash (Http.shaToChars sha))) ) @@ -1099,28 +1113,8 @@ interfacesDecoder = D.assocListDict ModuleName.toComparableCanonical ModuleName.canonicalDecoder I.dependencyInterfaceDecoder -resultRegistryProblemEnvEncoder : Result Exit.RegistryProblem Solver.Env -> Encode.Value -resultRegistryProblemEnvEncoder = - E.result Exit.registryProblemEncoder Solver.envEncoder - - -resultRegistryProblemEnvDecoder : Decode.Decoder (Result Exit.RegistryProblem Solver.Env) -resultRegistryProblemEnvDecoder = - D.result Exit.registryProblemDecoder Solver.envDecoder - - -depEncoder : Dep -> Encode.Value -depEncoder dep = - E.result (E.maybe Exit.detailsBadDepEncoder) artifactsEncoder dep - - -depDecoder : Decode.Decoder Dep -depDecoder = - D.result (Decode.maybe Exit.detailsBadDepDecoder) artifactsDecoder - - -artifactsEncoder : Artifacts -> Encode.Value -artifactsEncoder (Artifacts ifaces objects) = +artifactsEncoder : T.CED_Artifacts -> Encode.Value +artifactsEncoder (T.CED_Artifacts ifaces objects) = Encode.object [ ( "type", Encode.string "Artifacts" ) , ( "ifaces", E.assocListDict compare ModuleName.rawEncoder I.dependencyInterfaceEncoder ifaces ) @@ -1128,16 +1122,16 @@ artifactsEncoder (Artifacts ifaces objects) = ] -artifactsDecoder : Decode.Decoder Artifacts +artifactsDecoder : Decode.Decoder T.CED_Artifacts artifactsDecoder = - Decode.map2 Artifacts + Decode.map2 T.CED_Artifacts (Decode.field "ifaces" (D.assocListDict identity ModuleName.rawDecoder I.dependencyInterfaceDecoder)) (Decode.field "objects" Opt.globalGraphDecoder) -dictNameMVarDepEncoder : Dict ( String, String ) T.CEP_Name (T.MVar Dep) -> Encode.Value +dictNameMVarDepEncoder : Dict ( String, String ) T.CEP_Name T.MVar_CED_Dep -> Encode.Value dictNameMVarDepEncoder = - E.assocListDict compare Pkg.nameEncoder Utils.mVarEncoder + E.assocListDict compare Pkg.nameEncoder Utils.mVarEncoder_CED_Dep artifactCacheEncoder : ArtifactCache -> Encode.Value @@ -1156,84 +1150,29 @@ artifactCacheDecoder = (Decode.field "artifacts" artifactsDecoder) -dictPkgNameMVarDepDecoder : Decode.Decoder (Dict ( String, String ) T.CEP_Name (T.MVar Dep)) +dictPkgNameMVarDepDecoder : Decode.Decoder (Dict ( String, String ) T.CEP_Name T.MVar_CED_Dep) dictPkgNameMVarDepDecoder = - D.assocListDict identity Pkg.nameDecoder Utils.mVarDecoder + D.assocListDict identity Pkg.nameDecoder Utils.mVarDecoder_CED_Dep -dictRawMVarMaybeDResultEncoder : Dict String T.CEMN_Raw (T.MVar (Maybe DResult)) -> Encode.Value +dictRawMVarMaybeDResultEncoder : Dict String T.CEMN_Raw T.MVar_Maybe_BED_DResult -> Encode.Value dictRawMVarMaybeDResultEncoder = - E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder + E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder_Maybe_BED_DResult -moduleNameRawMVarMaybeDResultDecoder : Decode.Decoder (Dict String T.CEMN_Raw (T.MVar (Maybe DResult))) +moduleNameRawMVarMaybeDResultDecoder : Decode.Decoder (Dict String T.CEMN_Raw T.MVar_Maybe_BED_DResult) moduleNameRawMVarMaybeDResultDecoder = - D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder - - -dResultEncoder : DResult -> Encode.Value -dResultEncoder dResult = - case dResult of - RLocal ifaces objects docs -> - Encode.object - [ ( "type", Encode.string "RLocal" ) - , ( "ifaces", I.interfaceEncoder ifaces ) - , ( "objects", Opt.localGraphEncoder objects ) - , ( "docs", E.maybe Docs.jsonModuleEncoder docs ) - ] - - RForeign iface -> - Encode.object - [ ( "type", Encode.string "RForeign" ) - , ( "iface", I.interfaceEncoder iface ) - ] - - RKernelLocal chunks -> - Encode.object - [ ( "type", Encode.string "RKernelLocal" ) - , ( "chunks", Encode.list Kernel.chunkEncoder chunks ) - ] - - RKernelForeign -> - Encode.object - [ ( "type", Encode.string "RKernelForeign" ) - ] - - -dResultDecoder : Decode.Decoder DResult -dResultDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "RLocal" -> - Decode.map3 RLocal - (Decode.field "ifaces" I.interfaceDecoder) - (Decode.field "objects" Opt.localGraphDecoder) - (Decode.field "docs" (Decode.maybe Docs.jsonModuleDecoder)) - - "RForeign" -> - Decode.map RForeign (Decode.field "iface" I.interfaceDecoder) - - "RKernelLocal" -> - Decode.map RKernelLocal (Decode.field "chunks" (Decode.list Kernel.chunkDecoder)) - - "RKernelForeign" -> - Decode.succeed RKernelForeign - - _ -> - Decode.fail ("Failed to decode DResult's type: " ++ type_) - ) + D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder_Maybe_BED_DResult statusDictEncoder : T.BED_StatusDict -> Encode.Value statusDictEncoder statusDict = - E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder statusDict + E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder_Maybe_BED_Status statusDict statusDictDecoder : Decode.Decoder T.BED_StatusDict statusDictDecoder = - D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder + D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder_Maybe_BED_Status localEncoder : T.BED_Local -> Encode.Value diff --git a/src/Builder/Elm/Outline.elm b/src/Builder/Elm/Outline.elm index b2623ce74..0ee332f02 100644 --- a/src/Builder/Elm/Outline.elm +++ b/src/Builder/Elm/Outline.elm @@ -45,11 +45,11 @@ type Outline type AppOutline - = AppOutline V.Version (NE.Nonempty SrcDir) (Dict ( String, String ) T.CEP_Name V.Version) (Dict ( String, String ) T.CEP_Name V.Version) (Dict ( String, String ) T.CEP_Name V.Version) (Dict ( String, String ) T.CEP_Name V.Version) + = AppOutline T.CEV_Version (NE.Nonempty SrcDir) (Dict ( String, String ) T.CEP_Name T.CEV_Version) (Dict ( String, String ) T.CEP_Name T.CEV_Version) (Dict ( String, String ) T.CEP_Name T.CEV_Version) (Dict ( String, String ) T.CEP_Name T.CEV_Version) type PkgOutline - = PkgOutline T.CEP_Name String Licenses.License V.Version Exposed (Dict ( String, String ) T.CEP_Name Con.Constraint) (Dict ( String, String ) T.CEP_Name Con.Constraint) Con.Constraint + = PkgOutline T.CEP_Name String Licenses.License T.CEV_Version Exposed (Dict ( String, String ) T.CEP_Name Con.Constraint) (Dict ( String, String ) T.CEP_Name Con.Constraint) Con.Constraint type Exposed @@ -345,7 +345,7 @@ summaryDecoder = (\_ _ -> Exit.OP_BadSummaryTooLong) -versionDecoder : Decoder V.Version +versionDecoder : Decoder T.CEV_Version versionDecoder = D.mapError (Basics.uncurry Exit.OP_BadVersion) V.decoder diff --git a/src/Builder/Generate.elm b/src/Builder/Generate.elm index 121f2c853..0308fc59d 100644 --- a/src/Builder/Generate.elm +++ b/src/Builder/Generate.elm @@ -21,7 +21,6 @@ import Compiler.Generate.JavaScript as JS import Compiler.Generate.Mode as Mode import Compiler.Nitpick.Debug as Nitpick import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode import System.IO as IO exposing (IO) import Types as T import Utils.Main as Utils @@ -173,7 +172,7 @@ lookupMain pkg locals root = type LoadingObjects - = LoadingObjects (T.MVar (Maybe T.CASTO_GlobalGraph)) (Dict String T.CEMN_Raw (T.MVar (Maybe T.CASTO_LocalGraph))) + = LoadingObjects T.MVar_Maybe_CASTO_GlobalGraph (Dict String T.CEMN_Raw T.MVar_Maybe_CASTO_LocalGraph) loadObjects : T.FilePath -> Details.Details -> List Build.Module -> Task LoadingObjects @@ -191,7 +190,7 @@ loadObjects root details modules = ) -loadObject : T.FilePath -> Build.Module -> IO ( T.CEMN_Raw, T.MVar (Maybe T.CASTO_LocalGraph) ) +loadObject : T.FilePath -> Build.Module -> IO ( T.CEMN_Raw, T.MVar_Maybe_CASTO_LocalGraph ) loadObject root modul = case modul of Build.Fresh name _ graph -> @@ -244,18 +243,18 @@ objectsToGlobalGraph (Objects globals locals) = -- LOAD TYPES -loadTypes : T.FilePath -> Dict (List String) T.CEMN_Canonical I.DependencyInterface -> List Build.Module -> Task Extract.Types +loadTypes : T.FilePath -> Dict (List String) T.CEMN_Canonical T.CEI_DependencyInterface -> List Build.Module -> Task T.CECTE_Types loadTypes root ifaces modules = Task.eio identity (Utils.listTraverse (loadTypesHelp root) modules |> IO.bind (\mvars -> let - foreigns : Extract.Types + foreigns : T.CECTE_Types foreigns = Extract.mergeMany (Dict.values ModuleName.compareCanonical (Dict.map Extract.fromDependencyInterface ifaces)) in - Utils.listTraverse (Utils.readMVar (Decode.maybe Extract.typesDecoder)) mvars + Utils.listTraverse Utils.readMVar_Maybe_CECTE_Types mvars |> IO.fmap (\results -> case Utils.sequenceListMaybe results of @@ -269,11 +268,11 @@ loadTypes root ifaces modules = ) -loadTypesHelp : T.FilePath -> Build.Module -> IO (T.MVar (Maybe Extract.Types)) +loadTypesHelp : T.FilePath -> Build.Module -> IO T.MVar_Maybe_CECTE_Types loadTypesHelp root modul = case modul of Build.Fresh name iface _ -> - Utils.newMVar (Utils.maybeEncoder Extract.typesEncoder) (Just (Extract.fromInterface name iface)) + Utils.newMVar_Maybe_CECTE_Types (Just (Extract.fromInterface name iface)) Build.Cached name _ ciMVar -> Utils.readMVar Build.cachedInterfaceDecoder ciMVar @@ -281,22 +280,22 @@ loadTypesHelp root modul = (\cachedInterface -> case cachedInterface of T.BB_Unneeded -> - Utils.newEmptyMVar + Utils.newEmptyMVar_Maybe_CECTE_Types |> IO.bind (\mvar -> Utils.forkIO (File.readBinary I.interfaceDecoder (Stuff.elmi root name) |> IO.bind (\maybeIface -> - Utils.putMVar (Utils.maybeEncoder Extract.typesEncoder) mvar (Maybe.map (Extract.fromInterface name) maybeIface) + Utils.putMVar_Maybe_CECTE_Types mvar (Maybe.map (Extract.fromInterface name) maybeIface) ) ) |> IO.fmap (\_ -> mvar) ) T.BB_Loaded iface -> - Utils.newMVar (Utils.maybeEncoder Extract.typesEncoder) (Just (Extract.fromInterface name iface)) + Utils.newMVar_Maybe_CECTE_Types (Just (Extract.fromInterface name iface)) T.BB_Corrupted -> - Utils.newMVar (Utils.maybeEncoder Extract.typesEncoder) Nothing + Utils.newMVar_Maybe_CECTE_Types Nothing ) diff --git a/src/Builder/Http.elm b/src/Builder/Http.elm index 45e85fef2..7fb75f444 100644 --- a/src/Builder/Http.elm +++ b/src/Builder/Http.elm @@ -1,7 +1,5 @@ module Builder.Http exposing - ( Error(..) - , Header - , Manager + ( Header , MultiPart , Sha , accept @@ -27,41 +25,38 @@ import Compiler.Elm.Version as V import Json.Decode as Decode import Json.Encode as Encode import System.IO as IO exposing (IO(..)) +import Types as T import Url.Builder -import Utils.Main as Utils exposing (SomeException) +import Utils.Main as Utils -- MANAGER -type Manager - = Manager - - -managerEncoder : Manager -> Encode.Value +managerEncoder : T.BH_Manager -> Encode.Value managerEncoder _ = Encode.object [ ( "type", Encode.string "Manager" ) ] -managerDecoder : Decode.Decoder Manager +managerDecoder : Decode.Decoder T.BH_Manager managerDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Manager" -> - Decode.succeed Manager + Decode.succeed T.BH_Manager _ -> Decode.fail "Failed to decode Http.Manager" ) -getManager : IO Manager +getManager : IO T.BH_Manager getManager = -- TODO newManager tlsManagerSettings - IO.pure Manager + IO.pure T.BH_Manager @@ -92,12 +87,12 @@ type alias Header = ( String, String ) -get : Manager -> String -> List Header -> (Error -> e) -> (String -> IO (Result e a)) -> IO (Result e a) +get : T.BH_Manager -> String -> List Header -> (T.BH_Error -> e) -> (String -> IO (Result e a)) -> IO (Result e a) get = fetch MethodGet -post : Manager -> String -> List Header -> (Error -> e) -> (String -> IO (Result e a)) -> IO (Result e a) +post : T.BH_Manager -> String -> List Header -> (T.BH_Error -> e) -> (String -> IO (Result e a)) -> IO (Result e a) post = fetch MethodPost @@ -107,7 +102,7 @@ type Method | MethodPost -fetch : Method -> Manager -> String -> List Header -> (Error -> e) -> (String -> IO (Result e a)) -> IO (Result e a) +fetch : Method -> T.BH_Manager -> String -> List Header -> (T.BH_Error -> e) -> (String -> IO (Result e a)) -> IO (Result e a) fetch methodVerb _ url headers _ onSuccess = IO (\_ s -> @@ -143,16 +138,6 @@ accept mime = --- EXCEPTIONS - - -type Error - = BadUrl String String - | BadHttp String Utils.HttpExceptionContent - | BadMystery String SomeException - - - -- SHA @@ -169,7 +154,7 @@ shaToChars = -- FETCH ARCHIVE -getArchive : Manager -> String -> (Error -> e) -> e -> (( Sha, Zip.Archive ) -> IO (Result e a)) -> IO (Result e a) +getArchive : T.BH_Manager -> String -> (T.BH_Error -> e) -> e -> (( Sha, Zip.Archive ) -> IO (Result e a)) -> IO (Result e a) getArchive _ url _ _ onSuccess = IO (\_ s -> ( s, IO.GetArchive IO.pure "GET" url )) |> IO.bind (\shaAndArchive -> onSuccess shaAndArchive) @@ -185,7 +170,7 @@ type MultiPart | StringPart String String -upload : Manager -> String -> List MultiPart -> IO (Result Error ()) +upload : T.BH_Manager -> String -> List MultiPart -> IO (Result T.BH_Error ()) upload _ url parts = IO (\_ s -> @@ -244,24 +229,24 @@ stringPart name string = -- ENCODERS and DECODERS -errorEncoder : Error -> Encode.Value +errorEncoder : T.BH_Error -> Encode.Value errorEncoder error = case error of - BadUrl url reason -> + T.BH_BadUrl url reason -> Encode.object [ ( "type", Encode.string "BadUrl" ) , ( "url", Encode.string url ) , ( "reason", Encode.string reason ) ] - BadHttp url httpExceptionContent -> + T.BH_BadHttp url httpExceptionContent -> Encode.object [ ( "type", Encode.string "BadHttp" ) , ( "url", Encode.string url ) , ( "httpExceptionContent", Utils.httpExceptionContentEncoder httpExceptionContent ) ] - BadMystery url someException -> + T.BH_BadMystery url someException -> Encode.object [ ( "type", Encode.string "BadMystery" ) , ( "url", Encode.string url ) @@ -269,24 +254,24 @@ errorEncoder error = ] -errorDecoder : Decode.Decoder Error +errorDecoder : Decode.Decoder T.BH_Error errorDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "BadUrl" -> - Decode.map2 BadUrl + Decode.map2 T.BH_BadUrl (Decode.field "url" Decode.string) (Decode.field "reason" Decode.string) "BadHttp" -> - Decode.map2 BadHttp + Decode.map2 T.BH_BadHttp (Decode.field "url" Decode.string) (Decode.field "httpExceptionContent" Utils.httpExceptionContentDecoder) "BadMystery" -> - Decode.map2 BadMystery + Decode.map2 T.BH_BadMystery (Decode.field "url" Decode.string) (Decode.field "someException" Utils.someExceptionDecoder) diff --git a/src/Builder/Reporting.elm b/src/Builder/Reporting.elm index f4a3ad065..4c23188c0 100644 --- a/src/Builder/Reporting.elm +++ b/src/Builder/Reporting.elm @@ -264,8 +264,8 @@ type DMsg = DStart Int | DCached | DRequested - | DReceived T.CEP_Name V.Version - | DFailed T.CEP_Name V.Version + | DReceived T.CEP_Name T.CEV_Version + | DFailed T.CEP_Name T.CEV_Version | DBuilt | DBroken @@ -303,7 +303,7 @@ detailsStep msg (DState total cached rqst rcvd failed built broken) = putBuilt (DState total cached rqst rcvd failed built (broken + 1)) -putDownload : D.Doc -> T.CEP_Name -> V.Version -> IO () +putDownload : D.Doc -> T.CEP_Name -> T.CEV_Version -> IO () putDownload mark pkg vsn = Help.toStdout (D.indent 2 diff --git a/src/Builder/Reporting/Exit.elm b/src/Builder/Reporting/Exit.elm index 0e54017c8..9818261b2 100644 --- a/src/Builder/Reporting/Exit.elm +++ b/src/Builder/Reporting/Exit.elm @@ -3,7 +3,6 @@ module Builder.Reporting.Exit exposing , BuildProjectProblem(..) , Bump(..) , Details(..) - , DetailsBadDep(..) , Diff(..) , DocsProblem(..) , Generate(..) @@ -12,9 +11,7 @@ module Builder.Reporting.Exit exposing , Make(..) , Outline(..) , OutlineProblem(..) - , PackageProblem(..) , Publish(..) - , RegistryProblem(..) , Repl(..) , Solver(..) , buildProblemDecoder @@ -54,7 +51,7 @@ import Compiler.Reporting.Error as Error import Compiler.Reporting.Error.Import as Import import Compiler.Reporting.Error.Json as Json import Compiler.Reporting.Render.Code as Code -import Data.Map as Dict exposing (Dict) +import Data.Map as Dict import Json.Decode as CoreDecode import Json.Encode as CoreEncode import System.IO exposing (IO) @@ -85,7 +82,7 @@ type Init | InitNoOfflineSolution (List T.CEP_Name) | InitSolverProblem Solver | InitAlreadyExists - | InitRegistryProblem RegistryProblem + | InitRegistryProblem T.BRE_RegistryProblem initToReport : Init -> Help.Report @@ -149,9 +146,9 @@ type Diff | DiffNoExposed | DiffUnpublished | DiffUnknownPackage T.CEP_Name (List T.CEP_Name) - | DiffUnknownVersion V.Version (List V.Version) - | DiffDocsProblem V.Version DocsProblem - | DiffMustHaveLatestRegistry RegistryProblem + | DiffUnknownVersion T.CEV_Version (List T.CEV_Version) + | DiffDocsProblem T.CEV_Version DocsProblem + | DiffMustHaveLatestRegistry T.BRE_RegistryProblem | DiffBadDetails Details | DiffBadBuild BuildProblem @@ -225,11 +222,11 @@ diffToReport diff = D.dullyellow <| D.vcat <| let - sameMajor : V.Version -> V.Version -> Bool + sameMajor : T.CEV_Version -> T.CEV_Version -> Bool sameMajor v1 v2 = V.major v1 == V.major v2 - mkRow : List V.Version -> D.Doc + mkRow : List T.CEV_Version -> D.Doc mkRow vsns = D.hsep <| List.map D.fromVersion vsns in @@ -262,9 +259,9 @@ type Bump = BumpNoOutline | BumpBadOutline Outline | BumpApplication - | BumpUnexpectedVersion V.Version (List V.Version) - | BumpMustHaveLatestRegistry RegistryProblem - | BumpCannotFindDocs V.Version DocsProblem + | BumpUnexpectedVersion T.CEV_Version (List T.CEV_Version) + | BumpMustHaveLatestRegistry T.BRE_RegistryProblem + | BumpCannotFindDocs T.CEV_Version DocsProblem | BumpBadDetails Details | BumpNoExposed | BumpBadBuild BuildProblem @@ -436,27 +433,27 @@ type Publish = PublishNoOutline | PublishBadOutline Outline | PublishBadDetails Details - | PublishMustHaveLatestRegistry RegistryProblem + | PublishMustHaveLatestRegistry T.BRE_RegistryProblem | PublishApplication - | PublishNotInitialVersion V.Version - | PublishAlreadyPublished V.Version - | PublishInvalidBump V.Version V.Version - | PublishBadBump V.Version V.Version M.Magnitude V.Version M.Magnitude + | PublishNotInitialVersion T.CEV_Version + | PublishAlreadyPublished T.CEV_Version + | PublishInvalidBump T.CEV_Version T.CEV_Version + | PublishBadBump T.CEV_Version T.CEV_Version M.Magnitude T.CEV_Version M.Magnitude | PublishNoSummary | PublishNoExposed | PublishNoReadme | PublishShortReadme | PublishNoLicense | PublishBuildProblem BuildProblem - | PublishMissingTag V.Version - | PublishCannotGetTag V.Version Http.Error - | PublishCannotGetTagData V.Version String String - | PublishCannotGetZip Http.Error + | PublishMissingTag T.CEV_Version + | PublishCannotGetTag T.CEV_Version T.BH_Error + | PublishCannotGetTagData T.CEV_Version String String + | PublishCannotGetZip T.BH_Error | PublishCannotDecodeZip String - | PublishCannotGetDocs V.Version V.Version DocsProblem - | PublishCannotRegister Http.Error + | PublishCannotGetDocs T.CEV_Version T.CEV_Version DocsProblem + | PublishCannotRegister T.BH_Error | PublishNoGit - | PublishLocalChanges V.Version + | PublishLocalChanges T.CEV_Version -- | PublishZipBadDetails Details | PublishZipApplication @@ -783,7 +780,7 @@ publishToReport publish = PublishCannotGetTag version httpError -> case httpError of - Http.BadHttp _ (Utils.StatusCodeException response _) -> + T.BH_BadHttp _ (T.UM_StatusCodeException response _) -> if Utils.httpStatusCode (Utils.httpResponseStatus response) == 404 then let vsn : String @@ -970,7 +967,7 @@ badZipReport = type DocsProblem - = DP_Http Http.Error + = DP_Http T.BH_Error | DP_Data String String | DP_Cache @@ -1024,7 +1021,7 @@ toDocsProblemReport problem context = type Install = InstallNoOutline | InstallBadOutline Outline - | InstallBadRegistry RegistryProblem + | InstallBadRegistry T.BRE_RegistryProblem | InstallNoArgs T.FilePath | InstallNoOnlineAppSolution T.CEP_Name | InstallNoOfflineAppSolution T.CEP_Name @@ -1250,9 +1247,9 @@ installToReport exit = type Solver - = SolverBadCacheData T.CEP_Name V.Version - | SolverBadHttpData T.CEP_Name V.Version String - | SolverBadHttp T.CEP_Name V.Version Http.Error + = SolverBadCacheData T.CEP_Name T.CEV_Version + | SolverBadHttpData T.CEP_Name T.CEV_Version String + | SolverBadHttp T.CEP_Name T.CEV_Version T.BH_Error toSolverReport : Solver -> Help.Report @@ -1834,16 +1831,11 @@ type Details | DetailsNoOfflineSolution | DetailsSolverProblem Solver | DetailsBadElmInPkg C.Constraint - | DetailsBadElmInAppOutline V.Version + | DetailsBadElmInAppOutline T.CEV_Version | DetailsHandEditedDependencies | DetailsBadOutline Outline - | DetailsCannotGetRegistry RegistryProblem - | DetailsBadDeps T.FilePath (List DetailsBadDep) - - -type DetailsBadDep - = BD_BadDownload T.CEP_Name V.Version PackageProblem - | BD_BadBuild T.CEP_Name V.Version (Dict ( String, String ) T.CEP_Name V.Version) + | DetailsCannotGetRegistry T.BRE_RegistryProblem + | DetailsBadDeps T.FilePath (List T.BRE_DetailsBadDep) toDetailsReport : Details -> Help.Report @@ -2007,10 +1999,10 @@ toDetailsReport details = d :: _ -> case d of - BD_BadDownload pkg vsn packageProblem -> + T.BRE_BD_BadDownload pkg vsn packageProblem -> toPackageProblemReport pkg vsn packageProblem - BD_BadBuild pkg vsn fingerprint -> + T.BRE_BD_BadBuild pkg vsn fingerprint -> Help.report "PROBLEM BUILDING DEPENDENCIES" Nothing "I ran into a compilation error when trying to build the following package:" @@ -2029,14 +2021,14 @@ toDetailsReport details = toBadDepRank : - DetailsBadDep + T.BRE_DetailsBadDep -> Int -- lower is better toBadDepRank badDep = case badDep of - BD_BadDownload _ _ _ -> + T.BRE_BD_BadDownload _ _ _ -> 0 - BD_BadBuild _ _ _ -> + T.BRE_BD_BadBuild _ _ _ -> 1 @@ -2044,15 +2036,7 @@ toBadDepRank badDep = -- PACKAGE PROBLEM -type PackageProblem - = PP_BadEndpointRequest Http.Error - | PP_BadEndpointContent String - | PP_BadArchiveRequest Http.Error - | PP_BadArchiveContent String - | PP_BadArchiveHash String String String - - -toPackageProblemReport : T.CEP_Name -> V.Version -> PackageProblem -> Help.Report +toPackageProblemReport : T.CEP_Name -> T.CEV_Version -> T.BRE_PackageProblem -> Help.Report toPackageProblemReport pkg vsn problem = let thePackage : String @@ -2060,12 +2044,12 @@ toPackageProblemReport pkg vsn problem = Pkg.toChars pkg ++ " " ++ V.toChars vsn in case problem of - PP_BadEndpointRequest httpError -> + T.BRE_PP_BadEndpointRequest httpError -> toHttpErrorReport "PROBLEM DOWNLOADING PACKAGE" httpError <| "I need to find the latest download link for " ++ thePackage - PP_BadEndpointContent url -> + T.BRE_PP_BadEndpointContent url -> Help.report "PROBLEM DOWNLOADING PACKAGE" Nothing ("I need to find the latest download link for " ++ thePackage ++ ", but I ran into corrupted information from:") @@ -2074,12 +2058,12 @@ toPackageProblemReport pkg vsn problem = "Is something weird with your internet connection. We have gotten reports that schools, businesses, airports, etc. sometimes intercept requests and add things to the body or change its contents entirely. Could that be the problem?" ] - PP_BadArchiveRequest httpError -> + T.BRE_PP_BadArchiveRequest httpError -> toHttpErrorReport "PROBLEM DOWNLOADING PACKAGE" httpError <| "I was trying to download the source code for " ++ thePackage - PP_BadArchiveContent url -> + T.BRE_PP_BadArchiveContent url -> Help.report "PROBLEM DOWNLOADING PACKAGE" Nothing ("I downloaded the source code for " ++ thePackage ++ " from:") @@ -2088,7 +2072,7 @@ toPackageProblemReport pkg vsn problem = "But I was unable to unzip the data. Maybe there is something weird with your internet connection. We have gotten reports that schools, businesses, airports, etc. sometimes intercept requests and add things to the body or change its contents entirely. Could that be the problem?" ] - PP_BadArchiveHash url expectedHash actualHash -> + T.BRE_PP_BadArchiveHash url expectedHash actualHash -> Help.report "CORRUPT PACKAGE DATA" Nothing ("I downloaded the source code for " ++ thePackage ++ " from:") @@ -2108,18 +2092,13 @@ toPackageProblemReport pkg vsn problem = -- REGISTRY PROBLEM -type RegistryProblem - = RP_Http Http.Error - | RP_Data String String - - -toRegistryProblemReport : String -> RegistryProblem -> String -> Help.Report +toRegistryProblemReport : String -> T.BRE_RegistryProblem -> String -> Help.Report toRegistryProblemReport title problem context = case problem of - RP_Http err -> + T.BRE_RP_Http err -> toHttpErrorReport title err context - RP_Data url body -> + T.BRE_RP_Data url body -> Help.report title Nothing (context ++ ", so I fetched:") @@ -2147,7 +2126,7 @@ toRegistryProblemReport title problem context = ] -toHttpErrorReport : String -> Http.Error -> String -> Help.Report +toHttpErrorReport : String -> T.BH_Error -> String -> Help.Report toHttpErrorReport title err context = let toHttpReport : String -> String -> List D.Doc -> Help.Report @@ -2157,7 +2136,7 @@ toHttpErrorReport title err context = :: details in case err of - Http.BadUrl url reason -> + T.BH_BadUrl url reason -> toHttpReport (context ++ ", so I wanted to fetch:") url [ D.reflow <| "But my HTTP library is saying this is not a valid URL. It is saying:" @@ -2166,11 +2145,11 @@ toHttpErrorReport title err context = "This may indicate that there is some problem in the compiler, so please open an issue at https://github.com/elm/compiler/issues listing your operating system, Elm version, the command you ran, the terminal output, and any additional information that might help others reproduce the error." ] - Http.BadHttp url httpExceptionContent -> + T.BH_BadHttp url httpExceptionContent -> case httpExceptionContent of - Utils.StatusCodeException response body -> + T.UM_StatusCodeException response body -> let - (Utils.HttpStatus code message) = + (T.UM_HttpStatus code message) = Utils.httpResponseStatus response in toHttpReport (context ++ ", so I tried to fetch:") @@ -2189,7 +2168,7 @@ toHttpErrorReport title err context = "This may mean some online endpoint changed in an unexpected way, so if does not seem like something on your side is causing this (e.g. firewall) please report this to https://github.com/elm/compiler/issues with your operating system, Elm version, the command you ran, the terminal output, and any additional information that can help others reproduce the error!" ] - Utils.TooManyRedirects responses -> + T.UM_TooManyRedirects responses -> toHttpReport (context ++ ", so I tried to fetch:") url [ D.reflow <| @@ -2210,7 +2189,7 @@ toHttpErrorReport title err context = "Are you somewhere with a slow internet connection? Or no internet? Does the link I am trying to fetch work in your browser? Maybe the site is down? Does your internet connection have a firewall that blocks certain domains? It is usually something like that!" ] - Http.BadMystery url Utils.SomeException -> + T.BH_BadMystery url T.UM_SomeException -> toHttpReport (context ++ ", so I tried to fetch:") url [ D.reflow <| "But I ran into something weird! I was able to extract this error message:" @@ -2220,10 +2199,10 @@ toHttpErrorReport title err context = ] -toRedirectDoc : Utils.HttpResponse body -> D.Doc +toRedirectDoc : T.UM_HttpResponse body -> D.Doc toRedirectDoc response = let - (Utils.HttpStatus code message) = + (T.UM_HttpStatus code message) = Utils.httpResponseStatus response in case Utils.listLookup Utils.httpHLocation (Utils.httpResponseHeaders response) of @@ -2823,10 +2802,10 @@ replToReport problem = -- ENCODERS and DECODERS -detailsBadDepEncoder : DetailsBadDep -> CoreEncode.Value +detailsBadDepEncoder : T.BRE_DetailsBadDep -> CoreEncode.Value detailsBadDepEncoder detailsBadDep = case detailsBadDep of - BD_BadDownload pkg vsn packageProblem -> + T.BRE_BD_BadDownload pkg vsn packageProblem -> CoreEncode.object [ ( "type", CoreEncode.string "BD_BadDownload" ) , ( "pkg", Pkg.nameEncoder pkg ) @@ -2834,7 +2813,7 @@ detailsBadDepEncoder detailsBadDep = , ( "packageProblem", packageProblemEncoder packageProblem ) ] - BD_BadBuild pkg vsn fingerprint -> + T.BRE_BD_BadBuild pkg vsn fingerprint -> CoreEncode.object [ ( "type", CoreEncode.string "BD_BadBuild" ) , ( "pkg", Pkg.nameEncoder pkg ) @@ -2843,20 +2822,20 @@ detailsBadDepEncoder detailsBadDep = ] -detailsBadDepDecoder : CoreDecode.Decoder DetailsBadDep +detailsBadDepDecoder : CoreDecode.Decoder T.BRE_DetailsBadDep detailsBadDepDecoder = CoreDecode.field "type" CoreDecode.string |> CoreDecode.andThen (\type_ -> case type_ of "BD_BadDownload" -> - CoreDecode.map3 BD_BadDownload + CoreDecode.map3 T.BRE_BD_BadDownload (CoreDecode.field "pkg" Pkg.nameDecoder) (CoreDecode.field "vsn" V.versionDecoder) (CoreDecode.field "packageProblem" packageProblemDecoder) "BD_BadBuild" -> - CoreDecode.map3 BD_BadBuild + CoreDecode.map3 T.BRE_BD_BadBuild (CoreDecode.field "pkg" Pkg.nameDecoder) (CoreDecode.field "vsn" V.versionDecoder) (CoreDecode.field "fingerprint" (Decode.assocListDict identity Pkg.nameDecoder V.versionDecoder)) @@ -3025,16 +3004,16 @@ buildProjectProblemDecoder = ) -registryProblemEncoder : RegistryProblem -> CoreEncode.Value +registryProblemEncoder : T.BRE_RegistryProblem -> CoreEncode.Value registryProblemEncoder registryProblem = case registryProblem of - RP_Http err -> + T.BRE_RP_Http err -> CoreEncode.object [ ( "type", CoreEncode.string "RP_Http" ) , ( "err", Http.errorEncoder err ) ] - RP_Data url body -> + T.BRE_RP_Data url body -> CoreEncode.object [ ( "type", CoreEncode.string "RP_Data" ) , ( "url", CoreEncode.string url ) @@ -3042,17 +3021,17 @@ registryProblemEncoder registryProblem = ] -registryProblemDecoder : CoreDecode.Decoder RegistryProblem +registryProblemDecoder : CoreDecode.Decoder T.BRE_RegistryProblem registryProblemDecoder = CoreDecode.field "type" CoreDecode.string |> CoreDecode.andThen (\type_ -> case type_ of "RP_Http" -> - CoreDecode.map RP_Http (CoreDecode.field "err" Http.errorDecoder) + CoreDecode.map T.BRE_RP_Http (CoreDecode.field "err" Http.errorDecoder) "RP_Data" -> - CoreDecode.map2 RP_Data + CoreDecode.map2 T.BRE_RP_Data (CoreDecode.field "url" CoreDecode.string) (CoreDecode.field "body" CoreDecode.string) @@ -3061,34 +3040,34 @@ registryProblemDecoder = ) -packageProblemEncoder : PackageProblem -> CoreEncode.Value +packageProblemEncoder : T.BRE_PackageProblem -> CoreEncode.Value packageProblemEncoder packageProblem = case packageProblem of - PP_BadEndpointRequest httpError -> + T.BRE_PP_BadEndpointRequest httpError -> CoreEncode.object [ ( "type", CoreEncode.string "PP_BadEndpointRequest" ) , ( "httpError", Http.errorEncoder httpError ) ] - PP_BadEndpointContent url -> + T.BRE_PP_BadEndpointContent url -> CoreEncode.object [ ( "type", CoreEncode.string "PP_BadEndpointContent" ) , ( "url", CoreEncode.string url ) ] - PP_BadArchiveRequest httpError -> + T.BRE_PP_BadArchiveRequest httpError -> CoreEncode.object [ ( "type", CoreEncode.string "PP_BadArchiveRequest" ) , ( "httpError", Http.errorEncoder httpError ) ] - PP_BadArchiveContent url -> + T.BRE_PP_BadArchiveContent url -> CoreEncode.object [ ( "type", CoreEncode.string "PP_BadArchiveContent" ) , ( "url", CoreEncode.string url ) ] - PP_BadArchiveHash url expectedHash actualHash -> + T.BRE_PP_BadArchiveHash url expectedHash actualHash -> CoreEncode.object [ ( "type", CoreEncode.string "PP_BadArchiveHash" ) , ( "url", CoreEncode.string url ) @@ -3097,26 +3076,26 @@ packageProblemEncoder packageProblem = ] -packageProblemDecoder : CoreDecode.Decoder PackageProblem +packageProblemDecoder : CoreDecode.Decoder T.BRE_PackageProblem packageProblemDecoder = CoreDecode.field "type" CoreDecode.string |> CoreDecode.andThen (\type_ -> case type_ of "PP_BadEndpointRequest" -> - CoreDecode.map PP_BadEndpointRequest (CoreDecode.field "httpError" Http.errorDecoder) + CoreDecode.map T.BRE_PP_BadEndpointRequest (CoreDecode.field "httpError" Http.errorDecoder) "PP_BadEndpointContent" -> - CoreDecode.map PP_BadEndpointContent (CoreDecode.field "url" CoreDecode.string) + CoreDecode.map T.BRE_PP_BadEndpointContent (CoreDecode.field "url" CoreDecode.string) "PP_BadArchiveRequest" -> - CoreDecode.map PP_BadArchiveRequest (CoreDecode.field "httpError" Http.errorDecoder) + CoreDecode.map T.BRE_PP_BadArchiveRequest (CoreDecode.field "httpError" Http.errorDecoder) "PP_BadArchiveContent" -> - CoreDecode.map PP_BadArchiveContent (CoreDecode.field "url" CoreDecode.string) + CoreDecode.map T.BRE_PP_BadArchiveContent (CoreDecode.field "url" CoreDecode.string) "PP_BadArchiveHash" -> - CoreDecode.map3 PP_BadArchiveHash + CoreDecode.map3 T.BRE_PP_BadArchiveHash (CoreDecode.field "url" CoreDecode.string) (CoreDecode.field "expectedHash" CoreDecode.string) (CoreDecode.field "actualHash" CoreDecode.string) diff --git a/src/Builder/Stuff.elm b/src/Builder/Stuff.elm index 291494a3a..750b58439 100644 --- a/src/Builder/Stuff.elm +++ b/src/Builder/Stuff.elm @@ -1,6 +1,5 @@ module Builder.Stuff exposing - ( PackageCache - , details + ( details , elmi , elmo , findRoot @@ -131,8 +130,8 @@ withRootLock root work = ) -withRegistryLock : PackageCache -> IO a -> IO a -withRegistryLock (PackageCache dir) work = +withRegistryLock : T.BS_PackageCache -> IO a -> IO a +withRegistryLock (T.BS_PackageCache dir) work = Utils.lockWithFileLock (dir ++ "/lock") Utils.LockExclusive (\_ -> work) @@ -140,22 +139,18 @@ withRegistryLock (PackageCache dir) work = -- PACKAGE CACHES -type PackageCache - = PackageCache String - - -getPackageCache : IO PackageCache +getPackageCache : IO T.BS_PackageCache getPackageCache = - IO.fmap PackageCache (getCacheDir "packages") + IO.fmap T.BS_PackageCache (getCacheDir "packages") -registry : PackageCache -> String -registry (PackageCache dir) = +registry : T.BS_PackageCache -> String +registry (T.BS_PackageCache dir) = Utils.fpForwardSlash dir "registry.json" -package : PackageCache -> T.CEP_Name -> V.Version -> String -package (PackageCache dir) name version = +package : T.BS_PackageCache -> T.CEP_Name -> T.CEV_Version -> String +package (T.BS_PackageCache dir) name version = Utils.fpForwardSlash dir (Utils.fpForwardSlash (Pkg.toString name) (V.toChars version)) @@ -201,14 +196,14 @@ getElmHome = -- ENCODERS and DECODERS -packageCacheEncoder : PackageCache -> Encode.Value -packageCacheEncoder (PackageCache dir) = +packageCacheEncoder : T.BS_PackageCache -> Encode.Value +packageCacheEncoder (T.BS_PackageCache dir) = Encode.object [ ( "type", Encode.string "PackageCache" ) , ( "dir", Encode.string dir ) ] -packageCacheDecoder : Decode.Decoder PackageCache +packageCacheDecoder : Decode.Decoder T.BS_PackageCache packageCacheDecoder = - Decode.map PackageCache (Decode.field "dir" Decode.string) + Decode.map T.BS_PackageCache (Decode.field "dir" Decode.string) diff --git a/src/Compiler/Elm/Compiler/Type/Extract.elm b/src/Compiler/Elm/Compiler/Type/Extract.elm index 0e2c0bc5c..1f8e51641 100644 --- a/src/Compiler/Elm/Compiler/Type/Extract.elm +++ b/src/Compiler/Elm/Compiler/Type/Extract.elm @@ -1,7 +1,5 @@ module Compiler.Elm.Compiler.Type.Extract exposing - ( Types(..) - , Types_ - , fromDependencyInterface + ( fromDependencyInterface , fromInterface , fromMsg , fromType @@ -20,7 +18,7 @@ import Compiler.Elm.Interface as I import Compiler.Elm.ModuleName as ModuleName import Compiler.Json.Decode as D import Compiler.Json.Encode as E -import Data.Map as Dict exposing (Dict) +import Data.Map as Dict import Data.Set as EverySet exposing (EverySet) import Json.Decode as Decode import Json.Encode as Encode @@ -88,49 +86,38 @@ toPublicName (T.CEMN_Canonical _ home) name = -- TRANSITIVELY AVAILABLE TYPES -type Types - = -- PERF profile Opt.Global representation - -- current representation needs less allocation - -- but maybe the lookup is much worse - Types (Dict (List String) T.CEMN_Canonical Types_) - - -type Types_ - = Types_ (Dict String T.CDN_Name T.CASTC_Union) (Dict String T.CDN_Name T.CASTC_Alias) - - -mergeMany : List Types -> Types +mergeMany : List T.CECTE_Types -> T.CECTE_Types mergeMany listOfTypes = case listOfTypes of [] -> - Types Dict.empty + T.CECTE_Types Dict.empty t :: ts -> List.foldr merge t ts -merge : Types -> Types -> Types -merge (Types types1) (Types types2) = - Types (Dict.union types1 types2) +merge : T.CECTE_Types -> T.CECTE_Types -> T.CECTE_Types +merge (T.CECTE_Types types1) (T.CECTE_Types types2) = + T.CECTE_Types (Dict.union types1 types2) -fromInterface : T.CEMN_Raw -> T.CEI_Interface -> Types +fromInterface : T.CEMN_Raw -> T.CEI_Interface -> T.CECTE_Types fromInterface name (T.CEI_Interface pkg _ unions aliases _) = - Types <| + T.CECTE_Types <| Dict.singleton ModuleName.toComparableCanonical (T.CEMN_Canonical pkg name) <| - Types_ (Dict.map (\_ -> I.extractUnion) unions) (Dict.map (\_ -> I.extractAlias) aliases) + T.CECTE_Types_ (Dict.map (\_ -> I.extractUnion) unions) (Dict.map (\_ -> I.extractAlias) aliases) -fromDependencyInterface : T.CEMN_Canonical -> I.DependencyInterface -> Types +fromDependencyInterface : T.CEMN_Canonical -> T.CEI_DependencyInterface -> T.CECTE_Types fromDependencyInterface home di = - Types + T.CECTE_Types (Dict.singleton ModuleName.toComparableCanonical home <| case di of - I.Public (T.CEI_Interface _ _ unions aliases _) -> - Types_ (Dict.map (\_ -> I.extractUnion) unions) (Dict.map (\_ -> I.extractAlias) aliases) + T.CEI_Public (T.CEI_Interface _ _ unions aliases _) -> + T.CECTE_Types_ (Dict.map (\_ -> I.extractUnion) unions) (Dict.map (\_ -> I.extractAlias) aliases) - I.Private _ unions aliases -> - Types_ unions aliases + T.CEI_Private _ unions aliases -> + T.CECTE_Types_ unions aliases ) @@ -138,7 +125,7 @@ fromDependencyInterface home di = -- EXTRACT MODEL, MSG, AND ANY TRANSITIVE DEPENDENCIES -fromMsg : Types -> T.CASTC_Type -> T.DebugMetadata +fromMsg : T.CECTE_Types -> T.CASTC_Type -> T.DebugMetadata fromMsg types message = let ( msgDeps, msgType ) = @@ -150,7 +137,7 @@ fromMsg types message = T.DebugMetadata msgType aliases unions -extractTransitive : Types -> Deps -> Deps -> ( List T.Alias, List T.Union ) +extractTransitive : T.CECTE_Types -> Deps -> Deps -> ( List T.Alias, List T.Union ) extractTransitive types (Deps seenAliases seenUnions) (Deps nextAliases nextUnions) = let aliases : EverySet (List String) T.CASTO_Global @@ -183,19 +170,19 @@ extractTransitive types (Deps seenAliases seenUnions) (Deps nextAliases nextUnio ( resultAlias ++ remainingResultAlias, resultUnion ++ remainingResultUnion ) -extractAlias : Types -> T.CASTO_Global -> Extractor T.Alias -extractAlias (Types dict) (T.CASTO_Global home name) = +extractAlias : T.CECTE_Types -> T.CASTO_Global -> Extractor T.Alias +extractAlias (T.CECTE_Types dict) (T.CASTO_Global home name) = let (T.CASTC_Alias args aliasType) = Utils.find ModuleName.toComparableCanonical home dict - |> (\(Types_ _ aliasInfo) -> aliasInfo) + |> (\(T.CECTE_Types_ _ aliasInfo) -> aliasInfo) |> Utils.find identity name in fmap (T.Alias (toPublicName home name) args) (extract aliasType) -extractUnion : Types -> T.CASTO_Global -> Extractor T.Union -extractUnion (Types dict) (T.CASTO_Global home name) = +extractUnion : T.CECTE_Types -> T.CASTO_Global -> Extractor T.Union +extractUnion (T.CECTE_Types dict) (T.CASTO_Global home name) = if name == Name.list && home == ModuleName.list then pure <| T.Union (toPublicName home name) [ "a" ] [] @@ -207,7 +194,7 @@ extractUnion (Types dict) (T.CASTO_Global home name) = (T.CASTC_Union vars ctors _ _) = Utils.find ModuleName.toComparableCanonical home dict - |> (\(Types_ unionInfo _) -> unionInfo) + |> (\(T.CECTE_Types_ unionInfo _) -> unionInfo) |> Utils.find identity name in fmap (T.Union pname vars) (traverse extractCtor ctors) @@ -315,18 +302,18 @@ tupleTraverse f ( a, b ) = -- ENCODERS and DECODERS -typesEncoder : Types -> Encode.Value -typesEncoder (Types types) = +typesEncoder : T.CECTE_Types -> Encode.Value +typesEncoder (T.CECTE_Types types) = E.assocListDict ModuleName.compareCanonical ModuleName.canonicalEncoder types_Encoder types -typesDecoder : Decode.Decoder Types +typesDecoder : Decode.Decoder T.CECTE_Types typesDecoder = - Decode.map Types (D.assocListDict ModuleName.toComparableCanonical ModuleName.canonicalDecoder types_Decoder) + Decode.map T.CECTE_Types (D.assocListDict ModuleName.toComparableCanonical ModuleName.canonicalDecoder types_Decoder) -types_Encoder : Types_ -> Encode.Value -types_Encoder (Types_ unionInfo aliasInfo) = +types_Encoder : T.CECTE_Types_ -> Encode.Value +types_Encoder (T.CECTE_Types_ unionInfo aliasInfo) = Encode.object [ ( "type", Encode.string "Types_" ) , ( "unionInfo", E.assocListDict compare Encode.string Can.unionEncoder unionInfo ) @@ -334,8 +321,8 @@ types_Encoder (Types_ unionInfo aliasInfo) = ] -types_Decoder : Decode.Decoder Types_ +types_Decoder : Decode.Decoder T.CECTE_Types_ types_Decoder = - Decode.map2 Types_ + Decode.map2 T.CECTE_Types_ (Decode.field "unionInfo" (D.assocListDict identity Decode.string Can.unionDecoder)) (Decode.field "aliasInfo" (D.assocListDict identity Decode.string Can.aliasDecoder)) diff --git a/src/Compiler/Elm/Constraint.elm b/src/Compiler/Elm/Constraint.elm index ba29d900a..cd337e526 100644 --- a/src/Compiler/Elm/Constraint.elm +++ b/src/Compiler/Elm/Constraint.elm @@ -26,7 +26,7 @@ import Types as T type Constraint - = Range V.Version Op Op V.Version + = Range T.CEV_Version Op Op T.CEV_Version type Op @@ -38,7 +38,7 @@ type Op -- COMMON CONSTRAINTS -exactly : V.Version -> Constraint +exactly : T.CEV_Version -> Constraint exactly version = Range version LessOrEqual LessOrEqual version @@ -73,7 +73,7 @@ opToChars op = -- IS SATISFIED -satisfies : Constraint -> V.Version -> Bool +satisfies : Constraint -> T.CEV_Version -> Bool satisfies constraint version = case constraint of Range lower lowerOp upperOp upper -> @@ -81,7 +81,7 @@ satisfies constraint version = && isLess upperOp version upper -isLess : Op -> (V.Version -> V.Version -> Bool) +isLess : Op -> (T.CEV_Version -> T.CEV_Version -> Bool) isLess op = case op of Less -> @@ -153,7 +153,7 @@ goodElm constraint = defaultElm : Constraint defaultElm = let - (V.Version major _ _) = + (T.CEV_Version major _ _) = V.compiler in if major > 0 then @@ -167,12 +167,12 @@ defaultElm = -- CREATE CONSTRAINTS -untilNextMajor : V.Version -> Constraint +untilNextMajor : T.CEV_Version -> Constraint untilNextMajor version = Range version LessOrEqual Less (V.bumpMajor version) -untilNextMinor : V.Version -> Constraint +untilNextMinor : T.CEV_Version -> Constraint untilNextMinor version = Range version LessOrEqual Less (V.bumpMinor version) @@ -197,7 +197,7 @@ decoder = type Error = BadFormat T.CPP_Row T.CPP_Col - | InvalidRange V.Version V.Version + | InvalidRange T.CEV_Version T.CEV_Version parser : P.Parser Error Constraint @@ -247,7 +247,7 @@ parser = ) -parseVersion : P.Parser Error V.Version +parseVersion : P.Parser Error T.CEV_Version parseVersion = P.specialize (\( r, c ) _ _ -> BadFormat r c) V.parser diff --git a/src/Compiler/Elm/Interface.elm b/src/Compiler/Elm/Interface.elm index 0de75b00a..111684c12 100644 --- a/src/Compiler/Elm/Interface.elm +++ b/src/Compiler/Elm/Interface.elm @@ -1,6 +1,5 @@ module Compiler.Elm.Interface exposing - ( DependencyInterface(..) - , dependencyInterfaceDecoder + ( dependencyInterfaceDecoder , dependencyInterfaceEncoder , extractAlias , extractUnion @@ -128,19 +127,14 @@ toPublicAlias iAlias = -- DEPENDENCY INTERFACE -type DependencyInterface - = Public T.CEI_Interface - | Private T.CEP_Name (Dict String T.CDN_Name T.CASTC_Union) (Dict String T.CDN_Name T.CASTC_Alias) - - -public : T.CEI_Interface -> DependencyInterface +public : T.CEI_Interface -> T.CEI_DependencyInterface public = - Public + T.CEI_Public -private : T.CEI_Interface -> DependencyInterface +private : T.CEI_Interface -> T.CEI_DependencyInterface private (T.CEI_Interface pkg _ unions aliases _) = - Private pkg (Dict.map (\_ -> extractUnion) unions) (Dict.map (\_ -> extractAlias) aliases) + T.CEI_Private pkg (Dict.map (\_ -> extractUnion) unions) (Dict.map (\_ -> extractAlias) aliases) extractUnion : T.CEI_Union -> T.CASTC_Union @@ -166,13 +160,13 @@ extractAlias iAlias = alias -privatize : DependencyInterface -> DependencyInterface +privatize : T.CEI_DependencyInterface -> T.CEI_DependencyInterface privatize di = case di of - Public i -> + T.CEI_Public i -> private i - Private _ _ _ -> + T.CEI_Private _ _ _ -> di @@ -302,16 +296,16 @@ binopDecoder = (Decode.field "precedence" Binop.precedenceDecoder) -dependencyInterfaceEncoder : DependencyInterface -> Encode.Value +dependencyInterfaceEncoder : T.CEI_DependencyInterface -> Encode.Value dependencyInterfaceEncoder dependencyInterface = case dependencyInterface of - Public i -> + T.CEI_Public i -> Encode.object [ ( "type", Encode.string "Public" ) , ( "i", interfaceEncoder i ) ] - Private pkg unions aliases -> + T.CEI_Private pkg unions aliases -> Encode.object [ ( "type", Encode.string "Private" ) , ( "pkg", Pkg.nameEncoder pkg ) @@ -320,17 +314,17 @@ dependencyInterfaceEncoder dependencyInterface = ] -dependencyInterfaceDecoder : Decode.Decoder DependencyInterface +dependencyInterfaceDecoder : Decode.Decoder T.CEI_DependencyInterface dependencyInterfaceDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "Public" -> - Decode.map Public (Decode.field "i" interfaceDecoder) + Decode.map T.CEI_Public (Decode.field "i" interfaceDecoder) "Private" -> - Decode.map3 Private + Decode.map3 T.CEI_Private (Decode.field "pkg" Pkg.nameDecoder) (Decode.field "unions" (D.assocListDict identity Decode.string Can.unionDecoder)) (Decode.field "aliases" (D.assocListDict identity Decode.string Can.aliasDecoder)) diff --git a/src/Compiler/Elm/Version.elm b/src/Compiler/Elm/Version.elm index e6db48a64..fed0977b5 100644 --- a/src/Compiler/Elm/Version.elm +++ b/src/Compiler/Elm/Version.elm @@ -1,6 +1,5 @@ module Compiler.Elm.Version exposing - ( Version(..) - , bumpMajor + ( bumpMajor , bumpMinor , bumpPatch , compare @@ -33,17 +32,13 @@ import Types as T -- VERSION -type Version - = Version Int Int Int - - -major : Version -> Int -major (Version major_ _ _) = +major : T.CEV_Version -> Int +major (T.CEV_Version major_ _ _) = major_ -compare : Version -> Version -> Order -compare (Version major1 minor1 patch1) (Version major2 minor2 patch2) = +compare : T.CEV_Version -> T.CEV_Version -> Order +compare (T.CEV_Version major1 minor1 patch1) (T.CEV_Version major2 minor2 patch2) = case Basics.compare major1 major2 of EQ -> case Basics.compare minor1 minor2 of @@ -57,12 +52,12 @@ compare (Version major1 minor1 patch1) (Version major2 minor2 patch2) = majorRes -toComparable : Version -> ( Int, Int, Int ) -toComparable (Version major_ minor_ patch_) = +toComparable : T.CEV_Version -> ( Int, Int, Int ) +toComparable (T.CEV_Version major_ minor_ patch_) = ( major_, minor_, patch_ ) -min : Version -> Version -> Version +min : T.CEV_Version -> T.CEV_Version -> T.CEV_Version min v1 v2 = case compare v1 v2 of GT -> @@ -72,7 +67,7 @@ min v1 v2 = v1 -max : Version -> Version -> Version +max : T.CEV_Version -> T.CEV_Version -> T.CEV_Version max v1 v2 = case compare v1 v2 of LT -> @@ -82,17 +77,17 @@ max v1 v2 = v1 -one : Version +one : T.CEV_Version one = - Version 1 0 0 + T.CEV_Version 1 0 0 -maxVersion : Version +maxVersion : T.CEV_Version maxVersion = - Version 2147483647 0 0 + T.CEV_Version 2147483647 0 0 -compiler : Version +compiler : T.CEV_Version compiler = -- case map fromIntegral (Version.versionBranch Paths_elm.version) of -- major : minor : patch : _ -> @@ -103,34 +98,34 @@ compiler = -- Version major 0 0 -- [] -> -- error "could not detect version of elm-compiler you are using" - Version 0 19 1 + T.CEV_Version 0 19 1 -- BUMP -bumpPatch : Version -> Version -bumpPatch (Version major_ minor patch) = - Version major_ minor (patch + 1) +bumpPatch : T.CEV_Version -> T.CEV_Version +bumpPatch (T.CEV_Version major_ minor patch) = + T.CEV_Version major_ minor (patch + 1) -bumpMinor : Version -> Version -bumpMinor (Version major_ minor _) = - Version major_ (minor + 1) 0 +bumpMinor : T.CEV_Version -> T.CEV_Version +bumpMinor (T.CEV_Version major_ minor _) = + T.CEV_Version major_ (minor + 1) 0 -bumpMajor : Version -> Version -bumpMajor (Version major_ _ _) = - Version (major_ + 1) 0 0 +bumpMajor : T.CEV_Version -> T.CEV_Version +bumpMajor (T.CEV_Version major_ _ _) = + T.CEV_Version (major_ + 1) 0 0 -- TO CHARS -toChars : Version -> String -toChars (Version major_ minor patch) = +toChars : T.CEV_Version -> String +toChars (T.CEV_Version major_ minor patch) = String.fromInt major_ ++ "." ++ String.fromInt minor ++ "." ++ String.fromInt patch @@ -138,12 +133,12 @@ toChars (Version major_ minor patch) = -- JSON -decoder : D.Decoder ( T.CPP_Row, T.CPP_Col ) Version +decoder : D.Decoder ( T.CPP_Row, T.CPP_Col ) T.CEV_Version decoder = D.customString parser Tuple.pair -encode : Version -> E.Value +encode : T.CEV_Version -> E.Value encode version = E.string (toChars version) @@ -152,7 +147,7 @@ encode version = -- PARSER -parser : P.Parser ( T.CPP_Row, T.CPP_Col ) Version +parser : P.Parser ( T.CPP_Row, T.CPP_Col ) T.CEV_Version parser = numberParser |> P.bind @@ -165,7 +160,7 @@ parser = |> P.bind (\_ -> numberParser) |> P.fmap (\patch -> - Version major_ minor patch + T.CEV_Version major_ minor patch ) ) ) @@ -234,7 +229,7 @@ isDigit word = -- ENCODERS and DECODERS -jsonDecoder : Decode.Decoder Version +jsonDecoder : Decode.Decoder T.CEV_Version jsonDecoder = Decode.string |> Decode.andThen @@ -248,8 +243,8 @@ jsonDecoder = ) -versionEncoder : Version -> Encode.Value -versionEncoder (Version major_ minor_ patch_) = +versionEncoder : T.CEV_Version -> Encode.Value +versionEncoder (T.CEV_Version major_ minor_ patch_) = Encode.object [ ( "type", Encode.string "Version" ) , ( "major", Encode.int major_ ) @@ -258,14 +253,14 @@ versionEncoder (Version major_ minor_ patch_) = ] -versionDecoder : Decode.Decoder Version +versionDecoder : Decode.Decoder T.CEV_Version versionDecoder = - Decode.map3 Version + Decode.map3 T.CEV_Version (Decode.field "major" Decode.int) (Decode.field "minor" Decode.int) (Decode.field "patch" Decode.int) -jsonEncoder : Version -> Encode.Value +jsonEncoder : T.CEV_Version -> Encode.Value jsonEncoder version = Encode.string (toChars version) diff --git a/src/Compiler/Generate/Mode.elm b/src/Compiler/Generate/Mode.elm index 7ebf62f53..bceeac9b2 100644 --- a/src/Compiler/Generate/Mode.elm +++ b/src/Compiler/Generate/Mode.elm @@ -5,7 +5,6 @@ module Compiler.Generate.Mode exposing , shortenFieldNames ) -import Compiler.Elm.Compiler.Type.Extract as Extract import Compiler.Generate.JavaScript.Name as JsName import Data.Map as Dict exposing (Dict) import Types as T @@ -17,7 +16,7 @@ import Utils.Main as Utils type Mode - = Dev (Maybe Extract.Types) + = Dev (Maybe T.CECTE_Types) | Prod ShortFieldNames diff --git a/src/Compiler/Reporting/Doc.elm b/src/Compiler/Reporting/Doc.elm index eb7a33b0c..664db62e8 100644 --- a/src/Compiler/Reporting/Doc.elm +++ b/src/Compiler/Reporting/Doc.elm @@ -60,7 +60,7 @@ fromName = P.text -fromVersion : V.Version -> Doc +fromVersion : T.CEV_Version -> Doc fromVersion vsn = P.text (V.toChars vsn) diff --git a/src/System/IO.elm b/src/System/IO.elm index 2cce8a13c..a768ecb96 100644 --- a/src/System/IO.elm +++ b/src/System/IO.elm @@ -13,8 +13,16 @@ port module System.IO exposing , ReplState(..), initialReplState , MVarSubscriber(..) , MVarSubscriber_Maybe_BED_Status(..) + , MVarSubscriber_Maybe_BED_DResult(..) , MVarSubscriber_Maybe_CASTO_GlobalGraph(..) , MVarSubscriber_Maybe_CASTO_LocalGraph(..) + , MVarSubscriber_BB_BResult(..) + , MVarSubscriber_BB_Status(..) + , MVarSubscriber_BB_StatusDict(..) + , MVarSubscriber_ResultRegistryProblemEnv(..) + , MVarSubscriber_CED_Dep(..) + , MVarSubscriber_Maybe_CECTE_Types(..) + , MVarSubscriber_Maybe_BB_Dependencies(..) ) {-| Ref.: @@ -81,8 +89,16 @@ port module System.IO exposing @docs MVarSubscriber @docs MVarSubscriber_Maybe_BED_Status +@docs MVarSubscriber_Maybe_BED_DResult @docs MVarSubscriber_Maybe_CASTO_GlobalGraph @docs MVarSubscriber_Maybe_CASTO_LocalGraph +@docs MVarSubscriber_BB_BResult +@docs MVarSubscriber_BB_Status +@docs MVarSubscriber_BB_StatusDict +@docs MVarSubscriber_ResultRegistryProblemEnv +@docs MVarSubscriber_CED_Dep +@docs MVarSubscriber_Maybe_CECTE_Types +@docs MVarSubscriber_Maybe_BB_Dependencies -} @@ -121,8 +137,16 @@ run app = , state = initialReplState , mVars = Array.empty , mVars_Maybe_BED_Status = Array.empty + , mVars_Maybe_BED_DResult = Array.empty , mVars_Maybe_CASTO_LocalGraph = Array.empty , mVars_Maybe_CASTO_GlobalGraph = Array.empty + , mVars_BB_BResult = Array.empty + , mVars_BB_Status = Array.empty + , mVars_BB_StatusDict = Array.empty + , mVars_ResultRegistryProblemEnv = Array.empty + , mVars_CED_Dep = Array.empty + , mVars_Maybe_CECTE_Types = Array.empty + , mVars_Maybe_BB_Dependencies = Array.empty , next = Dict.empty } , update = update @@ -204,6 +228,10 @@ type Next | NewEmptyMVarNext_Maybe_BED_Status (Int -> IO ()) | ReadMVarNext_Maybe_BED_Status (Maybe T.BED_Status -> IO ()) | PutMVarNext_Maybe_BED_Status (() -> IO ()) + -- MVars (Maybe T.BED_DResult) + | NewEmptyMVarNext_Maybe_BED_DResult (Int -> IO ()) + | ReadMVarNext_Maybe_BED_DResult (Maybe T.BED_DResult -> IO ()) + | PutMVarNext_Maybe_BED_DResult (() -> IO ()) -- MVars (Maybe T.CASTO_LocalGraph) | NewEmptyMVarNext_Maybe_CASTO_LocalGraph (Int -> IO ()) | ReadMVarNext_Maybe_CASTO_LocalGraph (Maybe T.CASTO_LocalGraph -> IO ()) @@ -212,6 +240,39 @@ type Next | NewEmptyMVarNext_Maybe_CASTO_GlobalGraph (Int -> IO ()) | ReadMVarNext_Maybe_CASTO_GlobalGraph (Maybe T.CASTO_GlobalGraph -> IO ()) | PutMVarNext_Maybe_CASTO_GlobalGraph (() -> IO ()) + -- MVars (T.BB_BResult) + | NewEmptyMVarNext_BB_BResult (Int -> IO ()) + | ReadMVarNext_BB_BResult (T.BB_BResult -> IO ()) + | PutMVarNext_BB_BResult (() -> IO ()) + -- MVars (T.BB_Status) + | NewEmptyMVarNext_BB_Status (Int -> IO ()) + | ReadMVarNext_BB_Status (T.BB_Status -> IO ()) + | PutMVarNext_BB_Status (() -> IO ()) + -- MVars (T.BB_StatusDict) + | NewEmptyMVarNext_BB_StatusDict (Int -> IO ()) + | ReadMVarNext_BB_StatusDict (T.BB_StatusDict -> IO ()) + | TakeMVarNext_BB_StatusDict (T.BB_StatusDict -> IO ()) + | PutMVarNext_BB_StatusDict (() -> IO ()) + -- MVars (Result T.BRE_RegistryProblem T.BDS_Env) + | NewEmptyMVarNext_ResultRegistryProblemEnv (Int -> IO ()) + | ReadMVarNext_ResultRegistryProblemEnv (Result T.BRE_RegistryProblem T.BDS_Env -> IO ()) + | TakeMVarNext_ResultRegistryProblemEnv (Result T.BRE_RegistryProblem T.BDS_Env -> IO ()) + | PutMVarNext_ResultRegistryProblemEnv (() -> IO ()) + -- MVars (Result T.BRE_RegistryProblem T.BDS_Env) + | NewEmptyMVarNext_CED_Dep (Int -> IO ()) + | ReadMVarNext_CED_Dep (T.CED_Dep -> IO ()) + | TakeMVarNext_CED_Dep (T.CED_Dep -> IO ()) + | PutMVarNext_CED_Dep (() -> IO ()) + -- MVars (Maybe T.CECTE_Types) + | NewEmptyMVarNext_Maybe_CECTE_Types (Int -> IO ()) + | ReadMVarNext_Maybe_CECTE_Types (Maybe T.CECTE_Types -> IO ()) + | TakeMVarNext_Maybe_CECTE_Types (Maybe T.CECTE_Types -> IO ()) + | PutMVarNext_Maybe_CECTE_Types (() -> IO ()) + -- MVars (Maybe T.BB_Dependencies) + | NewEmptyMVarNext_Maybe_BB_Dependencies (Int -> IO ()) + | ReadMVarNext_Maybe_BB_Dependencies (Maybe T.BB_Dependencies -> IO ()) + | TakeMVarNext_Maybe_BB_Dependencies (Maybe T.BB_Dependencies -> IO ()) + | PutMVarNext_Maybe_BB_Dependencies (() -> IO ()) type Msg @@ -252,6 +313,10 @@ type Msg | NewEmptyMVarMsg_Maybe_BED_Status Int Int | ReadMVarMsg_Maybe_BED_Status Int (Maybe T.BED_Status) | PutMVarMsg_Maybe_BED_Status Int + -- MVars (Maybe T.BED_DResult) + | NewEmptyMVarMsg_Maybe_BED_DResult Int Int + | ReadMVarMsg_Maybe_BED_DResult Int (Maybe T.BED_DResult) + | PutMVarMsg_Maybe_BED_DResult Int -- MVars (Maybe T.CASTO_LocalGraph) | NewEmptyMVarMsg_Maybe_CASTO_LocalGraph Int Int | ReadMVarMsg_Maybe_CASTO_LocalGraph Int (Maybe T.CASTO_LocalGraph) @@ -260,6 +325,34 @@ type Msg | NewEmptyMVarMsg_Maybe_CASTO_GlobalGraph Int Int | ReadMVarMsg_Maybe_CASTO_GlobalGraph Int (Maybe T.CASTO_GlobalGraph) | PutMVarMsg_Maybe_CASTO_GlobalGraph Int + -- MVars (T.BB_BResult) + | NewEmptyMVarMsg_BB_BResult Int Int + | ReadMVarMsg_BB_BResult Int T.BB_BResult + | PutMVarMsg_BB_BResult Int + -- MVars (T.BB_Status) + | NewEmptyMVarMsg_BB_Status Int Int + | ReadMVarMsg_BB_Status Int T.BB_Status + | PutMVarMsg_BB_Status Int + -- MVars (T.BB_StatusDict) + | NewEmptyMVarMsg_BB_StatusDict Int Int + | ReadMVarMsg_BB_StatusDict Int T.BB_StatusDict + | PutMVarMsg_BB_StatusDict Int + -- MVars (Result T.BRE_RegistryProblem T.BDS_Env) + | NewEmptyMVarMsg_ResultRegistryProblemEnv Int Int + | ReadMVarMsg_ResultRegistryProblemEnv Int (Result T.BRE_RegistryProblem T.BDS_Env) + | PutMVarMsg_ResultRegistryProblemEnv Int + -- MVars (T.CED_Dep) + | NewEmptyMVarMsg_CED_Dep Int Int + | ReadMVarMsg_CED_Dep Int T.CED_Dep + | PutMVarMsg_CED_Dep Int + -- MVars (Maybe T.CECTE_Types) + | NewEmptyMVarMsg_Maybe_CECTE_Types Int Int + | ReadMVarMsg_Maybe_CECTE_Types Int (Maybe T.CECTE_Types) + | PutMVarMsg_Maybe_CECTE_Types Int + -- MVars (Maybe T.BB_Dependencies) + | NewEmptyMVarMsg_Maybe_BB_Dependencies Int Int + | ReadMVarMsg_Maybe_BB_Dependencies Int (Maybe T.BB_Dependencies) + | PutMVarMsg_Maybe_BB_Dependencies Int update : Msg -> Model -> ( Model, Cmd Msg ) @@ -441,6 +534,28 @@ update msg model = ( newRealWorld, PutMVar_Maybe_BED_Status next _ Nothing ) -> update (PutMVarMsg_Maybe_BED_Status index) { newRealWorld | next = Dict.insert index (PutMVarNext_Maybe_BED_Status next) model.next } + -- MVars (Maybe T.BED_DResult) + ( newRealWorld, NewEmptyMVar_Maybe_BED_DResult next value ) -> + update (NewEmptyMVarMsg_Maybe_BED_DResult index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_Maybe_BED_DResult next) model.next } + + ( newRealWorld, ReadMVar_Maybe_BED_DResult next (Just value) ) -> + update (ReadMVarMsg_Maybe_BED_DResult index value) { newRealWorld | next = Dict.insert index (ReadMVarNext_Maybe_BED_DResult next) model.next } + + ( newRealWorld, ReadMVar_Maybe_BED_DResult next Nothing ) -> + ( { newRealWorld | next = Dict.insert index (ReadMVarNext_Maybe_BED_DResult next) model.next }, Cmd.none ) + + ( newRealWorld, PutMVar_Maybe_BED_DResult next readIndexes (Just value) ) -> + List.foldl + (\readIndex ( updatedModel, updateCmd ) -> + update (ReadMVarMsg_Maybe_BED_DResult readIndex value) updatedModel + |> Tuple.mapSecond (\cmd -> Cmd.batch [ updateCmd, cmd ]) + ) + (update (PutMVarMsg_Maybe_BED_DResult index) { newRealWorld | next = Dict.insert index (PutMVarNext_Maybe_BED_DResult next) model.next }) + readIndexes + + ( newRealWorld, PutMVar_Maybe_BED_DResult next _ Nothing ) -> + update (PutMVarMsg_Maybe_BED_DResult index) { newRealWorld | next = Dict.insert index (PutMVarNext_Maybe_BED_DResult next) model.next } + -- MVars (Maybe T.CASTO_LocalGraph) ( newRealWorld, NewEmptyMVar_Maybe_CASTO_LocalGraph next value ) -> update (NewEmptyMVarMsg_Maybe_CASTO_LocalGraph index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_Maybe_CASTO_LocalGraph next) model.next } @@ -485,6 +600,200 @@ update msg model = ( newRealWorld, PutMVar_Maybe_CASTO_GlobalGraph next _ Nothing ) -> update (PutMVarMsg_Maybe_CASTO_GlobalGraph index) { newRealWorld | next = Dict.insert index (PutMVarNext_Maybe_CASTO_GlobalGraph next) model.next } + -- MVars (T.BB_BResult) + ( newRealWorld, NewEmptyMVar_BB_BResult next value ) -> + update (NewEmptyMVarMsg_BB_BResult index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_BB_BResult next) model.next } + + ( newRealWorld, ReadMVar_BB_BResult next (Just value) ) -> + update (ReadMVarMsg_BB_BResult index value) { newRealWorld | next = Dict.insert index (ReadMVarNext_BB_BResult next) model.next } + + ( newRealWorld, ReadMVar_BB_BResult next Nothing ) -> + ( { newRealWorld | next = Dict.insert index (ReadMVarNext_BB_BResult next) model.next }, Cmd.none ) + + ( newRealWorld, PutMVar_BB_BResult next readIndexes (Just value) ) -> + List.foldl + (\readIndex ( updatedModel, updateCmd ) -> + update (ReadMVarMsg_BB_BResult readIndex value) updatedModel + |> Tuple.mapSecond (\cmd -> Cmd.batch [ updateCmd, cmd ]) + ) + (update (PutMVarMsg_BB_BResult index) { newRealWorld | next = Dict.insert index (PutMVarNext_BB_BResult next) model.next }) + readIndexes + + ( newRealWorld, PutMVar_BB_BResult next _ Nothing ) -> + update (PutMVarMsg_BB_BResult index) { newRealWorld | next = Dict.insert index (PutMVarNext_BB_BResult next) model.next } + + -- MVars (T.BB_Status) + ( newRealWorld, NewEmptyMVar_BB_Status next value ) -> + update (NewEmptyMVarMsg_BB_Status index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_BB_Status next) model.next } + + ( newRealWorld, ReadMVar_BB_Status next (Just value) ) -> + update (ReadMVarMsg_BB_Status index value) { newRealWorld | next = Dict.insert index (ReadMVarNext_BB_Status next) model.next } + + ( newRealWorld, ReadMVar_BB_Status next Nothing ) -> + ( { newRealWorld | next = Dict.insert index (ReadMVarNext_BB_Status next) model.next }, Cmd.none ) + + ( newRealWorld, PutMVar_BB_Status next readIndexes (Just value) ) -> + List.foldl + (\readIndex ( updatedModel, updateCmd ) -> + update (ReadMVarMsg_BB_Status readIndex value) updatedModel + |> Tuple.mapSecond (\cmd -> Cmd.batch [ updateCmd, cmd ]) + ) + (update (PutMVarMsg_BB_Status index) { newRealWorld | next = Dict.insert index (PutMVarNext_BB_Status next) model.next }) + readIndexes + + ( newRealWorld, PutMVar_BB_Status next _ Nothing ) -> + update (PutMVarMsg_BB_Status index) { newRealWorld | next = Dict.insert index (PutMVarNext_BB_Status next) model.next } + + -- MVars (T.BB_StatusDict) + ( newRealWorld, NewEmptyMVar_BB_StatusDict next value ) -> + update (NewEmptyMVarMsg_BB_StatusDict index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_BB_StatusDict next) model.next } + + ( newRealWorld, ReadMVar_BB_StatusDict next (Just value) ) -> + update (ReadMVarMsg_BB_StatusDict index value) { newRealWorld | next = Dict.insert index (ReadMVarNext_BB_StatusDict next) model.next } + + ( newRealWorld, ReadMVar_BB_StatusDict next Nothing ) -> + ( { newRealWorld | next = Dict.insert index (ReadMVarNext_BB_StatusDict next) model.next }, Cmd.none ) + + ( newRealWorld, TakeMVar_BB_StatusDict next (Just value) maybePutIndex ) -> + update (ReadMVarMsg_BB_StatusDict index value) { newRealWorld | next = Dict.insert index (TakeMVarNext_BB_StatusDict next) model.next } + |> updatePutIndex maybePutIndex + + ( newRealWorld, TakeMVar_BB_StatusDict next Nothing maybePutIndex ) -> + ( { newRealWorld | next = Dict.insert index (TakeMVarNext_BB_StatusDict next) model.next }, Cmd.none ) + |> updatePutIndex maybePutIndex + + ( newRealWorld, PutMVar_BB_StatusDict next readIndexes (Just value) ) -> + List.foldl + (\readIndex ( updatedModel, updateCmd ) -> + update (ReadMVarMsg_BB_StatusDict readIndex value) updatedModel + |> Tuple.mapSecond (\cmd -> Cmd.batch [ updateCmd, cmd ]) + ) + (update (PutMVarMsg_BB_StatusDict index) { newRealWorld | next = Dict.insert index (PutMVarNext_BB_StatusDict next) model.next }) + readIndexes + + ( newRealWorld, PutMVar_BB_StatusDict next _ Nothing ) -> + update (PutMVarMsg_BB_StatusDict index) { newRealWorld | next = Dict.insert index (PutMVarNext_BB_StatusDict next) model.next } + + -- MVars (Result T.BRE_RegistryProblem T.BDS_Env) + ( newRealWorld, NewEmptyMVar_ResultRegistryProblemEnv next value ) -> + update (NewEmptyMVarMsg_ResultRegistryProblemEnv index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_ResultRegistryProblemEnv next) model.next } + + ( newRealWorld, ReadMVar_ResultRegistryProblemEnv next (Just value) ) -> + update (ReadMVarMsg_ResultRegistryProblemEnv index value) { newRealWorld | next = Dict.insert index (ReadMVarNext_ResultRegistryProblemEnv next) model.next } + + ( newRealWorld, ReadMVar_ResultRegistryProblemEnv next Nothing ) -> + ( { newRealWorld | next = Dict.insert index (ReadMVarNext_ResultRegistryProblemEnv next) model.next }, Cmd.none ) + + ( newRealWorld, TakeMVar_ResultRegistryProblemEnv next (Just value) maybePutIndex ) -> + update (ReadMVarMsg_ResultRegistryProblemEnv index value) { newRealWorld | next = Dict.insert index (TakeMVarNext_ResultRegistryProblemEnv next) model.next } + |> updatePutIndex maybePutIndex + + ( newRealWorld, TakeMVar_ResultRegistryProblemEnv next Nothing maybePutIndex ) -> + ( { newRealWorld | next = Dict.insert index (TakeMVarNext_ResultRegistryProblemEnv next) model.next }, Cmd.none ) + |> updatePutIndex maybePutIndex + + ( newRealWorld, PutMVar_ResultRegistryProblemEnv next readIndexes (Just value) ) -> + List.foldl + (\readIndex ( updatedModel, updateCmd ) -> + update (ReadMVarMsg_ResultRegistryProblemEnv readIndex value) updatedModel + |> Tuple.mapSecond (\cmd -> Cmd.batch [ updateCmd, cmd ]) + ) + (update (PutMVarMsg_ResultRegistryProblemEnv index) { newRealWorld | next = Dict.insert index (PutMVarNext_ResultRegistryProblemEnv next) model.next }) + readIndexes + + ( newRealWorld, PutMVar_ResultRegistryProblemEnv next _ Nothing ) -> + update (PutMVarMsg_ResultRegistryProblemEnv index) { newRealWorld | next = Dict.insert index (PutMVarNext_ResultRegistryProblemEnv next) model.next } + + -- MVars (T.CED_Dep) + ( newRealWorld, NewEmptyMVar_CED_Dep next value ) -> + update (NewEmptyMVarMsg_CED_Dep index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_CED_Dep next) model.next } + + ( newRealWorld, ReadMVar_CED_Dep next (Just value) ) -> + update (ReadMVarMsg_CED_Dep index value) { newRealWorld | next = Dict.insert index (ReadMVarNext_CED_Dep next) model.next } + + ( newRealWorld, ReadMVar_CED_Dep next Nothing ) -> + ( { newRealWorld | next = Dict.insert index (ReadMVarNext_CED_Dep next) model.next }, Cmd.none ) + + ( newRealWorld, TakeMVar_CED_Dep next (Just value) maybePutIndex ) -> + update (ReadMVarMsg_CED_Dep index value) { newRealWorld | next = Dict.insert index (TakeMVarNext_CED_Dep next) model.next } + |> updatePutIndex maybePutIndex + + ( newRealWorld, TakeMVar_CED_Dep next Nothing maybePutIndex ) -> + ( { newRealWorld | next = Dict.insert index (TakeMVarNext_CED_Dep next) model.next }, Cmd.none ) + |> updatePutIndex maybePutIndex + + ( newRealWorld, PutMVar_CED_Dep next readIndexes (Just value) ) -> + List.foldl + (\readIndex ( updatedModel, updateCmd ) -> + update (ReadMVarMsg_CED_Dep readIndex value) updatedModel + |> Tuple.mapSecond (\cmd -> Cmd.batch [ updateCmd, cmd ]) + ) + (update (PutMVarMsg_CED_Dep index) { newRealWorld | next = Dict.insert index (PutMVarNext_CED_Dep next) model.next }) + readIndexes + + ( newRealWorld, PutMVar_CED_Dep next _ Nothing ) -> + update (PutMVarMsg_CED_Dep index) { newRealWorld | next = Dict.insert index (PutMVarNext_CED_Dep next) model.next } + + -- MVars (Maybe T.CECTE_Types) + ( newRealWorld, NewEmptyMVar_Maybe_CECTE_Types next value ) -> + update (NewEmptyMVarMsg_Maybe_CECTE_Types index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_Maybe_CECTE_Types next) model.next } + + ( newRealWorld, ReadMVar_Maybe_CECTE_Types next (Just value) ) -> + update (ReadMVarMsg_Maybe_CECTE_Types index value) { newRealWorld | next = Dict.insert index (ReadMVarNext_Maybe_CECTE_Types next) model.next } + + ( newRealWorld, ReadMVar_Maybe_CECTE_Types next Nothing ) -> + ( { newRealWorld | next = Dict.insert index (ReadMVarNext_Maybe_CECTE_Types next) model.next }, Cmd.none ) + + ( newRealWorld, TakeMVar_Maybe_CECTE_Types next (Just value) maybePutIndex ) -> + update (ReadMVarMsg_Maybe_CECTE_Types index value) { newRealWorld | next = Dict.insert index (TakeMVarNext_Maybe_CECTE_Types next) model.next } + |> updatePutIndex maybePutIndex + + ( newRealWorld, TakeMVar_Maybe_CECTE_Types next Nothing maybePutIndex ) -> + ( { newRealWorld | next = Dict.insert index (TakeMVarNext_Maybe_CECTE_Types next) model.next }, Cmd.none ) + |> updatePutIndex maybePutIndex + + ( newRealWorld, PutMVar_Maybe_CECTE_Types next readIndexes (Just value) ) -> + List.foldl + (\readIndex ( updatedModel, updateCmd ) -> + update (ReadMVarMsg_Maybe_CECTE_Types readIndex value) updatedModel + |> Tuple.mapSecond (\cmd -> Cmd.batch [ updateCmd, cmd ]) + ) + (update (PutMVarMsg_Maybe_CECTE_Types index) { newRealWorld | next = Dict.insert index (PutMVarNext_Maybe_CECTE_Types next) model.next }) + readIndexes + + ( newRealWorld, PutMVar_Maybe_CECTE_Types next _ Nothing ) -> + update (PutMVarMsg_Maybe_CECTE_Types index) { newRealWorld | next = Dict.insert index (PutMVarNext_Maybe_CECTE_Types next) model.next } + + -- MVars (Maybe T.BB_Dependencies) + ( newRealWorld, NewEmptyMVar_Maybe_BB_Dependencies next value ) -> + update (NewEmptyMVarMsg_Maybe_BB_Dependencies index value) { newRealWorld | next = Dict.insert index (NewEmptyMVarNext_Maybe_BB_Dependencies next) model.next } + + ( newRealWorld, ReadMVar_Maybe_BB_Dependencies next (Just value) ) -> + update (ReadMVarMsg_Maybe_BB_Dependencies index value) { newRealWorld | next = Dict.insert index (ReadMVarNext_Maybe_BB_Dependencies next) model.next } + + ( newRealWorld, ReadMVar_Maybe_BB_Dependencies next Nothing ) -> + ( { newRealWorld | next = Dict.insert index (ReadMVarNext_Maybe_BB_Dependencies next) model.next }, Cmd.none ) + + ( newRealWorld, TakeMVar_Maybe_BB_Dependencies next (Just value) maybePutIndex ) -> + update (ReadMVarMsg_Maybe_BB_Dependencies index value) { newRealWorld | next = Dict.insert index (TakeMVarNext_Maybe_BB_Dependencies next) model.next } + |> updatePutIndex maybePutIndex + + ( newRealWorld, TakeMVar_Maybe_BB_Dependencies next Nothing maybePutIndex ) -> + ( { newRealWorld | next = Dict.insert index (TakeMVarNext_Maybe_BB_Dependencies next) model.next }, Cmd.none ) + |> updatePutIndex maybePutIndex + + ( newRealWorld, PutMVar_Maybe_BB_Dependencies next readIndexes (Just value) ) -> + List.foldl + (\readIndex ( updatedModel, updateCmd ) -> + update (ReadMVarMsg_Maybe_BB_Dependencies readIndex value) updatedModel + |> Tuple.mapSecond (\cmd -> Cmd.batch [ updateCmd, cmd ]) + ) + (update (PutMVarMsg_Maybe_BB_Dependencies index) { newRealWorld | next = Dict.insert index (PutMVarNext_Maybe_BB_Dependencies next) model.next }) + readIndexes + + ( newRealWorld, PutMVar_Maybe_BB_Dependencies next _ Nothing ) -> + update (PutMVarMsg_Maybe_BB_Dependencies index) { newRealWorld | next = Dict.insert index (PutMVarNext_Maybe_BB_Dependencies next) model.next } + GetLineMsg index input -> case Dict.get index model.next of Just (GetLineNext fn) -> @@ -762,6 +1071,31 @@ update msg model = _ -> crash "PutMVarMsg_Maybe_BED_Status" + -- MVars (Maybe T.BED_DResult) + NewEmptyMVarMsg_Maybe_BED_DResult index value -> + case Dict.get index model.next of + Just (NewEmptyMVarNext_Maybe_BED_DResult fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "NewEmptyMVarMsg_Maybe_BED_DResult" + + ReadMVarMsg_Maybe_BED_DResult index value -> + case Dict.get index model.next of + Just (ReadMVarNext_Maybe_BED_DResult fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "ReadMVarMsg_Maybe_BED_DResult" + + PutMVarMsg_Maybe_BED_DResult index -> + case Dict.get index model.next of + Just (PutMVarNext_Maybe_BED_DResult fn) -> + update (PureMsg index (fn ())) model + + _ -> + crash "PutMVarMsg_Maybe_BED_DResult" + -- MVars (Maybe T.CASTO_LocalGraph) NewEmptyMVarMsg_Maybe_CASTO_LocalGraph index value -> case Dict.get index model.next of @@ -812,6 +1146,196 @@ update msg model = _ -> crash "PutMVarMsg_Maybe_CASTO_GlobalGraph" + -- MVars (T.BB_BResult) + NewEmptyMVarMsg_BB_BResult index value -> + case Dict.get index model.next of + Just (NewEmptyMVarNext_BB_BResult fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "NewEmptyMVarMsg_BB_BResult" + + ReadMVarMsg_BB_BResult index value -> + case Dict.get index model.next of + Just (ReadMVarNext_BB_BResult fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "ReadMVarMsg_BB_BResult" + + PutMVarMsg_BB_BResult index -> + case Dict.get index model.next of + Just (PutMVarNext_BB_BResult fn) -> + update (PureMsg index (fn ())) model + + _ -> + crash "PutMVarMsg_BB_BResult" + + -- MVars (T.BB_Status) + NewEmptyMVarMsg_BB_Status index value -> + case Dict.get index model.next of + Just (NewEmptyMVarNext_BB_Status fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "NewEmptyMVarMsg_BB_Status" + + ReadMVarMsg_BB_Status index value -> + case Dict.get index model.next of + Just (ReadMVarNext_BB_Status fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "ReadMVarMsg_BB_Status" + + PutMVarMsg_BB_Status index -> + case Dict.get index model.next of + Just (PutMVarNext_BB_Status fn) -> + update (PureMsg index (fn ())) model + + _ -> + crash "PutMVarMsg_BB_Status" + + -- MVars (T.BB_StatusDict) + NewEmptyMVarMsg_BB_StatusDict index value -> + case Dict.get index model.next of + Just (NewEmptyMVarNext_BB_StatusDict fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "NewEmptyMVarMsg_BB_StatusDict" + + ReadMVarMsg_BB_StatusDict index value -> + case Dict.get index model.next of + Just (ReadMVarNext_BB_StatusDict fn) -> + update (PureMsg index (fn value)) model + + Just (TakeMVarNext_BB_StatusDict fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "ReadMVarMsg_BB_StatusDict" + + PutMVarMsg_BB_StatusDict index -> + case Dict.get index model.next of + Just (PutMVarNext_BB_StatusDict fn) -> + update (PureMsg index (fn ())) model + + _ -> + crash "PutMVarMsg_BB_StatusDict" + + -- MVars (Result T.BRE_RegistryProblem T.BDS_Env) + NewEmptyMVarMsg_ResultRegistryProblemEnv index value -> + case Dict.get index model.next of + Just (NewEmptyMVarNext_ResultRegistryProblemEnv fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "NewEmptyMVarMsg_ResultRegistryProblemEnv" + + ReadMVarMsg_ResultRegistryProblemEnv index value -> + case Dict.get index model.next of + Just (ReadMVarNext_ResultRegistryProblemEnv fn) -> + update (PureMsg index (fn value)) model + + Just (TakeMVarNext_ResultRegistryProblemEnv fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "ReadMVarMsg_ResultRegistryProblemEnv" + + PutMVarMsg_ResultRegistryProblemEnv index -> + case Dict.get index model.next of + Just (PutMVarNext_ResultRegistryProblemEnv fn) -> + update (PureMsg index (fn ())) model + + _ -> + crash "PutMVarMsg_ResultRegistryProblemEnv" + + -- MVars (T.CED_Dep) + NewEmptyMVarMsg_CED_Dep index value -> + case Dict.get index model.next of + Just (NewEmptyMVarNext_CED_Dep fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "NewEmptyMVarMsg_CED_Dep" + + ReadMVarMsg_CED_Dep index value -> + case Dict.get index model.next of + Just (ReadMVarNext_CED_Dep fn) -> + update (PureMsg index (fn value)) model + + Just (TakeMVarNext_CED_Dep fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "ReadMVarMsg_CED_Dep" + + PutMVarMsg_CED_Dep index -> + case Dict.get index model.next of + Just (PutMVarNext_CED_Dep fn) -> + update (PureMsg index (fn ())) model + + _ -> + crash "PutMVarMsg_CED_Dep" + + -- MVars (Maybe T.CECTE_Types) + NewEmptyMVarMsg_Maybe_CECTE_Types index value -> + case Dict.get index model.next of + Just (NewEmptyMVarNext_Maybe_CECTE_Types fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "NewEmptyMVarMsg_Maybe_CECTE_Types" + + ReadMVarMsg_Maybe_CECTE_Types index value -> + case Dict.get index model.next of + Just (ReadMVarNext_Maybe_CECTE_Types fn) -> + update (PureMsg index (fn value)) model + + Just (TakeMVarNext_Maybe_CECTE_Types fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "ReadMVarMsg_Maybe_CECTE_Types" + + PutMVarMsg_Maybe_CECTE_Types index -> + case Dict.get index model.next of + Just (PutMVarNext_Maybe_CECTE_Types fn) -> + update (PureMsg index (fn ())) model + + _ -> + crash "PutMVarMsg_Maybe_CECTE_Types" + + -- MVars (Maybe T.BB_Dependencies) + NewEmptyMVarMsg_Maybe_BB_Dependencies index value -> + case Dict.get index model.next of + Just (NewEmptyMVarNext_Maybe_BB_Dependencies fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "NewEmptyMVarMsg_Maybe_BB_Dependencies" + + ReadMVarMsg_Maybe_BB_Dependencies index value -> + case Dict.get index model.next of + Just (ReadMVarNext_Maybe_BB_Dependencies fn) -> + update (PureMsg index (fn value)) model + + Just (TakeMVarNext_Maybe_BB_Dependencies fn) -> + update (PureMsg index (fn value)) model + + _ -> + crash "ReadMVarMsg_Maybe_BB_Dependencies" + + PutMVarMsg_Maybe_BB_Dependencies index -> + case Dict.get index model.next of + Just (PutMVarNext_Maybe_BB_Dependencies fn) -> + update (PureMsg index (fn ())) model + + _ -> + crash "PutMVarMsg_Maybe_BB_Dependencies" + updatePutIndex : Maybe Int -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) updatePutIndex maybePutIndex ( model, cmd ) = @@ -1044,6 +1568,10 @@ type ION a | NewEmptyMVar_Maybe_BED_Status (Int -> IO a) Int | ReadMVar_Maybe_BED_Status (Maybe T.BED_Status -> IO a) (Maybe (Maybe T.BED_Status)) | PutMVar_Maybe_BED_Status (() -> IO a) (List Int) (Maybe (Maybe T.BED_Status)) + -- MVars (Maybe T.BED_DResult) + | NewEmptyMVar_Maybe_BED_DResult (Int -> IO a) Int + | ReadMVar_Maybe_BED_DResult (Maybe T.BED_DResult -> IO a) (Maybe (Maybe T.BED_DResult)) + | PutMVar_Maybe_BED_DResult (() -> IO a) (List Int) (Maybe (Maybe T.BED_DResult)) -- MVars (Maybe T.CASTO_LocalGraph) | NewEmptyMVar_Maybe_CASTO_LocalGraph (Int -> IO a) Int | ReadMVar_Maybe_CASTO_LocalGraph (Maybe T.CASTO_LocalGraph -> IO a) (Maybe (Maybe T.CASTO_LocalGraph)) @@ -1052,6 +1580,39 @@ type ION a | NewEmptyMVar_Maybe_CASTO_GlobalGraph (Int -> IO a) Int | ReadMVar_Maybe_CASTO_GlobalGraph (Maybe T.CASTO_GlobalGraph -> IO a) (Maybe (Maybe T.CASTO_GlobalGraph)) | PutMVar_Maybe_CASTO_GlobalGraph (() -> IO a) (List Int) (Maybe (Maybe T.CASTO_GlobalGraph)) + -- MVars (T.BB_BResult) + | NewEmptyMVar_BB_BResult (Int -> IO a) Int + | ReadMVar_BB_BResult (T.BB_BResult -> IO a) (Maybe T.BB_BResult) + | PutMVar_BB_BResult (() -> IO a) (List Int) (Maybe T.BB_BResult) + -- MVars (T.BB_Status) + | NewEmptyMVar_BB_Status (Int -> IO a) Int + | ReadMVar_BB_Status (T.BB_Status -> IO a) (Maybe T.BB_Status) + | PutMVar_BB_Status (() -> IO a) (List Int) (Maybe T.BB_Status) + -- MVars (T.BB_StatusDict) + | NewEmptyMVar_BB_StatusDict (Int -> IO a) Int + | ReadMVar_BB_StatusDict (T.BB_StatusDict -> IO a) (Maybe T.BB_StatusDict) + | TakeMVar_BB_StatusDict (T.BB_StatusDict -> IO a) (Maybe T.BB_StatusDict) (Maybe Int) + | PutMVar_BB_StatusDict (() -> IO a) (List Int) (Maybe T.BB_StatusDict) + -- MVars (Result T.BRE_RegistryProblem T.BDS_Env) + | NewEmptyMVar_ResultRegistryProblemEnv (Int -> IO a) Int + | ReadMVar_ResultRegistryProblemEnv (Result T.BRE_RegistryProblem T.BDS_Env -> IO a) (Maybe (Result T.BRE_RegistryProblem T.BDS_Env)) + | TakeMVar_ResultRegistryProblemEnv (Result T.BRE_RegistryProblem T.BDS_Env -> IO a) (Maybe (Result T.BRE_RegistryProblem T.BDS_Env)) (Maybe Int) + | PutMVar_ResultRegistryProblemEnv (() -> IO a) (List Int) (Maybe (Result T.BRE_RegistryProblem T.BDS_Env)) + -- MVars (T.CED_Dep) + | NewEmptyMVar_CED_Dep (Int -> IO a) Int + | ReadMVar_CED_Dep (T.CED_Dep -> IO a) (Maybe T.CED_Dep) + | TakeMVar_CED_Dep (T.CED_Dep -> IO a) (Maybe T.CED_Dep) (Maybe Int) + | PutMVar_CED_Dep (() -> IO a) (List Int) (Maybe T.CED_Dep) + -- MVars (Maybe T.CECTE_Types) + | NewEmptyMVar_Maybe_CECTE_Types (Int -> IO a) Int + | ReadMVar_Maybe_CECTE_Types (Maybe T.CECTE_Types -> IO a) (Maybe (Maybe T.CECTE_Types)) + | TakeMVar_Maybe_CECTE_Types (Maybe T.CECTE_Types -> IO a) (Maybe (Maybe T.CECTE_Types)) (Maybe Int) + | PutMVar_Maybe_CECTE_Types (() -> IO a) (List Int) (Maybe (Maybe T.CECTE_Types)) + -- MVars (Maybe T.BB_Dependencies) + | NewEmptyMVar_Maybe_BB_Dependencies (Int -> IO a) Int + | ReadMVar_Maybe_BB_Dependencies (Maybe T.BB_Dependencies -> IO a) (Maybe (Maybe T.BB_Dependencies)) + | TakeMVar_Maybe_BB_Dependencies (Maybe T.BB_Dependencies -> IO a) (Maybe (Maybe T.BB_Dependencies)) (Maybe Int) + | PutMVar_Maybe_BB_Dependencies (() -> IO a) (List Int) (Maybe (Maybe T.BB_Dependencies)) type alias RealWorld = @@ -1063,8 +1624,16 @@ type alias RealWorld = , state : ReplState , mVars : Array { subscribers : List MVarSubscriber, value : Maybe Encode.Value } , mVars_Maybe_BED_Status : Array { subscribers : List MVarSubscriber_Maybe_BED_Status, value : Maybe (Maybe T.BED_Status) } + , mVars_Maybe_BED_DResult : Array { subscribers : List MVarSubscriber_Maybe_BED_DResult, value : Maybe (Maybe T.BED_DResult) } , mVars_Maybe_CASTO_LocalGraph : Array { subscribers : List MVarSubscriber_Maybe_CASTO_LocalGraph, value : Maybe (Maybe T.CASTO_LocalGraph) } , mVars_Maybe_CASTO_GlobalGraph : Array { subscribers : List MVarSubscriber_Maybe_CASTO_GlobalGraph, value : Maybe (Maybe T.CASTO_GlobalGraph) } + , mVars_BB_BResult : Array { subscribers : List MVarSubscriber_BB_BResult, value : Maybe T.BB_BResult } + , mVars_BB_Status : Array { subscribers : List MVarSubscriber_BB_Status, value : Maybe T.BB_Status } + , mVars_BB_StatusDict : Array { subscribers : List MVarSubscriber_BB_StatusDict, value : Maybe T.BB_StatusDict } + , mVars_ResultRegistryProblemEnv : Array { subscribers : List MVarSubscriber_ResultRegistryProblemEnv, value : Maybe (Result T.BRE_RegistryProblem T.BDS_Env) } + , mVars_CED_Dep : Array { subscribers : List MVarSubscriber_CED_Dep, value : Maybe T.CED_Dep } + , mVars_Maybe_CECTE_Types : Array { subscribers : List MVarSubscriber_Maybe_CECTE_Types, value : Maybe (Maybe T.CECTE_Types) } + , mVars_Maybe_BB_Dependencies : Array { subscribers : List MVarSubscriber_Maybe_BB_Dependencies, value : Maybe (Maybe T.BB_Dependencies) } , next : Dict Int Next } @@ -1081,6 +1650,12 @@ type MVarSubscriber_Maybe_BED_Status | PutMVarSubscriber_Maybe_BED_Status Int (Maybe T.BED_Status) +type MVarSubscriber_Maybe_BED_DResult + = ReadMVarSubscriber_Maybe_BED_DResult Int + | TakeMVarSubscriber_Maybe_BED_DResult Int + | PutMVarSubscriber_Maybe_BED_DResult Int (Maybe T.BED_DResult) + + type MVarSubscriber_Maybe_CASTO_LocalGraph = ReadMVarSubscriber_Maybe_CASTO_LocalGraph Int | TakeMVarSubscriber_Maybe_CASTO_LocalGraph Int @@ -1093,6 +1668,48 @@ type MVarSubscriber_Maybe_CASTO_GlobalGraph | PutMVarSubscriber_Maybe_CASTO_GlobalGraph Int (Maybe T.CASTO_GlobalGraph) +type MVarSubscriber_BB_BResult + = ReadMVarSubscriber_BB_BResult Int + | TakeMVarSubscriber_BB_BResult Int + | PutMVarSubscriber_BB_BResult Int T.BB_BResult + + +type MVarSubscriber_BB_Status + = ReadMVarSubscriber_BB_Status Int + | TakeMVarSubscriber_BB_Status Int + | PutMVarSubscriber_BB_Status Int T.BB_Status + + +type MVarSubscriber_BB_StatusDict + = ReadMVarSubscriber_BB_StatusDict Int + | TakeMVarSubscriber_BB_StatusDict Int + | PutMVarSubscriber_BB_StatusDict Int T.BB_StatusDict + + +type MVarSubscriber_ResultRegistryProblemEnv + = ReadMVarSubscriber_ResultRegistryProblemEnv Int + | TakeMVarSubscriber_ResultRegistryProblemEnv Int + | PutMVarSubscriber_ResultRegistryProblemEnv Int (Result T.BRE_RegistryProblem T.BDS_Env) + + +type MVarSubscriber_CED_Dep + = ReadMVarSubscriber_CED_Dep Int + | TakeMVarSubscriber_CED_Dep Int + | PutMVarSubscriber_CED_Dep Int T.CED_Dep + + +type MVarSubscriber_Maybe_CECTE_Types + = ReadMVarSubscriber_Maybe_CECTE_Types Int + | TakeMVarSubscriber_Maybe_CECTE_Types Int + | PutMVarSubscriber_Maybe_CECTE_Types Int (Maybe T.CECTE_Types) + + +type MVarSubscriber_Maybe_BB_Dependencies + = ReadMVarSubscriber_Maybe_BB_Dependencies Int + | TakeMVarSubscriber_Maybe_BB_Dependencies Int + | PutMVarSubscriber_Maybe_BB_Dependencies Int (Maybe T.BB_Dependencies) + + pure : a -> IO a pure x = IO (\_ s -> ( s, Pure x )) @@ -1229,6 +1846,16 @@ bind f (IO ma) = ( s1, PutMVar_Maybe_BED_Status next readIndexes value ) -> ( s1, PutMVar_Maybe_BED_Status (\() -> bind f (next ())) readIndexes value ) + -- MVars (Maybe T.BED_DResult) + ( s1, NewEmptyMVar_Maybe_BED_DResult next emptyMVarIndex ) -> + ( s1, NewEmptyMVar_Maybe_BED_DResult (\value -> bind f (next value)) emptyMVarIndex ) + + ( s1, ReadMVar_Maybe_BED_DResult next mVarValue ) -> + ( s1, ReadMVar_Maybe_BED_DResult (\value -> bind f (next value)) mVarValue ) + + ( s1, PutMVar_Maybe_BED_DResult next readIndexes value ) -> + ( s1, PutMVar_Maybe_BED_DResult (\() -> bind f (next ())) readIndexes value ) + -- MVars (Maybe T.CASTO_LocalGraph) ( s1, NewEmptyMVar_Maybe_CASTO_LocalGraph next emptyMVarIndex ) -> ( s1, NewEmptyMVar_Maybe_CASTO_LocalGraph (\value -> bind f (next value)) emptyMVarIndex ) @@ -1248,6 +1875,91 @@ bind f (IO ma) = ( s1, PutMVar_Maybe_CASTO_GlobalGraph next readIndexes value ) -> ( s1, PutMVar_Maybe_CASTO_GlobalGraph (\() -> bind f (next ())) readIndexes value ) + + -- MVars (T.BB_BResult) + ( s1, NewEmptyMVar_BB_BResult next emptyMVarIndex ) -> + ( s1, NewEmptyMVar_BB_BResult (\value -> bind f (next value)) emptyMVarIndex ) + + ( s1, ReadMVar_BB_BResult next mVarValue ) -> + ( s1, ReadMVar_BB_BResult (\value -> bind f (next value)) mVarValue ) + + ( s1, PutMVar_BB_BResult next readIndexes value ) -> + ( s1, PutMVar_BB_BResult (\() -> bind f (next ())) readIndexes value ) + + -- MVars (T.BB_Status) + ( s1, NewEmptyMVar_BB_Status next emptyMVarIndex ) -> + ( s1, NewEmptyMVar_BB_Status (\value -> bind f (next value)) emptyMVarIndex ) + + ( s1, ReadMVar_BB_Status next mVarValue ) -> + ( s1, ReadMVar_BB_Status (\value -> bind f (next value)) mVarValue ) + + ( s1, PutMVar_BB_Status next readIndexes value ) -> + ( s1, PutMVar_BB_Status (\() -> bind f (next ())) readIndexes value ) + + -- MVars (T.BB_StatusDict) + ( s1, NewEmptyMVar_BB_StatusDict next emptyMVarIndex ) -> + ( s1, NewEmptyMVar_BB_StatusDict (\value -> bind f (next value)) emptyMVarIndex ) + + ( s1, ReadMVar_BB_StatusDict next mVarValue ) -> + ( s1, ReadMVar_BB_StatusDict (\value -> bind f (next value)) mVarValue ) + + ( s1, TakeMVar_BB_StatusDict next mVarValue maybePutIndex ) -> + ( s1, TakeMVar_BB_StatusDict (\value -> bind f (next value)) mVarValue maybePutIndex ) + + ( s1, PutMVar_BB_StatusDict next readIndexes value ) -> + ( s1, PutMVar_BB_StatusDict (\() -> bind f (next ())) readIndexes value ) + + -- MVars (Result T.BRE_RegistryProblem T.BDS_Env) + ( s1, NewEmptyMVar_ResultRegistryProblemEnv next emptyMVarIndex ) -> + ( s1, NewEmptyMVar_ResultRegistryProblemEnv (\value -> bind f (next value)) emptyMVarIndex ) + + ( s1, ReadMVar_ResultRegistryProblemEnv next mVarValue ) -> + ( s1, ReadMVar_ResultRegistryProblemEnv (\value -> bind f (next value)) mVarValue ) + + ( s1, TakeMVar_ResultRegistryProblemEnv next mVarValue maybePutIndex ) -> + ( s1, TakeMVar_ResultRegistryProblemEnv (\value -> bind f (next value)) mVarValue maybePutIndex ) + + ( s1, PutMVar_ResultRegistryProblemEnv next readIndexes value ) -> + ( s1, PutMVar_ResultRegistryProblemEnv (\() -> bind f (next ())) readIndexes value ) + + -- MVars (T.CED_Dep) + ( s1, NewEmptyMVar_CED_Dep next emptyMVarIndex ) -> + ( s1, NewEmptyMVar_CED_Dep (\value -> bind f (next value)) emptyMVarIndex ) + + ( s1, ReadMVar_CED_Dep next mVarValue ) -> + ( s1, ReadMVar_CED_Dep (\value -> bind f (next value)) mVarValue ) + + ( s1, TakeMVar_CED_Dep next mVarValue maybePutIndex ) -> + ( s1, TakeMVar_CED_Dep (\value -> bind f (next value)) mVarValue maybePutIndex ) + + ( s1, PutMVar_CED_Dep next readIndexes value ) -> + ( s1, PutMVar_CED_Dep (\() -> bind f (next ())) readIndexes value ) + + -- MVars (Maybe T.CECTE_Types) + ( s1, NewEmptyMVar_Maybe_CECTE_Types next emptyMVarIndex ) -> + ( s1, NewEmptyMVar_Maybe_CECTE_Types (\value -> bind f (next value)) emptyMVarIndex ) + + ( s1, ReadMVar_Maybe_CECTE_Types next mVarValue ) -> + ( s1, ReadMVar_Maybe_CECTE_Types (\value -> bind f (next value)) mVarValue ) + + ( s1, TakeMVar_Maybe_CECTE_Types next mVarValue maybePutIndex ) -> + ( s1, TakeMVar_Maybe_CECTE_Types (\value -> bind f (next value)) mVarValue maybePutIndex ) + + ( s1, PutMVar_Maybe_CECTE_Types next readIndexes value ) -> + ( s1, PutMVar_Maybe_CECTE_Types (\() -> bind f (next ())) readIndexes value ) + + -- MVars (Maybe T.BB_Dependencies) + ( s1, NewEmptyMVar_Maybe_BB_Dependencies next emptyMVarIndex ) -> + ( s1, NewEmptyMVar_Maybe_BB_Dependencies (\value -> bind f (next value)) emptyMVarIndex ) + + ( s1, ReadMVar_Maybe_BB_Dependencies next mVarValue ) -> + ( s1, ReadMVar_Maybe_BB_Dependencies (\value -> bind f (next value)) mVarValue ) + + ( s1, TakeMVar_Maybe_BB_Dependencies next mVarValue maybePutIndex ) -> + ( s1, TakeMVar_Maybe_BB_Dependencies (\value -> bind f (next value)) mVarValue maybePutIndex ) + + ( s1, PutMVar_Maybe_BB_Dependencies next readIndexes value ) -> + ( s1, PutMVar_Maybe_BB_Dependencies (\() -> bind f (next ())) readIndexes value ) ) diff --git a/src/Terminal/Bump.elm b/src/Terminal/Bump.elm index 40c3efbdd..20e99d443 100644 --- a/src/Terminal/Bump.elm +++ b/src/Terminal/Bump.elm @@ -39,7 +39,7 @@ run () () = type Env - = Env T.FilePath Stuff.PackageCache Http.Manager Registry.Registry Outline.PkgOutline + = Env T.FilePath T.BS_PackageCache T.BH_Manager T.BDR_Registry Outline.PkgOutline getEnv : Task.Task Exit.Bump Env @@ -86,7 +86,7 @@ bump ((Env root _ _ registry ((Outline.PkgOutline pkg _ _ vsn _ _ _ _) as outlin case Registry.getVersions pkg registry of Just knownVersions -> let - bumpableVersions : List V.Version + bumpableVersions : List T.CEV_Version bumpableVersions = List.map (\( old, _, _ ) -> old) (Bump.getPossibilities knownVersions) in @@ -140,7 +140,7 @@ suggestVersion (Env root cache manager _ ((Outline.PkgOutline pkg _ _ vsn _ _ _ changes = Diff.diff oldDocs newDocs - newVersion : V.Version + newVersion : T.CEV_Version newVersion = Diff.bump changes vsn @@ -197,7 +197,7 @@ generateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) = -- CHANGE VERSION -changeVersion : T.FilePath -> Outline.PkgOutline -> V.Version -> D.Doc -> IO () +changeVersion : T.FilePath -> Outline.PkgOutline -> T.CEV_Version -> D.Doc -> IO () changeVersion root (Outline.PkgOutline name summary license _ exposed deps testDeps elmVersion) targetVersion question = Reporting.ask question |> IO.bind diff --git a/src/Terminal/Diff.elm b/src/Terminal/Diff.elm index fc5079e6a..206d52e11 100644 --- a/src/Terminal/Diff.elm +++ b/src/Terminal/Diff.elm @@ -35,9 +35,9 @@ import Types as T type Args = CodeVsLatest - | CodeVsExactly V.Version - | LocalInquiry V.Version V.Version - | GlobalInquiry T.CEP_Name V.Version V.Version + | CodeVsExactly T.CEV_Version + | LocalInquiry T.CEV_Version T.CEV_Version + | GlobalInquiry T.CEP_Name T.CEV_Version T.CEV_Version run : Args -> () -> IO () @@ -55,7 +55,7 @@ run args () = type Env - = Env (Maybe String) Stuff.PackageCache Http.Manager Registry.Registry + = Env (Maybe String) T.BS_PackageCache T.BH_Manager T.BDR_Registry getEnv : Task Env @@ -141,8 +141,8 @@ diff ((Env _ _ _ registry) as env) args = -- GET DOCS -getDocs : Env -> T.CEP_Name -> Registry.KnownVersions -> V.Version -> Task Docs.Documentation -getDocs (Env _ cache manager _) name (Registry.KnownVersions latest previous) version = +getDocs : Env -> T.CEP_Name -> T.BDR_KnownVersions -> T.CEV_Version -> Task Docs.Documentation +getDocs (Env _ cache manager _) name (T.BDR_KnownVersions latest previous) version = if latest == version || List.member version previous then Task.eio (Exit.DiffDocsProblem version) <| DD.getDocs cache manager name version @@ -150,8 +150,8 @@ getDocs (Env _ cache manager _) name (Registry.KnownVersions latest previous) ve Task.throw <| Exit.DiffUnknownVersion version (latest :: previous) -getLatestDocs : Env -> T.CEP_Name -> Registry.KnownVersions -> Task Docs.Documentation -getLatestDocs (Env _ cache manager _) name (Registry.KnownVersions latest _) = +getLatestDocs : Env -> T.CEP_Name -> T.BDR_KnownVersions -> Task Docs.Documentation +getLatestDocs (Env _ cache manager _) name (T.BDR_KnownVersions latest _) = Task.eio (Exit.DiffDocsProblem latest) <| DD.getDocs cache manager name latest @@ -159,7 +159,7 @@ getLatestDocs (Env _ cache manager _) name (Registry.KnownVersions latest _) = -- READ OUTLINE -readOutline : Env -> Task ( T.CEP_Name, Registry.KnownVersions ) +readOutline : Env -> Task ( T.CEP_Name, T.BDR_KnownVersions ) readOutline (Env maybeRoot _ _ registry) = case maybeRoot of Nothing -> diff --git a/src/Terminal/Init.elm b/src/Terminal/Init.elm index 0eed8d099..5f699281b 100644 --- a/src/Terminal/Init.elm +++ b/src/Terminal/Init.elm @@ -88,7 +88,7 @@ init = Err problem -> IO.pure (Err (Exit.InitRegistryProblem problem)) - Ok (Solver.Env cache _ connection registry) -> + Ok (T.BDS_Env cache _ connection registry) -> Solver.verify cache connection registry defaults |> IO.bind (\result -> @@ -104,15 +104,15 @@ init = Solver.SolverOk details -> let - solution : Dict ( String, String ) T.CEP_Name V.Version + solution : Dict ( String, String ) T.CEP_Name T.CEV_Version solution = Dict.map (\_ (Solver.Details vsn _) -> vsn) details - directs : Dict ( String, String ) T.CEP_Name V.Version + directs : Dict ( String, String ) T.CEP_Name T.CEV_Version directs = Dict.intersection compare solution defaults - indirects : Dict ( String, String ) T.CEP_Name V.Version + indirects : Dict ( String, String ) T.CEP_Name T.CEV_Version indirects = Dict.diff solution defaults in diff --git a/src/Terminal/Install.elm b/src/Terminal/Install.elm index f8bd6e2fc..3421621f8 100644 --- a/src/Terminal/Install.elm +++ b/src/Terminal/Install.elm @@ -85,7 +85,7 @@ type alias Task a = Task.Task Exit.Install a -attemptChanges : String -> Solver.Env -> Outline.Outline -> (a -> String) -> Changes a -> Task () +attemptChanges : String -> T.BDS_Env -> Outline.Outline -> (a -> String) -> Changes a -> Task () attemptChanges root env oldOutline toChars changes = case changes of AlreadyInstalled -> @@ -175,7 +175,7 @@ attemptChanges root env oldOutline toChars changes = ] -attemptChangesHelp : T.FilePath -> Solver.Env -> Outline.Outline -> Outline.Outline -> D.Doc -> Task () +attemptChangesHelp : T.FilePath -> T.BDS_Env -> Outline.Outline -> Outline.Outline -> D.Doc -> Task () attemptChangesHelp root env oldOutline newOutline question = Task.eio Exit.InstallBadDetails <| BW.withScope @@ -209,8 +209,8 @@ attemptChangesHelp root env oldOutline newOutline question = -- MAKE APP PLAN -makeAppPlan : Solver.Env -> T.CEP_Name -> Outline.AppOutline -> Task (Changes V.Version) -makeAppPlan (Solver.Env cache _ connection registry) pkg ((Outline.AppOutline elmVersion sourceDirs direct indirect testDirect testIndirect) as outline) = +makeAppPlan : T.BDS_Env -> T.CEP_Name -> Outline.AppOutline -> Task (Changes T.CEV_Version) +makeAppPlan (T.BDS_Env cache _ connection registry) pkg ((Outline.AppOutline elmVersion sourceDirs direct indirect testDirect testIndirect) as outline) = if Dict.member identity pkg direct then Task.pure AlreadyInstalled @@ -261,10 +261,10 @@ makeAppPlan (Solver.Env cache _ connection registry) pkg ((Outline.AppOutline el case Registry.getVersions_ pkg registry of Err suggestions -> case connection of - Solver.Online _ -> + T.BDS_Online _ -> Task.throw (Exit.InstallUnknownPackageOnline pkg suggestions) - Solver.Offline -> + T.BDS_Offline -> Task.throw (Exit.InstallUnknownPackageOffline pkg suggestions) Ok _ -> @@ -290,8 +290,8 @@ makeAppPlan (Solver.Env cache _ connection registry) pkg ((Outline.AppOutline el -- MAKE PACKAGE PLAN -makePkgPlan : Solver.Env -> T.CEP_Name -> Outline.PkgOutline -> Task (Changes C.Constraint) -makePkgPlan (Solver.Env cache _ connection registry) pkg (Outline.PkgOutline name summary license version exposed deps test elmVersion) = +makePkgPlan : T.BDS_Env -> T.CEP_Name -> Outline.PkgOutline -> Task (Changes C.Constraint) +makePkgPlan (T.BDS_Env cache _ connection registry) pkg (Outline.PkgOutline name summary license version exposed deps test elmVersion) = if Dict.member identity pkg deps then Task.pure AlreadyInstalled @@ -316,13 +316,13 @@ makePkgPlan (Solver.Env cache _ connection registry) pkg (Outline.PkgOutline nam case Registry.getVersions_ pkg registry of Err suggestions -> case connection of - Solver.Online _ -> + T.BDS_Online _ -> Task.throw (Exit.InstallUnknownPackageOnline pkg suggestions) - Solver.Offline -> + T.BDS_Offline -> Task.throw (Exit.InstallUnknownPackageOffline pkg suggestions) - Ok (Registry.KnownVersions _ _) -> + Ok (T.BDR_KnownVersions _ _) -> let old : Dict ( String, String ) T.CEP_Name C.Constraint old = diff --git a/src/Terminal/Publish.elm b/src/Terminal/Publish.elm index 94a831f42..536ec7b82 100644 --- a/src/Terminal/Publish.elm +++ b/src/Terminal/Publish.elm @@ -49,7 +49,7 @@ run () () = type Env - = Env T.FilePath Stuff.PackageCache Http.Manager Registry.Registry Outline.Outline + = Env T.FilePath T.BS_PackageCache T.BH_Manager T.BDR_Registry Outline.Outline getEnv : Task.Task Exit.Publish Env @@ -89,7 +89,7 @@ publish ((Env root _ manager registry outline) as env) = Outline.Pkg (Outline.PkgOutline pkg summary _ vsn exposed _ _ _) -> let - maybeKnownVersions : Maybe Registry.KnownVersions + maybeKnownVersions : Maybe T.BDR_KnownVersions maybeKnownVersions = Registry.getVersions pkg registry in @@ -291,7 +291,7 @@ getGit = -- VERIFY GITHUB TAG -verifyTag : Git -> Http.Manager -> T.CEP_Name -> V.Version -> Task.Task Exit.Publish String +verifyTag : Git -> T.BH_Manager -> T.CEP_Name -> T.CEV_Version -> Task.Task Exit.Publish String verifyTag (Git run_) manager pkg vsn = reportTagCheck vsn -- https://stackoverflow.com/questions/1064499/how-to-list-all-git-tags @@ -320,7 +320,7 @@ verifyTag (Git run_) manager pkg vsn = ) -toTagUrl : T.CEP_Name -> V.Version -> String +toTagUrl : T.CEP_Name -> T.CEV_Version -> String toTagUrl pkg vsn = "https://api.github.com/repos/" ++ Pkg.toUrl pkg ++ "/git/refs/tags/" ++ V.toChars vsn @@ -334,7 +334,7 @@ commitHashDecoder = -- VERIFY NO LOCAL CHANGES SINCE TAG -verifyNoChanges : Git -> String -> V.Version -> Task.Task Exit.Publish () +verifyNoChanges : Git -> String -> T.CEV_Version -> Task.Task Exit.Publish () verifyNoChanges (Git run_) commitHash vsn = reportLocalChangesCheck <| -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes @@ -355,7 +355,7 @@ verifyNoChanges (Git run_) commitHash vsn = -- VERIFY THAT ZIP BUILDS / COMPUTE HASH -verifyZip : Env -> T.CEP_Name -> V.Version -> Task.Task Exit.Publish Http.Sha +verifyZip : Env -> T.CEP_Name -> T.CEV_Version -> Task.Task Exit.Publish Http.Sha verifyZip (Env root _ manager _ _) pkg vsn = withPrepublishDir root <| \prepublishDir -> @@ -384,7 +384,7 @@ verifyZip (Env root _ manager _ _) pkg vsn = ) -toZipUrl : T.CEP_Name -> V.Version -> String +toZipUrl : T.CEP_Name -> T.CEV_Version -> String toZipUrl pkg vsn = "https://github.com/" ++ Pkg.toUrl pkg ++ "/zipball/" ++ V.toChars vsn ++ "/" @@ -439,10 +439,10 @@ verifyZipBuild root = type GoodVersion = GoodStart - | GoodBump V.Version M.Magnitude + | GoodBump T.CEV_Version M.Magnitude -verifyVersion : Env -> T.CEP_Name -> V.Version -> Docs.Documentation -> Maybe Registry.KnownVersions -> Task.Task Exit.Publish () +verifyVersion : Env -> T.CEP_Name -> T.CEV_Version -> Docs.Documentation -> Maybe T.BDR_KnownVersions -> Task.Task Exit.Publish () verifyVersion env pkg vsn newDocs publishedVersions = reportSemverCheck vsn <| case publishedVersions of @@ -453,7 +453,7 @@ verifyVersion env pkg vsn newDocs publishedVersions = else IO.pure <| Err <| Exit.PublishNotInitialVersion vsn - Just ((Registry.KnownVersions latest previous) as knownVersions) -> + Just ((T.BDR_KnownVersions latest previous) as knownVersions) -> if vsn == latest || List.member vsn previous then IO.pure <| Err <| Exit.PublishAlreadyPublished vsn @@ -461,8 +461,8 @@ verifyVersion env pkg vsn newDocs publishedVersions = verifyBump env pkg vsn newDocs knownVersions -verifyBump : Env -> T.CEP_Name -> V.Version -> Docs.Documentation -> Registry.KnownVersions -> IO (Result Exit.Publish GoodVersion) -verifyBump (Env _ cache manager _ _) pkg vsn newDocs ((Registry.KnownVersions latest _) as knownVersions) = +verifyBump : Env -> T.CEP_Name -> T.CEV_Version -> Docs.Documentation -> T.BDR_KnownVersions -> IO (Result Exit.Publish GoodVersion) +verifyBump (Env _ cache manager _ _) pkg vsn newDocs ((T.BDR_KnownVersions latest _) as knownVersions) = case List.find (\( _, new, _ ) -> vsn == new) (Bump.getPossibilities knownVersions) of Nothing -> IO.pure <| @@ -483,7 +483,7 @@ verifyBump (Env _ cache manager _ _) pkg vsn newDocs ((Registry.KnownVersions la changes = Diff.diff oldDocs newDocs - realNew : V.Version + realNew : T.CEV_Version realNew = Diff.bump changes old in @@ -500,7 +500,7 @@ verifyBump (Env _ cache manager _ _) pkg vsn newDocs ((Registry.KnownVersions la -- REGISTER PACKAGES -register : Http.Manager -> T.CEP_Name -> V.Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish () +register : T.BH_Manager -> T.CEP_Name -> T.CEV_Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish () register manager pkg vsn docs commitHash sha = let url : String @@ -525,7 +525,7 @@ register manager pkg vsn docs commitHash sha = -- REPORTING -reportPublishStart : T.CEP_Name -> V.Version -> Maybe Registry.KnownVersions -> Task.Task x () +reportPublishStart : T.CEP_Name -> T.CEV_Version -> Maybe T.BDR_KnownVersions -> Task.Task x () reportPublishStart pkg vsn maybeKnownVersions = Task.io <| case maybeKnownVersions of @@ -564,7 +564,7 @@ reportBuildCheck = "Problem with documentation" -reportSemverCheck : V.Version -> IO (Result x GoodVersion) -> Task.Task x () +reportSemverCheck : T.CEV_Version -> IO (Result x GoodVersion) -> Task.Task x () reportSemverCheck version work = let vsn : String @@ -599,7 +599,7 @@ reportSemverCheck version work = Task.void <| reportCustomCheck waiting success failure work -reportTagCheck : V.Version -> IO (Result x a) -> Task.Task x a +reportTagCheck : T.CEV_Version -> IO (Result x a) -> Task.Task x a reportTagCheck vsn = reportCheck ("Is version " ++ V.toChars vsn ++ " tagged on GitHub?") diff --git a/src/Terminal/Terminal/Helpers.elm b/src/Terminal/Terminal/Helpers.elm index ef63ba2ef..43b8457c4 100644 --- a/src/Terminal/Terminal/Helpers.elm +++ b/src/Terminal/Terminal/Helpers.elm @@ -34,7 +34,7 @@ version = } -parseVersion : String -> Maybe V.Version +parseVersion : String -> Maybe T.CEV_Version parseVersion chars = case P.fromByteString V.parser Tuple.pair chars of Ok vsn -> @@ -142,7 +142,7 @@ suggestPackages given = Nothing -> [] - Just (Registry.Registry _ versions) -> + Just (T.BDR_Registry _ versions) -> List.filter (String.startsWith given) <| List.map Pkg.toChars (Dict.keys compare versions) ) @@ -164,7 +164,7 @@ examplePackages given = , "elm/random" ] - Just (Registry.Registry _ versions) -> + Just (T.BDR_Registry _ versions) -> List.map Pkg.toChars <| List.take 4 <| Suggest.sort given Pkg.toChars (Dict.keys compare versions) diff --git a/src/Types.elm b/src/Types.elm index cda93db17..9074272c3 100644 --- a/src/Types.elm +++ b/src/Types.elm @@ -1,4 +1,4 @@ -module Types exposing (BB_BResult(..), BB_CachedInterface(..), BB_ResultDict, BED_BuildID, BED_DocsStatus(..), BED_Local(..), BED_Status(..), BED_StatusDict, BF_Time(..), CASTC_Alias(..), CASTC_AliasType(..), CASTC_Annotation(..), CASTC_CaseBranch(..), CASTC_Ctor(..), CASTC_CtorOpts(..), CASTC_Decls(..), CASTC_Def(..), CASTC_Expr, CASTC_Expr_(..), CASTC_FieldType(..), CASTC_FieldUpdate(..), CASTC_FreeVars, CASTC_Pattern, CASTC_PatternCtorArg(..), CASTC_Pattern_(..), CASTC_Type(..), CASTC_Union(..), CASTO_Choice(..), CASTO_Decider(..), CASTO_Def(..), CASTO_Destructor(..), CASTO_EffectsType(..), CASTO_Expr(..), CASTO_Global(..), CASTO_GlobalGraph(..), CASTO_LocalGraph(..), CASTO_Main(..), CASTO_Node(..), CASTO_Path(..), CASTS_Alias(..), CASTS_Comment(..), CASTS_Def(..), CASTS_Docs(..), CASTS_Effects(..), CASTS_Exposed(..), CASTS_Exposing(..), CASTS_Expr, CASTS_Expr_(..), CASTS_Import(..), CASTS_Infix(..), CASTS_Manager(..), CASTS_Module(..), CASTS_Pattern, CASTS_Pattern_(..), CASTS_Port(..), CASTS_Privacy(..), CASTS_Type, CASTS_Type_(..), CASTS_Union(..), CASTS_Value(..), CASTS_VarType(..), CASTUB_Associativity(..), CASTUB_Precedence, CASTUS_Source(..), CASTUS_Type(..), CASTUS_Types(..), CDI_ZeroBased(..), CDN_Name, CECT_Type(..), CED_Alias(..), CED_Binop(..), CED_Comment, CED_Module(..), CED_Union(..), CED_Value(..), CEI_Alias(..), CEI_Binop(..), CEI_Interface(..), CEI_Union(..), CEK_Chunk(..), CEMN_Canonical(..), CEMN_Raw, CEP_Author, CEP_Name, CEP_Project, CNPM_Context(..), CNPM_Error(..), CNPM_Literal(..), CNPM_Pattern(..), CODT_Path(..), CODT_Test(..), CPP_Col, CPP_Row, CPP_Snippet(..), CPS_BadOperator(..), CRA_Located(..), CRA_Position(..), CRA_Region(..), CREC_BadArityContext(..), CREC_DuplicatePatternContext(..), CREC_Error(..), CREC_InvalidPayload(..), CREC_PortProblem(..), CREC_PossibleNames, CREC_VarKind(..), CRED_DefProblem(..), CRED_Error(..), CRED_NameProblem(..), CRED_SyntaxProblem(..), CREI_Error(..), CREI_Problem(..), CREM_Error(..), CRES_Case(..), CRES_Char(..), CRES_CustomType(..), CRES_Decl(..), CRES_DeclDef(..), CRES_DeclType(..), CRES_Def(..), CRES_Destruct(..), CRES_Error(..), CRES_Escape(..), CRES_Exposing(..), CRES_Expr(..), CRES_Func(..), CRES_If(..), CRES_Let(..), CRES_List_(..), CRES_Module(..), CRES_Number(..), CRES_PList(..), CRES_PRecord(..), CRES_PTuple(..), CRES_Pattern(..), CRES_Port(..), CRES_Record(..), CRES_Space(..), CRES_String_(..), CRES_TRecord(..), CRES_TTuple(..), CRES_Tuple(..), CRES_Type(..), CRES_TypeAlias(..), CRET_Category(..), CRET_Context(..), CRET_Error(..), CRET_Expected(..), CRET_MaybeName(..), CRET_PCategory(..), CRET_PContext(..), CRET_PExpected(..), CRET_SubContext(..), CRE_Error(..), CRE_Module, CRRTL_Exposing(..), CRRTL_Import, CRRTL_Localizer(..), CTE_Extension(..), CTE_Super(..), CTE_Type(..), FilePath, MVar(..)) +module Types exposing (..) {-| -} @@ -24,7 +24,7 @@ type alias FilePath = {-| FIXME Builder.Elm.Details -} type alias BED_StatusDict = - Dict String CEMN_Raw (MVar (Maybe BED_Status)) + Dict String CEMN_Raw MVar_Maybe_BED_Status {-| FIXME Builder.Elm.Details @@ -550,6 +550,72 @@ type MVar a = MVar Int +{-| FIXME Utils.Main +-} +type MVar_Maybe_BED_Status + = MVar_Maybe_BED_Status Int + + +{-| FIXME Utils.Main +-} +type MVar_Maybe_BED_DResult + = MVar_Maybe_BED_DResult Int + + +{-| FIXME Utils.Main +-} +type MVar_Maybe_CASTO_LocalGraph + = MVar_Maybe_CASTO_LocalGraph Int + + +{-| FIXME Utils.Main +-} +type MVar_Maybe_CASTO_GlobalGraph + = MVar_Maybe_CASTO_GlobalGraph Int + + +{-| FIXME Utils.Main +-} +type MVar_BB_BResult + = MVar_BB_BResult Int + + +{-| FIXME Utils.Main +-} +type MVar_BB_Status + = MVar_BB_Status Int + + +{-| FIXME Utils.Main +-} +type MVar_BB_StatusDict + = MVar_BB_StatusDict Int + + +{-| FIXME Utils.Main +-} +type MVar_ResultRegistryProblemEnv + = MVar_ResultRegistryProblemEnv Int + + +{-| FIXME Utils.Main +-} +type MVar_CED_Dep + = MVar_CED_Dep Int + + +{-| FIXME Utils.Main +-} +type MVar_Maybe_CECTE_Types + = MVar_Maybe_CECTE_Types Int + + +{-| FIXME Utils.Main +-} +type MVar_Maybe_BB_Dependencies + = MVar_Maybe_BB_Dependencies Int + + -- EXPRESSIONS @@ -720,7 +786,7 @@ type CODT_Path {-| FIXME Builder.Build -} type alias BB_ResultDict = - Dict String CEMN_Raw (MVar BB_BResult) + Dict String CEMN_Raw MVar_BB_BResult {-| FIXME Builder.Build @@ -745,6 +811,33 @@ type BB_CachedInterface +-- CRAWL + + +{-| FIXME Builder.Build +-} +type alias BB_StatusDict = + Dict String CEMN_Raw MVar_BB_Status + + +{-| FIXME Builder.Build +-} +type BB_Status + = BB_SCached BED_Local + | BB_SChanged BED_Local String CASTS_Module BB_DocsNeed + | BB_SBadImport CREI_Problem + | BB_SBadSyntax FilePath BF_Time String CRES_Error + | BB_SForeign CEP_Name + | BB_SKernel + + +{-| FIXME Builder.Build +-} +type BB_DocsNeed + = BB_DocsNeed Bool + + + -- TIME @@ -1884,3 +1977,226 @@ type CASTC_PatternCtorArg -- CACHE for type inference CASTC_Type CASTC_Pattern + + + +-- MANAGER + + +{-| FIXME Builder.Http +-} +type BH_Manager + = BH_Manager + + + +-- EXCEPTIONS + + +{-| FIXME Builder.Http +-} +type BH_Error + = BH_BadUrl String String + | BH_BadHttp String UM_HttpExceptionContent + | BH_BadMystery String UM_SomeException + + + +-- PACKAGE CACHES + + +{-| FIXME Builder.Stuff +-} +type BS_PackageCache + = BS_PackageCache String + + + +-- REGISTRY + + +{-| FIXME Builder.Deps.Registry +-} +type BDR_Registry + = BDR_Registry Int (Dict ( String, String ) CEP_Name BDR_KnownVersions) + + +{-| FIXME Builder.Deps.Registry +-} +type BDR_KnownVersions + = BDR_KnownVersions CEV_Version (List CEV_Version) + + + +-- SOLVER + + +{-| FIXME Builder.Deps.Solver +-} +type BDS_Connection + = BDS_Online BH_Manager + | BDS_Offline + + + +-- ENVIRONMENT + + +{-| FIXME Builder.Deps.Solver +-} +type BDS_Env + = BDS_Env BS_PackageCache BH_Manager BDS_Connection BDR_Registry + + + +-- REGISTRY PROBLEM + + +{-| FIXME Builder.Reporting.Exit +-} +type BRE_RegistryProblem + = BRE_RP_Http BH_Error + | BRE_RP_Data String String + + + +-- DEPENDENCY INTERFACE + + +{-| FIXME Compiler.Elm.Interface +-} +type CEI_DependencyInterface + = CEI_Public CEI_Interface + | CEI_Private CEP_Name (Dict String CDN_Name CASTC_Union) (Dict String CDN_Name CASTC_Alias) + + + +-- VERSION + + +{-| FIXME Compiler.Elm.Version +-} +type CEV_Version + = CEV_Version Int Int Int + + + +-- Network.HTTP.Client + + +{-| FIXME Utils.Main +-} +type UM_HttpExceptionContent + = UM_StatusCodeException (UM_HttpResponse ()) String + | UM_TooManyRedirects (List (UM_HttpResponse ())) + | UM_ConnectionFailure UM_SomeException + + +{-| FIXME Utils.Main +-} +type UM_HttpResponse body + = UM_HttpResponse + { responseStatus : UM_HttpStatus + , responseHeaders : UM_HttpResponseHeaders + } + + +{-| FIXME Utils.Main +-} +type alias UM_HttpResponseHeaders = + List ( String, String ) + + +{-| FIXME Utils.Main +-} +type UM_HttpStatus + = UM_HttpStatus Int String + + + +-- Control.Exception + + +{-| FIXME Utils.Main +-} +type UM_SomeException + = UM_SomeException + + + +-- COMPILE + + +{-| FIXME Builder.Elm.Details +-} +type BED_DResult + = BED_RLocal CEI_Interface CASTO_LocalGraph (Maybe CED_Module) + | BED_RForeign CEI_Interface + | BED_RKernelLocal (List CEK_Chunk) + | BED_RKernelForeign + + + +-- VERIFY DEPENDENCY + + +{-| FIXME Builder.Elm.Details +-} +type CED_Artifacts + = CED_Artifacts (Dict String CEMN_Raw CEI_DependencyInterface) CASTO_GlobalGraph + + +{-| FIXME Builder.Elm.Details +-} +type alias CED_Dep = + Result (Maybe BRE_DetailsBadDep) CED_Artifacts + + + +-- DETAILS + + +{-| FIXME Builder.Reporting.Exit +-} +type BRE_DetailsBadDep + = BRE_BD_BadDownload CEP_Name CEV_Version BRE_PackageProblem + | BRE_BD_BadBuild CEP_Name CEV_Version (Dict ( String, String ) CEP_Name CEV_Version) + + + +-- PACKAGE PROBLEM + + +{-| FIXME Builder.Reporting.Exit +-} +type BRE_PackageProblem + = BRE_PP_BadEndpointRequest BH_Error + | BRE_PP_BadEndpointContent String + | BRE_PP_BadArchiveRequest BH_Error + | BRE_PP_BadArchiveContent String + | BRE_PP_BadArchiveHash String String String + + + +-- FROM PATHS + + +{-| FIXME Builder.Build +-} +type alias BB_Dependencies = + Dict (List String) CEMN_Canonical CEI_DependencyInterface + + + +-- TRANSITIVELY AVAILABLE TYPES + + +type CECTE_Types + = -- PERF profile Opt.Global representation + -- current representation needs less allocation + -- but maybe the lookup is much worse + CECTE_Types (Dict (List String) CEMN_Canonical CECTE_Types_) + + +type CECTE_Types_ + = CECTE_Types_ (Dict String CDN_Name CASTC_Union) (Dict String CDN_Name CASTC_Alias) diff --git a/src/Utils/Main.elm b/src/Utils/Main.elm index e101b8fe3..b785a0bd3 100644 --- a/src/Utils/Main.elm +++ b/src/Utils/Main.elm @@ -2,16 +2,11 @@ module Utils.Main exposing ( AsyncException(..) , ChItem , Chan - , HttpExceptionContent(..) - , HttpResponse(..) - , HttpResponseHeaders - , HttpStatus(..) , LockSharedExclusive(..) , ReplCompletion(..) , ReplCompletionFunc , ReplInputT , ReplSettings(..) - , SomeException(..) , ThreadId , ZipArchive(..) , ZipEntry(..) @@ -73,7 +68,17 @@ module Utils.Main exposing , listTraverse_ , lockWithFileLock , mVarDecoder + , mVarDecoder_BB_BResult + , mVarDecoder_CED_Dep + , mVarDecoder_Maybe_BED_DResult + , mVarDecoder_Maybe_BED_Status + , mVarDecoder_Maybe_CECTE_Types , mVarEncoder + , mVarEncoder_BB_BResult + , mVarEncoder_CED_Dep + , mVarEncoder_Maybe_BED_DResult + , mVarEncoder_Maybe_BED_Status + , mVarEncoder_Maybe_CECTE_Types , mapFindMin , mapFromKeys , mapFromListWith @@ -96,22 +101,53 @@ module Utils.Main exposing , maybeTraverseTask , newChan , newEmptyMVar + , newEmptyMVar_BB_BResult + , newEmptyMVar_BB_Status + , newEmptyMVar_BB_StatusDict + , newEmptyMVar_CED_Dep + , newEmptyMVar_Maybe_BB_Dependencies + , newEmptyMVar_Maybe_BED_DResult , newEmptyMVar_Maybe_BED_Status , newEmptyMVar_Maybe_CASTO_GlobalGraph , newEmptyMVar_Maybe_CASTO_LocalGraph + , newEmptyMVar_Maybe_CECTE_Types + , newEmptyMVar_ResultRegistryProblemEnv , newMVar + , newMVar_BB_BResult + , newMVar_BB_Status + , newMVar_BB_StatusDict + , newMVar_CED_Dep + , newMVar_Maybe_BB_Dependencies , newMVar_Maybe_CASTO_GlobalGraph , newMVar_Maybe_CASTO_LocalGraph + , newMVar_Maybe_CECTE_Types + , newMVar_ResultRegistryProblemEnv , nonEmptyListTraverse , putMVar + , putMVar_BB_BResult + , putMVar_BB_Status + , putMVar_BB_StatusDict + , putMVar_CED_Dep + , putMVar_Maybe_BB_Dependencies + , putMVar_Maybe_BED_DResult , putMVar_Maybe_BED_Status , putMVar_Maybe_CASTO_GlobalGraph , putMVar_Maybe_CASTO_LocalGraph + , putMVar_Maybe_CECTE_Types + , putMVar_ResultRegistryProblemEnv , readChan , readMVar + , readMVar_BB_BResult + , readMVar_BB_Status + , readMVar_BB_StatusDict + , readMVar_CED_Dep + , readMVar_Maybe_BB_Dependencies + , readMVar_Maybe_BED_DResult , readMVar_Maybe_BED_Status , readMVar_Maybe_CASTO_GlobalGraph , readMVar_Maybe_CASTO_LocalGraph + , readMVar_Maybe_CECTE_Types + , readMVar_ResultRegistryProblemEnv , replCompleteWord , replGetInputLine , replGetInputLineWithInitial @@ -126,6 +162,11 @@ module Utils.Main exposing , someExceptionDecoder , someExceptionEncoder , takeMVar + , takeMVar_BB_StatusDict + , takeMVar_CED_Dep + , takeMVar_Maybe_BB_Dependencies + , takeMVar_Maybe_CECTE_Types + , takeMVar_ResultRegistryProblemEnv , unlines , unzip3 , writeChan @@ -839,35 +880,18 @@ type ZipEntry -- Network.HTTP.Client -type HttpExceptionContent - = StatusCodeException (HttpResponse ()) String - | TooManyRedirects (List (HttpResponse ())) - | ConnectionFailure SomeException - - -type HttpResponse body - = HttpResponse - { responseStatus : HttpStatus - , responseHeaders : HttpResponseHeaders - } - - -type alias HttpResponseHeaders = - List ( String, String ) - - -httpResponseStatus : HttpResponse body -> HttpStatus -httpResponseStatus (HttpResponse { responseStatus }) = +httpResponseStatus : T.UM_HttpResponse body -> T.UM_HttpStatus +httpResponseStatus (T.UM_HttpResponse { responseStatus }) = responseStatus -httpStatusCode : HttpStatus -> Int -httpStatusCode (HttpStatus statusCode _) = +httpStatusCode : T.UM_HttpStatus -> Int +httpStatusCode (T.UM_HttpStatus statusCode _) = statusCode -httpResponseHeaders : HttpResponse body -> HttpResponseHeaders -httpResponseHeaders (HttpResponse { responseHeaders }) = +httpResponseHeaders : T.UM_HttpResponse body -> T.UM_HttpResponseHeaders +httpResponseHeaders (T.UM_HttpResponse { responseHeaders }) = responseHeaders @@ -876,18 +900,10 @@ httpHLocation = "Location" -type HttpStatus - = HttpStatus Int String - - -- Control.Exception -type SomeException - = SomeException - - type AsyncException = UserInterrupt @@ -1067,8 +1083,8 @@ newEmptyMVar = -- Control.Concurrent.MVar (Maybe T.BED_Status) -readMVar_Maybe_BED_Status : T.MVar (Maybe T.BED_Status) -> IO (Maybe T.BED_Status) -readMVar_Maybe_BED_Status (T.MVar ref) = +readMVar_Maybe_BED_Status : T.MVar_Maybe_BED_Status -> IO (Maybe T.BED_Status) +readMVar_Maybe_BED_Status (T.MVar_Maybe_BED_Status ref) = IO (\index s -> case Array.get ref s.mVars_Maybe_BED_Status of @@ -1087,8 +1103,8 @@ readMVar_Maybe_BED_Status (T.MVar ref) = ) -putMVar_Maybe_BED_Status : T.MVar (Maybe T.BED_Status) -> Maybe T.BED_Status -> IO () -putMVar_Maybe_BED_Status (T.MVar ref) value = +putMVar_Maybe_BED_Status : T.MVar_Maybe_BED_Status -> Maybe T.BED_Status -> IO () +putMVar_Maybe_BED_Status (T.MVar_Maybe_BED_Status ref) value = IO (\index s -> case Array.get ref s.mVars_Maybe_BED_Status of @@ -1123,7 +1139,7 @@ putMVar_Maybe_BED_Status (T.MVar ref) value = ) -newEmptyMVar_Maybe_BED_Status : IO (T.MVar (Maybe T.BED_Status)) +newEmptyMVar_Maybe_BED_Status : IO T.MVar_Maybe_BED_Status newEmptyMVar_Maybe_BED_Status = IO (\_ s -> @@ -1131,14 +1147,85 @@ newEmptyMVar_Maybe_BED_Status = , IO.NewEmptyMVar_Maybe_BED_Status IO.pure (Array.length s.mVars_Maybe_BED_Status) ) ) - |> IO.fmap T.MVar + |> IO.fmap T.MVar_Maybe_BED_Status + + + +-- Control.Concurrent.MVar (Maybe T.BED_DResult) + + +readMVar_Maybe_BED_DResult : T.MVar_Maybe_BED_DResult -> IO (Maybe T.BED_DResult) +readMVar_Maybe_BED_DResult (T.MVar_Maybe_BED_DResult ref) = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_BED_DResult of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_Maybe_BED_DResult IO.pure (Just value) ) + + Nothing -> + ( { s | mVars_Maybe_BED_DResult = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_Maybe_BED_DResult index ] } s.mVars_Maybe_BED_DResult } + , IO.ReadMVar_Maybe_BED_DResult IO.pure Nothing + ) + + Nothing -> + crash "Utils.Main.readMVar: invalid ref" + ) + + +putMVar_Maybe_BED_DResult : T.MVar_Maybe_BED_DResult -> Maybe T.BED_DResult -> IO () +putMVar_Maybe_BED_DResult (T.MVar_Maybe_BED_DResult ref) value = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_BED_DResult of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_Maybe_BED_DResult = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_Maybe_BED_DResult index value ] } s.mVars_Maybe_BED_DResult } + , IO.PutMVar_Maybe_BED_DResult IO.pure [] Nothing + ) + + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_Maybe_BED_DResult readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) + + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_Maybe_BED_DResult = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_Maybe_BED_DResult } + , IO.PutMVar_Maybe_BED_DResult IO.pure readIndexes (Just value) + ) + + Nothing -> + crash "Utils.Main.putMVar: invalid ref" + ) + + +newEmptyMVar_Maybe_BED_DResult : IO T.MVar_Maybe_BED_DResult +newEmptyMVar_Maybe_BED_DResult = + IO + (\_ s -> + ( { s | mVars_Maybe_BED_DResult = Array.push { subscribers = [], value = Nothing } s.mVars_Maybe_BED_DResult } + , IO.NewEmptyMVar_Maybe_BED_DResult IO.pure (Array.length s.mVars_Maybe_BED_DResult) + ) + ) + |> IO.fmap T.MVar_Maybe_BED_DResult -- Control.Concurrent.MVar (Maybe T.CASTO_LocalGraph) -newMVar_Maybe_CASTO_LocalGraph : Maybe T.CASTO_LocalGraph -> IO (T.MVar (Maybe T.CASTO_LocalGraph)) +newMVar_Maybe_CASTO_LocalGraph : Maybe T.CASTO_LocalGraph -> IO T.MVar_Maybe_CASTO_LocalGraph newMVar_Maybe_CASTO_LocalGraph value = newEmptyMVar_Maybe_CASTO_LocalGraph |> IO.bind @@ -1148,8 +1235,8 @@ newMVar_Maybe_CASTO_LocalGraph value = ) -readMVar_Maybe_CASTO_LocalGraph : T.MVar (Maybe T.CASTO_LocalGraph) -> IO (Maybe T.CASTO_LocalGraph) -readMVar_Maybe_CASTO_LocalGraph (T.MVar ref) = +readMVar_Maybe_CASTO_LocalGraph : T.MVar_Maybe_CASTO_LocalGraph -> IO (Maybe T.CASTO_LocalGraph) +readMVar_Maybe_CASTO_LocalGraph (T.MVar_Maybe_CASTO_LocalGraph ref) = IO (\index s -> case Array.get ref s.mVars_Maybe_CASTO_LocalGraph of @@ -1164,12 +1251,12 @@ readMVar_Maybe_CASTO_LocalGraph (T.MVar ref) = ) Nothing -> - crash "Utils.Main.readMVar: invalid ref" + crash "Utils.Main.readMVar_Maybe_CASTO_LocalGraph: invalid ref" ) -putMVar_Maybe_CASTO_LocalGraph : T.MVar (Maybe T.CASTO_LocalGraph) -> Maybe T.CASTO_LocalGraph -> IO () -putMVar_Maybe_CASTO_LocalGraph (T.MVar ref) value = +putMVar_Maybe_CASTO_LocalGraph : T.MVar_Maybe_CASTO_LocalGraph -> Maybe T.CASTO_LocalGraph -> IO () +putMVar_Maybe_CASTO_LocalGraph (T.MVar_Maybe_CASTO_LocalGraph ref) value = IO (\index s -> case Array.get ref s.mVars_Maybe_CASTO_LocalGraph of @@ -1200,11 +1287,11 @@ putMVar_Maybe_CASTO_LocalGraph (T.MVar ref) value = ) Nothing -> - crash "Utils.Main.putMVar: invalid ref" + crash "Utils.Main.putMVar_Maybe_CASTO_LocalGraph: invalid ref" ) -newEmptyMVar_Maybe_CASTO_LocalGraph : IO (T.MVar (Maybe T.CASTO_LocalGraph)) +newEmptyMVar_Maybe_CASTO_LocalGraph : IO T.MVar_Maybe_CASTO_LocalGraph newEmptyMVar_Maybe_CASTO_LocalGraph = IO (\_ s -> @@ -1212,14 +1299,14 @@ newEmptyMVar_Maybe_CASTO_LocalGraph = , IO.NewEmptyMVar_Maybe_CASTO_LocalGraph IO.pure (Array.length s.mVars_Maybe_CASTO_LocalGraph) ) ) - |> IO.fmap T.MVar + |> IO.fmap T.MVar_Maybe_CASTO_LocalGraph -- Control.Concurrent.MVar (Maybe T.CASTO_GlobalGraph) -newMVar_Maybe_CASTO_GlobalGraph : Maybe T.CASTO_GlobalGraph -> IO (T.MVar (Maybe T.CASTO_GlobalGraph)) +newMVar_Maybe_CASTO_GlobalGraph : Maybe T.CASTO_GlobalGraph -> IO T.MVar_Maybe_CASTO_GlobalGraph newMVar_Maybe_CASTO_GlobalGraph value = newEmptyMVar_Maybe_CASTO_GlobalGraph |> IO.bind @@ -1229,8 +1316,8 @@ newMVar_Maybe_CASTO_GlobalGraph value = ) -readMVar_Maybe_CASTO_GlobalGraph : T.MVar (Maybe T.CASTO_GlobalGraph) -> IO (Maybe T.CASTO_GlobalGraph) -readMVar_Maybe_CASTO_GlobalGraph (T.MVar ref) = +readMVar_Maybe_CASTO_GlobalGraph : T.MVar_Maybe_CASTO_GlobalGraph -> IO (Maybe T.CASTO_GlobalGraph) +readMVar_Maybe_CASTO_GlobalGraph (T.MVar_Maybe_CASTO_GlobalGraph ref) = IO (\index s -> case Array.get ref s.mVars_Maybe_CASTO_GlobalGraph of @@ -1245,12 +1332,12 @@ readMVar_Maybe_CASTO_GlobalGraph (T.MVar ref) = ) Nothing -> - crash "Utils.Main.readMVar: invalid ref" + crash "Utils.Main.readMVar_Maybe_CASTO_GlobalGraph: invalid ref" ) -putMVar_Maybe_CASTO_GlobalGraph : T.MVar (Maybe T.CASTO_GlobalGraph) -> Maybe T.CASTO_GlobalGraph -> IO () -putMVar_Maybe_CASTO_GlobalGraph (T.MVar ref) value = +putMVar_Maybe_CASTO_GlobalGraph : T.MVar_Maybe_CASTO_GlobalGraph -> Maybe T.CASTO_GlobalGraph -> IO () +putMVar_Maybe_CASTO_GlobalGraph (T.MVar_Maybe_CASTO_GlobalGraph ref) value = IO (\index s -> case Array.get ref s.mVars_Maybe_CASTO_GlobalGraph of @@ -1281,11 +1368,11 @@ putMVar_Maybe_CASTO_GlobalGraph (T.MVar ref) value = ) Nothing -> - crash "Utils.Main.putMVar: invalid ref" + crash "Utils.Main.putMVar_Maybe_CASTO_GlobalGraph: invalid ref" ) -newEmptyMVar_Maybe_CASTO_GlobalGraph : IO (T.MVar (Maybe T.CASTO_GlobalGraph)) +newEmptyMVar_Maybe_CASTO_GlobalGraph : IO T.MVar_Maybe_CASTO_GlobalGraph newEmptyMVar_Maybe_CASTO_GlobalGraph = IO (\_ s -> @@ -1293,137 +1380,959 @@ newEmptyMVar_Maybe_CASTO_GlobalGraph = , IO.NewEmptyMVar_Maybe_CASTO_GlobalGraph IO.pure (Array.length s.mVars_Maybe_CASTO_GlobalGraph) ) ) - |> IO.fmap T.MVar + |> IO.fmap T.MVar_Maybe_CASTO_GlobalGraph --- Control.Concurrent.Chan +-- Control.Concurrent.MVar (T.BB_BResult) -type Chan a - = Chan (T.MVar (Stream a)) (T.MVar (Stream a)) +newMVar_BB_BResult : T.BB_BResult -> IO T.MVar_BB_BResult +newMVar_BB_BResult value = + newEmptyMVar_BB_BResult + |> IO.bind + (\mvar -> + putMVar_BB_BResult mvar value + |> IO.fmap (\_ -> mvar) + ) -type alias Stream a = - T.MVar (ChItem a) +readMVar_BB_BResult : T.MVar_BB_BResult -> IO T.BB_BResult +readMVar_BB_BResult (T.MVar_BB_BResult ref) = + IO + (\index s -> + case Array.get ref s.mVars_BB_BResult of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_BB_BResult IO.pure (Just value) ) + Nothing -> + ( { s | mVars_BB_BResult = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_BB_BResult index ] } s.mVars_BB_BResult } + , IO.ReadMVar_BB_BResult IO.pure Nothing + ) -type ChItem a - = ChItem a (Stream a) + Nothing -> + crash "Utils.Main.readMVar_BB_BResult: invalid ref" + ) -newChan : (T.MVar (ChItem a) -> Encode.Value) -> IO (Chan a) -newChan encoder = - newEmptyMVar - |> IO.bind - (\hole -> - newMVar encoder hole - |> IO.bind - (\readVar -> - newMVar encoder hole - |> IO.fmap - (\writeVar -> - Chan readVar writeVar - ) - ) - ) +putMVar_BB_BResult : T.MVar_BB_BResult -> T.BB_BResult -> IO () +putMVar_BB_BResult (T.MVar_BB_BResult ref) value = + IO + (\index s -> + case Array.get ref s.mVars_BB_BResult of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_BB_BResult = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_BB_BResult index value ] } s.mVars_BB_BResult } + , IO.PutMVar_BB_BResult IO.pure [] Nothing + ) + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_BB_BResult readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) -readChan : Decode.Decoder a -> Chan a -> IO a -readChan decoder (Chan readVar _) = - modifyMVar mVarDecoder mVarEncoder readVar <| - \read_end -> - readMVar (chItemDecoder decoder) read_end - |> IO.fmap - (\(ChItem val new_read_end) -> - -- Use readMVar here, not takeMVar, - -- else dupChan doesn't work - ( new_read_end, val ) - ) + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_BB_BResult = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_BB_BResult } + , IO.PutMVar_BB_BResult IO.pure readIndexes (Just value) + ) + Nothing -> + crash "Utils.Main.putMVar_BB_BResult: invalid ref" + ) -writeChan : (a -> Encode.Value) -> Chan a -> a -> IO () -writeChan encoder (Chan _ writeVar) val = - newEmptyMVar - |> IO.bind - (\new_hole -> - takeMVar mVarDecoder writeVar - |> IO.bind - (\old_hole -> - putMVar (chItemEncoder encoder) old_hole (ChItem val new_hole) - |> IO.bind (\_ -> putMVar mVarEncoder writeVar new_hole) - ) + +newEmptyMVar_BB_BResult : IO T.MVar_BB_BResult +newEmptyMVar_BB_BResult = + IO + (\_ s -> + ( { s | mVars_BB_BResult = Array.push { subscribers = [], value = Nothing } s.mVars_BB_BResult } + , IO.NewEmptyMVar_BB_BResult IO.pure (Array.length s.mVars_BB_BResult) ) + ) + |> IO.fmap T.MVar_BB_BResult --- Data.ByteString.Builder +-- Control.Concurrent.MVar (T.BB_Status) -builderHPutBuilder : IO.Handle -> String -> IO () -builderHPutBuilder handle str = - IO (\_ s -> ( s, IO.HPutStr IO.pure handle str )) +newMVar_BB_Status : T.BB_Status -> IO T.MVar_BB_Status +newMVar_BB_Status value = + newEmptyMVar_BB_Status + |> IO.bind + (\mvar -> + putMVar_BB_Status mvar value + |> IO.fmap (\_ -> mvar) + ) +readMVar_BB_Status : T.MVar_BB_Status -> IO T.BB_Status +readMVar_BB_Status (T.MVar_BB_Status ref) = + IO + (\index s -> + case Array.get ref s.mVars_BB_Status of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_BB_Status IO.pure (Just value) ) --- Data.Binary + Nothing -> + ( { s | mVars_BB_Status = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_BB_Status index ] } s.mVars_BB_Status } + , IO.ReadMVar_BB_Status IO.pure Nothing + ) + Nothing -> + crash "Utils.Main.readMVar_BB_Status: invalid ref" + ) -binaryDecodeFileOrFail : Decode.Decoder a -> T.FilePath -> IO (Result ( Int, String ) a) -binaryDecodeFileOrFail decoder filename = - IO (\_ s -> ( s, IO.BinaryDecodeFileOrFail IO.pure filename )) - |> IO.fmap - (Decode.decodeValue decoder - >> Result.mapError (\_ -> ( 0, "Could not find file " ++ filename )) - ) +putMVar_BB_Status : T.MVar_BB_Status -> T.BB_Status -> IO () +putMVar_BB_Status (T.MVar_BB_Status ref) value = + IO + (\index s -> + case Array.get ref s.mVars_BB_Status of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_BB_Status = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_BB_Status index value ] } s.mVars_BB_Status } + , IO.PutMVar_BB_Status IO.pure [] Nothing + ) -binaryEncodeFile : (a -> Encode.Value) -> T.FilePath -> a -> IO () -binaryEncodeFile encoder path value = - IO (\_ s -> ( s, IO.Write IO.pure path (encoder value) )) + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_BB_Status readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_BB_Status = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_BB_Status } + , IO.PutMVar_BB_Status IO.pure readIndexes (Just value) + ) + Nothing -> + crash "Utils.Main.putMVar_BB_Status: invalid ref" + ) --- System.Console.Haskeline +newEmptyMVar_BB_Status : IO T.MVar_BB_Status +newEmptyMVar_BB_Status = + IO + (\_ s -> + ( { s | mVars_BB_Status = Array.push { subscribers = [], value = Nothing } s.mVars_BB_Status } + , IO.NewEmptyMVar_BB_Status IO.pure (Array.length s.mVars_BB_Status) + ) + ) + |> IO.fmap T.MVar_BB_Status -type ReplSettings - = ReplSettings - { historyFile : Maybe String - , autoAddHistory : Bool - , complete : ReplCompletionFunc - } -type alias ReplInputT a = - IO a +-- Control.Concurrent.MVar (T.BB_StatusDict) -type ReplCompletion - = ReplCompletion String String Bool +newMVar_BB_StatusDict : T.BB_StatusDict -> IO T.MVar_BB_StatusDict +newMVar_BB_StatusDict value = + newEmptyMVar_BB_StatusDict + |> IO.bind + (\mvar -> + putMVar_BB_StatusDict mvar value + |> IO.fmap (\_ -> mvar) + ) -type ReplCompletionFunc - = ReplCompletionFunc +readMVar_BB_StatusDict : T.MVar_BB_StatusDict -> IO T.BB_StatusDict +readMVar_BB_StatusDict (T.MVar_BB_StatusDict ref) = + IO + (\index s -> + case Array.get ref s.mVars_BB_StatusDict of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_BB_StatusDict IO.pure (Just value) ) + Nothing -> + ( { s | mVars_BB_StatusDict = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_BB_StatusDict index ] } s.mVars_BB_StatusDict } + , IO.ReadMVar_BB_StatusDict IO.pure Nothing + ) -replRunInputT : ReplSettings -> ReplInputT Exit.ExitCode -> State.StateT s Exit.ExitCode -replRunInputT _ io = - State.liftIO io + Nothing -> + crash "Utils.Main.readMVar_BB_StatusDict: invalid ref" + ) -replWithInterrupt : ReplInputT a -> ReplInputT a -replWithInterrupt = - identity +takeMVar_BB_StatusDict : T.MVar_BB_StatusDict -> IO T.BB_StatusDict +takeMVar_BB_StatusDict (T.MVar_BB_StatusDict ref) = + IO + (\index s -> + case Array.get ref s.mVars_BB_StatusDict of + Just mVar -> + case mVar.value of + Just value -> + case mVar.subscribers of + (IO.PutMVarSubscriber_BB_StatusDict putIndex putValue) :: restSubscribers -> + ( { s | mVars_BB_StatusDict = Array.set ref { mVar | subscribers = restSubscribers, value = Just putValue } s.mVars_BB_StatusDict } + , IO.TakeMVar_BB_StatusDict IO.pure (Just value) (Just putIndex) + ) + _ -> + ( { s | mVars_BB_StatusDict = Array.set ref { mVar | value = Nothing } s.mVars_BB_StatusDict } + , IO.TakeMVar_BB_StatusDict IO.pure (Just value) Nothing + ) -replCompleteWord : Maybe Char -> String -> (String -> State.StateT a (List ReplCompletion)) -> ReplCompletionFunc -replCompleteWord _ _ _ = - -- FIXME - ReplCompletionFunc + Nothing -> + ( { s | mVars_BB_StatusDict = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.TakeMVarSubscriber_BB_StatusDict index ] } s.mVars_BB_StatusDict } + , IO.TakeMVar_BB_StatusDict IO.pure Nothing Nothing + ) + Nothing -> + crash "Utils.Main.takeMVar_BB_StatusDict: invalid ref" + ) -replGetInputLine : String -> ReplInputT (Maybe String) + +putMVar_BB_StatusDict : T.MVar_BB_StatusDict -> T.BB_StatusDict -> IO () +putMVar_BB_StatusDict (T.MVar_BB_StatusDict ref) value = + IO + (\index s -> + case Array.get ref s.mVars_BB_StatusDict of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_BB_StatusDict = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_BB_StatusDict index value ] } s.mVars_BB_StatusDict } + , IO.PutMVar_BB_StatusDict IO.pure [] Nothing + ) + + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_BB_StatusDict readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) + + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_BB_StatusDict = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_BB_StatusDict } + , IO.PutMVar_BB_StatusDict IO.pure readIndexes (Just value) + ) + + Nothing -> + crash "Utils.Main.putMVar_BB_StatusDict: invalid ref" + ) + + +newEmptyMVar_BB_StatusDict : IO T.MVar_BB_StatusDict +newEmptyMVar_BB_StatusDict = + IO + (\_ s -> + ( { s | mVars_BB_StatusDict = Array.push { subscribers = [], value = Nothing } s.mVars_BB_StatusDict } + , IO.NewEmptyMVar_BB_StatusDict IO.pure (Array.length s.mVars_BB_StatusDict) + ) + ) + |> IO.fmap T.MVar_BB_StatusDict + + + +-- Control.Concurrent.MVar (Result T.BRE_RegistryProblem T.BDS_Env) + + +newMVar_ResultRegistryProblemEnv : Result T.BRE_RegistryProblem T.BDS_Env -> IO T.MVar_ResultRegistryProblemEnv +newMVar_ResultRegistryProblemEnv value = + newEmptyMVar_ResultRegistryProblemEnv + |> IO.bind + (\mvar -> + putMVar_ResultRegistryProblemEnv mvar value + |> IO.fmap (\_ -> mvar) + ) + + +readMVar_ResultRegistryProblemEnv : T.MVar_ResultRegistryProblemEnv -> IO (Result T.BRE_RegistryProblem T.BDS_Env) +readMVar_ResultRegistryProblemEnv (T.MVar_ResultRegistryProblemEnv ref) = + IO + (\index s -> + case Array.get ref s.mVars_ResultRegistryProblemEnv of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_ResultRegistryProblemEnv IO.pure (Just value) ) + + Nothing -> + ( { s | mVars_ResultRegistryProblemEnv = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_ResultRegistryProblemEnv index ] } s.mVars_ResultRegistryProblemEnv } + , IO.ReadMVar_ResultRegistryProblemEnv IO.pure Nothing + ) + + Nothing -> + crash "Utils.Main.readMVar_ResultRegistryProblemEnv: invalid ref" + ) + + +takeMVar_ResultRegistryProblemEnv : T.MVar_ResultRegistryProblemEnv -> IO (Result T.BRE_RegistryProblem T.BDS_Env) +takeMVar_ResultRegistryProblemEnv (T.MVar_ResultRegistryProblemEnv ref) = + IO + (\index s -> + case Array.get ref s.mVars_ResultRegistryProblemEnv of + Just mVar -> + case mVar.value of + Just value -> + case mVar.subscribers of + (IO.PutMVarSubscriber_ResultRegistryProblemEnv putIndex putValue) :: restSubscribers -> + ( { s | mVars_ResultRegistryProblemEnv = Array.set ref { mVar | subscribers = restSubscribers, value = Just putValue } s.mVars_ResultRegistryProblemEnv } + , IO.TakeMVar_ResultRegistryProblemEnv IO.pure (Just value) (Just putIndex) + ) + + _ -> + ( { s | mVars_ResultRegistryProblemEnv = Array.set ref { mVar | value = Nothing } s.mVars_ResultRegistryProblemEnv } + , IO.TakeMVar_ResultRegistryProblemEnv IO.pure (Just value) Nothing + ) + + Nothing -> + ( { s | mVars_ResultRegistryProblemEnv = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.TakeMVarSubscriber_ResultRegistryProblemEnv index ] } s.mVars_ResultRegistryProblemEnv } + , IO.TakeMVar_ResultRegistryProblemEnv IO.pure Nothing Nothing + ) + + Nothing -> + crash "Utils.Main.takeMVar_ResultRegistryProblemEnv: invalid ref" + ) + + +putMVar_ResultRegistryProblemEnv : T.MVar_ResultRegistryProblemEnv -> Result T.BRE_RegistryProblem T.BDS_Env -> IO () +putMVar_ResultRegistryProblemEnv (T.MVar_ResultRegistryProblemEnv ref) value = + IO + (\index s -> + case Array.get ref s.mVars_ResultRegistryProblemEnv of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_ResultRegistryProblemEnv = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_ResultRegistryProblemEnv index value ] } s.mVars_ResultRegistryProblemEnv } + , IO.PutMVar_ResultRegistryProblemEnv IO.pure [] Nothing + ) + + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_ResultRegistryProblemEnv readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) + + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_ResultRegistryProblemEnv = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_ResultRegistryProblemEnv } + , IO.PutMVar_ResultRegistryProblemEnv IO.pure readIndexes (Just value) + ) + + Nothing -> + crash "Utils.Main.putMVar_ResultRegistryProblemEnv: invalid ref" + ) + + +newEmptyMVar_ResultRegistryProblemEnv : IO T.MVar_ResultRegistryProblemEnv +newEmptyMVar_ResultRegistryProblemEnv = + IO + (\_ s -> + ( { s | mVars_ResultRegistryProblemEnv = Array.push { subscribers = [], value = Nothing } s.mVars_ResultRegistryProblemEnv } + , IO.NewEmptyMVar_ResultRegistryProblemEnv IO.pure (Array.length s.mVars_ResultRegistryProblemEnv) + ) + ) + |> IO.fmap T.MVar_ResultRegistryProblemEnv + + + +-- Control.Concurrent.MVar (T.CED_Dep) + + +newMVar_CED_Dep : T.CED_Dep -> IO T.MVar_CED_Dep +newMVar_CED_Dep value = + newEmptyMVar_CED_Dep + |> IO.bind + (\mvar -> + putMVar_CED_Dep mvar value + |> IO.fmap (\_ -> mvar) + ) + + +readMVar_CED_Dep : T.MVar_CED_Dep -> IO T.CED_Dep +readMVar_CED_Dep (T.MVar_CED_Dep ref) = + IO + (\index s -> + case Array.get ref s.mVars_CED_Dep of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_CED_Dep IO.pure (Just value) ) + + Nothing -> + ( { s | mVars_CED_Dep = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_CED_Dep index ] } s.mVars_CED_Dep } + , IO.ReadMVar_CED_Dep IO.pure Nothing + ) + + Nothing -> + crash "Utils.Main.readMVar_CED_Dep: invalid ref" + ) + + +takeMVar_CED_Dep : T.MVar_CED_Dep -> IO T.CED_Dep +takeMVar_CED_Dep (T.MVar_CED_Dep ref) = + IO + (\index s -> + case Array.get ref s.mVars_CED_Dep of + Just mVar -> + case mVar.value of + Just value -> + case mVar.subscribers of + (IO.PutMVarSubscriber_CED_Dep putIndex putValue) :: restSubscribers -> + ( { s | mVars_CED_Dep = Array.set ref { mVar | subscribers = restSubscribers, value = Just putValue } s.mVars_CED_Dep } + , IO.TakeMVar_CED_Dep IO.pure (Just value) (Just putIndex) + ) + + _ -> + ( { s | mVars_CED_Dep = Array.set ref { mVar | value = Nothing } s.mVars_CED_Dep } + , IO.TakeMVar_CED_Dep IO.pure (Just value) Nothing + ) + + Nothing -> + ( { s | mVars_CED_Dep = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.TakeMVarSubscriber_CED_Dep index ] } s.mVars_CED_Dep } + , IO.TakeMVar_CED_Dep IO.pure Nothing Nothing + ) + + Nothing -> + crash "Utils.Main.takeMVar_CED_Dep: invalid ref" + ) + + +putMVar_CED_Dep : T.MVar_CED_Dep -> T.CED_Dep -> IO () +putMVar_CED_Dep (T.MVar_CED_Dep ref) value = + IO + (\index s -> + case Array.get ref s.mVars_CED_Dep of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_CED_Dep = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_CED_Dep index value ] } s.mVars_CED_Dep } + , IO.PutMVar_CED_Dep IO.pure [] Nothing + ) + + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_CED_Dep readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) + + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_CED_Dep = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_CED_Dep } + , IO.PutMVar_CED_Dep IO.pure readIndexes (Just value) + ) + + Nothing -> + crash "Utils.Main.putMVar_CED_Dep: invalid ref" + ) + + +newEmptyMVar_CED_Dep : IO T.MVar_CED_Dep +newEmptyMVar_CED_Dep = + IO + (\_ s -> + ( { s | mVars_CED_Dep = Array.push { subscribers = [], value = Nothing } s.mVars_CED_Dep } + , IO.NewEmptyMVar_CED_Dep IO.pure (Array.length s.mVars_CED_Dep) + ) + ) + |> IO.fmap T.MVar_CED_Dep + + + +-- Control.Concurrent.MVar (Maybe T.CECTE_Types) + + +newMVar_Maybe_CECTE_Types : Maybe T.CECTE_Types -> IO T.MVar_Maybe_CECTE_Types +newMVar_Maybe_CECTE_Types value = + newEmptyMVar_Maybe_CECTE_Types + |> IO.bind + (\mvar -> + putMVar_Maybe_CECTE_Types mvar value + |> IO.fmap (\_ -> mvar) + ) + + +readMVar_Maybe_CECTE_Types : T.MVar_Maybe_CECTE_Types -> IO (Maybe T.CECTE_Types) +readMVar_Maybe_CECTE_Types (T.MVar_Maybe_CECTE_Types ref) = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_CECTE_Types of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_Maybe_CECTE_Types IO.pure (Just value) ) + + Nothing -> + ( { s | mVars_Maybe_CECTE_Types = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_Maybe_CECTE_Types index ] } s.mVars_Maybe_CECTE_Types } + , IO.ReadMVar_Maybe_CECTE_Types IO.pure Nothing + ) + + Nothing -> + crash "Utils.Main.readMVar_Maybe_CECTE_Types: invalid ref" + ) + + +takeMVar_Maybe_CECTE_Types : T.MVar_Maybe_CECTE_Types -> IO (Maybe T.CECTE_Types) +takeMVar_Maybe_CECTE_Types (T.MVar_Maybe_CECTE_Types ref) = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_CECTE_Types of + Just mVar -> + case mVar.value of + Just value -> + case mVar.subscribers of + (IO.PutMVarSubscriber_Maybe_CECTE_Types putIndex putValue) :: restSubscribers -> + ( { s | mVars_Maybe_CECTE_Types = Array.set ref { mVar | subscribers = restSubscribers, value = Just putValue } s.mVars_Maybe_CECTE_Types } + , IO.TakeMVar_Maybe_CECTE_Types IO.pure (Just value) (Just putIndex) + ) + + _ -> + ( { s | mVars_Maybe_CECTE_Types = Array.set ref { mVar | value = Nothing } s.mVars_Maybe_CECTE_Types } + , IO.TakeMVar_Maybe_CECTE_Types IO.pure (Just value) Nothing + ) + + Nothing -> + ( { s | mVars_Maybe_CECTE_Types = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.TakeMVarSubscriber_Maybe_CECTE_Types index ] } s.mVars_Maybe_CECTE_Types } + , IO.TakeMVar_Maybe_CECTE_Types IO.pure Nothing Nothing + ) + + Nothing -> + crash "Utils.Main.takeMVar_Maybe_CECTE_Types: invalid ref" + ) + + +putMVar_Maybe_CECTE_Types : T.MVar_Maybe_CECTE_Types -> Maybe T.CECTE_Types -> IO () +putMVar_Maybe_CECTE_Types (T.MVar_Maybe_CECTE_Types ref) value = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_CECTE_Types of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_Maybe_CECTE_Types = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_Maybe_CECTE_Types index value ] } s.mVars_Maybe_CECTE_Types } + , IO.PutMVar_Maybe_CECTE_Types IO.pure [] Nothing + ) + + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_Maybe_CECTE_Types readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) + + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_Maybe_CECTE_Types = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_Maybe_CECTE_Types } + , IO.PutMVar_Maybe_CECTE_Types IO.pure readIndexes (Just value) + ) + + Nothing -> + crash "Utils.Main.putMVar_Maybe_CECTE_Types: invalid ref" + ) + + +newEmptyMVar_Maybe_CECTE_Types : IO T.MVar_Maybe_CECTE_Types +newEmptyMVar_Maybe_CECTE_Types = + IO + (\_ s -> + ( { s | mVars_Maybe_CECTE_Types = Array.push { subscribers = [], value = Nothing } s.mVars_Maybe_CECTE_Types } + , IO.NewEmptyMVar_Maybe_CECTE_Types IO.pure (Array.length s.mVars_Maybe_CECTE_Types) + ) + ) + |> IO.fmap T.MVar_Maybe_CECTE_Types + + + +-- Control.Concurrent.MVar (Maybe T.BB_Dependencies) + + +newMVar_Maybe_BB_Dependencies : Maybe T.BB_Dependencies -> IO T.MVar_Maybe_BB_Dependencies +newMVar_Maybe_BB_Dependencies value = + newEmptyMVar_Maybe_BB_Dependencies + |> IO.bind + (\mvar -> + putMVar_Maybe_BB_Dependencies mvar value + |> IO.fmap (\_ -> mvar) + ) + + +readMVar_Maybe_BB_Dependencies : T.MVar_Maybe_BB_Dependencies -> IO (Maybe T.BB_Dependencies) +readMVar_Maybe_BB_Dependencies (T.MVar_Maybe_BB_Dependencies ref) = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_BB_Dependencies of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_Maybe_BB_Dependencies IO.pure (Just value) ) + + Nothing -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_Maybe_BB_Dependencies index ] } s.mVars_Maybe_BB_Dependencies } + , IO.ReadMVar_Maybe_BB_Dependencies IO.pure Nothing + ) + + Nothing -> + crash "Utils.Main.readMVar_Maybe_BB_Dependencies: invalid ref" + ) + + +takeMVar_Maybe_BB_Dependencies : T.MVar_Maybe_BB_Dependencies -> IO (Maybe T.BB_Dependencies) +takeMVar_Maybe_BB_Dependencies (T.MVar_Maybe_BB_Dependencies ref) = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_BB_Dependencies of + Just mVar -> + case mVar.value of + Just value -> + case mVar.subscribers of + (IO.PutMVarSubscriber_Maybe_BB_Dependencies putIndex putValue) :: restSubscribers -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = restSubscribers, value = Just putValue } s.mVars_Maybe_BB_Dependencies } + , IO.TakeMVar_Maybe_BB_Dependencies IO.pure (Just value) (Just putIndex) + ) + + _ -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | value = Nothing } s.mVars_Maybe_BB_Dependencies } + , IO.TakeMVar_Maybe_BB_Dependencies IO.pure (Just value) Nothing + ) + + Nothing -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.TakeMVarSubscriber_Maybe_BB_Dependencies index ] } s.mVars_Maybe_BB_Dependencies } + , IO.TakeMVar_Maybe_BB_Dependencies IO.pure Nothing Nothing + ) + + Nothing -> + crash "Utils.Main.takeMVar_Maybe_BB_Dependencies: invalid ref" + ) + + +putMVar_Maybe_BB_Dependencies : T.MVar_Maybe_BB_Dependencies -> Maybe T.BB_Dependencies -> IO () +putMVar_Maybe_BB_Dependencies (T.MVar_Maybe_BB_Dependencies ref) value = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_BB_Dependencies of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_Maybe_BB_Dependencies index value ] } s.mVars_Maybe_BB_Dependencies } + , IO.PutMVar_Maybe_BB_Dependencies IO.pure [] Nothing + ) + + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_Maybe_BB_Dependencies readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) + + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_Maybe_BB_Dependencies } + , IO.PutMVar_Maybe_BB_Dependencies IO.pure readIndexes (Just value) + ) + + Nothing -> + crash "Utils.Main.putMVar_Maybe_BB_Dependencies: invalid ref" + ) + + +newEmptyMVar_Maybe_BB_Dependencies : IO T.MVar_Maybe_BB_Dependencies +newEmptyMVar_Maybe_BB_Dependencies = + IO + (\_ s -> + ( { s | mVars_Maybe_BB_Dependencies = Array.push { subscribers = [], value = Nothing } s.mVars_Maybe_BB_Dependencies } + , IO.NewEmptyMVar_Maybe_BB_Dependencies IO.pure (Array.length s.mVars_Maybe_BB_Dependencies) + ) + ) + |> IO.fmap T.MVar_Maybe_BB_Dependencies + + + +-- Control.Concurrent.MVar (Maybe T.BB_Dependencies) + + +newMVar_Maybe_BB_Dependencies : Maybe T.BB_Dependencies -> IO T.MVar_Maybe_BB_Dependencies +newMVar_Maybe_BB_Dependencies value = + newEmptyMVar_Maybe_BB_Dependencies + |> IO.bind + (\mvar -> + putMVar_Maybe_BB_Dependencies mvar value + |> IO.fmap (\_ -> mvar) + ) + + +readMVar_Maybe_BB_Dependencies : T.MVar_Maybe_BB_Dependencies -> IO (Maybe T.BB_Dependencies) +readMVar_Maybe_BB_Dependencies (T.MVar_Maybe_BB_Dependencies ref) = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_BB_Dependencies of + Just mVar -> + case mVar.value of + Just value -> + ( s, IO.ReadMVar_Maybe_BB_Dependencies IO.pure (Just value) ) + + Nothing -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.ReadMVarSubscriber_Maybe_BB_Dependencies index ] } s.mVars_Maybe_BB_Dependencies } + , IO.ReadMVar_Maybe_BB_Dependencies IO.pure Nothing + ) + + Nothing -> + crash "Utils.Main.readMVar_Maybe_BB_Dependencies: invalid ref" + ) + + +takeMVar_Maybe_BB_Dependencies : T.MVar_Maybe_BB_Dependencies -> IO (Maybe T.BB_Dependencies) +takeMVar_Maybe_BB_Dependencies (T.MVar_Maybe_BB_Dependencies ref) = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_BB_Dependencies of + Just mVar -> + case mVar.value of + Just value -> + case mVar.subscribers of + (IO.PutMVarSubscriber_Maybe_BB_Dependencies putIndex putValue) :: restSubscribers -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = restSubscribers, value = Just putValue } s.mVars_Maybe_BB_Dependencies } + , IO.TakeMVar_Maybe_BB_Dependencies IO.pure (Just value) (Just putIndex) + ) + + _ -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | value = Nothing } s.mVars_Maybe_BB_Dependencies } + , IO.TakeMVar_Maybe_BB_Dependencies IO.pure (Just value) Nothing + ) + + Nothing -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.TakeMVarSubscriber_Maybe_BB_Dependencies index ] } s.mVars_Maybe_BB_Dependencies } + , IO.TakeMVar_Maybe_BB_Dependencies IO.pure Nothing Nothing + ) + + Nothing -> + crash "Utils.Main.takeMVar_Maybe_BB_Dependencies: invalid ref" + ) + + +putMVar_Maybe_BB_Dependencies : T.MVar_Maybe_BB_Dependencies -> Maybe T.BB_Dependencies -> IO () +putMVar_Maybe_BB_Dependencies (T.MVar_Maybe_BB_Dependencies ref) value = + IO + (\index s -> + case Array.get ref s.mVars_Maybe_BB_Dependencies of + Just mVar -> + case mVar.value of + Just _ -> + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = mVar.subscribers ++ [ IO.PutMVarSubscriber_Maybe_BB_Dependencies index value ] } s.mVars_Maybe_BB_Dependencies } + , IO.PutMVar_Maybe_BB_Dependencies IO.pure [] Nothing + ) + + Nothing -> + let + ( filteredSubscribers, readIndexes ) = + List.foldr + (\subscriber ( filteredSubscribersAcc, readIndexesAcc ) -> + case subscriber of + IO.ReadMVarSubscriber_Maybe_BB_Dependencies readIndex -> + ( filteredSubscribersAcc, readIndex :: readIndexesAcc ) + + _ -> + ( subscriber :: filteredSubscribersAcc, readIndexesAcc ) + ) + ( [], [] ) + mVar.subscribers + in + ( { s | mVars_Maybe_BB_Dependencies = Array.set ref { mVar | subscribers = filteredSubscribers, value = Just value } s.mVars_Maybe_BB_Dependencies } + , IO.PutMVar_Maybe_BB_Dependencies IO.pure readIndexes (Just value) + ) + + Nothing -> + crash "Utils.Main.putMVar_Maybe_BB_Dependencies: invalid ref" + ) + + +newEmptyMVar_Maybe_BB_Dependencies : IO T.MVar_Maybe_BB_Dependencies +newEmptyMVar_Maybe_BB_Dependencies = + IO + (\_ s -> + ( { s | mVars_Maybe_BB_Dependencies = Array.push { subscribers = [], value = Nothing } s.mVars_Maybe_BB_Dependencies } + , IO.NewEmptyMVar_Maybe_BB_Dependencies IO.pure (Array.length s.mVars_Maybe_BB_Dependencies) + ) + ) + |> IO.fmap T.MVar_Maybe_BB_Dependencies + + + +-- Control.Concurrent.Chan + + +type Chan a + = Chan (T.MVar (Stream a)) (T.MVar (Stream a)) + + +type alias Stream a = + T.MVar (ChItem a) + + +type ChItem a + = ChItem a (Stream a) + + +newChan : (T.MVar (ChItem a) -> Encode.Value) -> IO (Chan a) +newChan encoder = + newEmptyMVar + |> IO.bind + (\hole -> + newMVar encoder hole + |> IO.bind + (\readVar -> + newMVar encoder hole + |> IO.fmap + (\writeVar -> + Chan readVar writeVar + ) + ) + ) + + +readChan : Decode.Decoder a -> Chan a -> IO a +readChan decoder (Chan readVar _) = + modifyMVar mVarDecoder mVarEncoder readVar <| + \read_end -> + readMVar (chItemDecoder decoder) read_end + |> IO.fmap + (\(ChItem val new_read_end) -> + -- Use readMVar here, not takeMVar, + -- else dupChan doesn't work + ( new_read_end, val ) + ) + + +writeChan : (a -> Encode.Value) -> Chan a -> a -> IO () +writeChan encoder (Chan _ writeVar) val = + newEmptyMVar + |> IO.bind + (\new_hole -> + takeMVar mVarDecoder writeVar + |> IO.bind + (\old_hole -> + putMVar (chItemEncoder encoder) old_hole (ChItem val new_hole) + |> IO.bind (\_ -> putMVar mVarEncoder writeVar new_hole) + ) + ) + + + +-- Data.ByteString.Builder + + +builderHPutBuilder : IO.Handle -> String -> IO () +builderHPutBuilder handle str = + IO (\_ s -> ( s, IO.HPutStr IO.pure handle str )) + + + +-- Data.Binary + + +binaryDecodeFileOrFail : Decode.Decoder a -> T.FilePath -> IO (Result ( Int, String ) a) +binaryDecodeFileOrFail decoder filename = + IO (\_ s -> ( s, IO.BinaryDecodeFileOrFail IO.pure filename )) + |> IO.fmap + (Decode.decodeValue decoder + >> Result.mapError (\_ -> ( 0, "Could not find file " ++ filename )) + ) + + +binaryEncodeFile : (a -> Encode.Value) -> T.FilePath -> a -> IO () +binaryEncodeFile encoder path value = + IO (\_ s -> ( s, IO.Write IO.pure path (encoder value) )) + + + +-- System.Console.Haskeline + + +type ReplSettings + = ReplSettings + { historyFile : Maybe String + , autoAddHistory : Bool + , complete : ReplCompletionFunc + } + + +type alias ReplInputT a = + IO a + + +type ReplCompletion + = ReplCompletion String String Bool + + +type ReplCompletionFunc + = ReplCompletionFunc + + +replRunInputT : ReplSettings -> ReplInputT Exit.ExitCode -> State.StateT s Exit.ExitCode +replRunInputT _ io = + State.liftIO io + + +replWithInterrupt : ReplInputT a -> ReplInputT a +replWithInterrupt = + identity + + +replCompleteWord : Maybe Char -> String -> (String -> State.StateT a (List ReplCompletion)) -> ReplCompletionFunc +replCompleteWord _ _ _ = + -- FIXME + ReplCompletionFunc + + +replGetInputLine : String -> ReplInputT (Maybe String) replGetInputLine prompt = IO (\_ s -> ( s, IO.ReplGetInputLine IO.pure prompt )) @@ -1442,11 +2351,61 @@ mVarDecoder = Decode.map T.MVar Decode.int +mVarDecoder_Maybe_BED_Status : Decode.Decoder T.MVar_Maybe_BED_Status +mVarDecoder_Maybe_BED_Status = + Decode.map T.MVar_Maybe_BED_Status Decode.int + + +mVarDecoder_Maybe_BED_DResult : Decode.Decoder T.MVar_Maybe_BED_DResult +mVarDecoder_Maybe_BED_DResult = + Decode.map T.MVar_Maybe_BED_DResult Decode.int + + +mVarDecoder_BB_BResult : Decode.Decoder T.MVar_BB_BResult +mVarDecoder_BB_BResult = + Decode.map T.MVar_BB_BResult Decode.int + + +mVarDecoder_CED_Dep : Decode.Decoder T.MVar_CED_Dep +mVarDecoder_CED_Dep = + Decode.map T.MVar_CED_Dep Decode.int + + +mVarDecoder_Maybe_CECTE_Types : Decode.Decoder T.MVar_Maybe_CECTE_Types +mVarDecoder_Maybe_CECTE_Types = + Decode.map T.MVar_Maybe_CECTE_Types Decode.int + + mVarEncoder : T.MVar a -> Encode.Value mVarEncoder (T.MVar ref) = Encode.int ref +mVarEncoder_Maybe_BED_Status : T.MVar_Maybe_BED_Status -> Encode.Value +mVarEncoder_Maybe_BED_Status (T.MVar_Maybe_BED_Status ref) = + Encode.int ref + + +mVarEncoder_Maybe_BED_DResult : T.MVar_Maybe_BED_DResult -> Encode.Value +mVarEncoder_Maybe_BED_DResult (T.MVar_Maybe_BED_DResult ref) = + Encode.int ref + + +mVarEncoder_BB_BResult : T.MVar_BB_BResult -> Encode.Value +mVarEncoder_BB_BResult (T.MVar_BB_BResult ref) = + Encode.int ref + + +mVarEncoder_CED_Dep : T.MVar_CED_Dep -> Encode.Value +mVarEncoder_CED_Dep (T.MVar_CED_Dep ref) = + Encode.int ref + + +mVarEncoder_Maybe_CECTE_Types : T.MVar_Maybe_CECTE_Types -> Encode.Value +mVarEncoder_Maybe_CECTE_Types (T.MVar_Maybe_CECTE_Types ref) = + Encode.int ref + + chItemEncoder : (a -> Encode.Value) -> ChItem a -> Encode.Value chItemEncoder valueEncoder (ChItem value hole) = Encode.object @@ -1461,18 +2420,18 @@ chItemDecoder decoder = Decode.map2 ChItem (Decode.field "value" decoder) (Decode.field "hole" mVarDecoder) -someExceptionEncoder : SomeException -> Encode.Value +someExceptionEncoder : T.UM_SomeException -> Encode.Value someExceptionEncoder _ = Encode.object [ ( "type", Encode.string "SomeException" ) ] -someExceptionDecoder : Decode.Decoder SomeException +someExceptionDecoder : Decode.Decoder T.UM_SomeException someExceptionDecoder = - Decode.succeed SomeException + Decode.succeed T.UM_SomeException -httpResponseEncoder : HttpResponse body -> Encode.Value -httpResponseEncoder (HttpResponse httpResponse) = +httpResponseEncoder : T.UM_HttpResponse body -> Encode.Value +httpResponseEncoder (T.UM_HttpResponse httpResponse) = Encode.object [ ( "type", Encode.string "HttpResponse" ) , ( "responseStatus", httpStatusEncoder httpResponse.responseStatus ) @@ -1480,11 +2439,11 @@ httpResponseEncoder (HttpResponse httpResponse) = ] -httpResponseDecoder : Decode.Decoder (HttpResponse body) +httpResponseDecoder : Decode.Decoder (T.UM_HttpResponse body) httpResponseDecoder = Decode.map2 (\responseStatus responseHeaders -> - HttpResponse + T.UM_HttpResponse { responseStatus = responseStatus , responseHeaders = responseHeaders } @@ -1493,8 +2452,8 @@ httpResponseDecoder = (Decode.field "responseHeaders" httpResponseHeadersDecoder) -httpStatusEncoder : HttpStatus -> Encode.Value -httpStatusEncoder (HttpStatus statusCode statusMessage) = +httpStatusEncoder : T.UM_HttpStatus -> Encode.Value +httpStatusEncoder (T.UM_HttpStatus statusCode statusMessage) = Encode.object [ ( "type", Encode.string "HttpStatus" ) , ( "statusCode", Encode.int statusCode ) @@ -1502,62 +2461,62 @@ httpStatusEncoder (HttpStatus statusCode statusMessage) = ] -httpStatusDecoder : Decode.Decoder HttpStatus +httpStatusDecoder : Decode.Decoder T.UM_HttpStatus httpStatusDecoder = - Decode.map2 HttpStatus + Decode.map2 T.UM_HttpStatus (Decode.field "statusCode" Decode.int) (Decode.field "statusMessage" Decode.string) -httpResponseHeadersEncoder : HttpResponseHeaders -> Encode.Value +httpResponseHeadersEncoder : T.UM_HttpResponseHeaders -> Encode.Value httpResponseHeadersEncoder = Encode.list (E.jsonPair Encode.string Encode.string) -httpResponseHeadersDecoder : Decode.Decoder HttpResponseHeaders +httpResponseHeadersDecoder : Decode.Decoder T.UM_HttpResponseHeaders httpResponseHeadersDecoder = Decode.list (D.jsonPair Decode.string Decode.string) -httpExceptionContentEncoder : HttpExceptionContent -> Encode.Value +httpExceptionContentEncoder : T.UM_HttpExceptionContent -> Encode.Value httpExceptionContentEncoder httpExceptionContent = case httpExceptionContent of - StatusCodeException response body -> + T.UM_StatusCodeException response body -> Encode.object [ ( "type", Encode.string "StatusCodeException" ) , ( "response", httpResponseEncoder response ) , ( "body", Encode.string body ) ] - TooManyRedirects responses -> + T.UM_TooManyRedirects responses -> Encode.object [ ( "type", Encode.string "TooManyRedirects" ) , ( "responses", Encode.list httpResponseEncoder responses ) ] - ConnectionFailure someException -> + T.UM_ConnectionFailure someException -> Encode.object [ ( "type", Encode.string "ConnectionFailure" ) , ( "someException", someExceptionEncoder someException ) ] -httpExceptionContentDecoder : Decode.Decoder HttpExceptionContent +httpExceptionContentDecoder : Decode.Decoder T.UM_HttpExceptionContent httpExceptionContentDecoder = Decode.field "type" Decode.string |> Decode.andThen (\type_ -> case type_ of "StatusCodeException" -> - Decode.map2 StatusCodeException + Decode.map2 T.UM_StatusCodeException (Decode.field "response" httpResponseDecoder) (Decode.field "body" Decode.string) "TooManyRedirects" -> - Decode.map TooManyRedirects (Decode.field "responses" (Decode.list httpResponseDecoder)) + Decode.map T.UM_TooManyRedirects (Decode.field "responses" (Decode.list httpResponseDecoder)) "ConnectionFailure" -> - Decode.map ConnectionFailure (Decode.field "someException" someExceptionDecoder) + Decode.map T.UM_ConnectionFailure (Decode.field "someException" someExceptionDecoder) _ -> Decode.fail ("Failed to decode HttpExceptionContent's type: " ++ type_)