Skip to content

Commit

Permalink
WIP Types
Browse files Browse the repository at this point in the history
  • Loading branch information
@decioferreira
decioferreira committed Dec 21, 2024
1 parent e04c7c1 commit abedcf9
Show file tree
Hide file tree
Showing 5 changed files with 459 additions and 34 deletions.
23 changes: 9 additions & 14 deletions src/Builder/BackgroundWriter.elm
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
module Builder.BackgroundWriter exposing
( Scope
, withScope
( withScope
, writeBinary
)

Expand All @@ -16,19 +15,15 @@ import Utils.Main as Utils
-- BACKGROUND WRITER


type Scope
= Scope (T.MVar (List (T.MVar ())))


withScope : (Scope -> IO a) -> IO a
withScope : (T.BBW_Scope -> IO a) -> IO a
withScope callback =
Utils.newMVar (Encode.list (\_ -> Encode.null)) []
Utils.newMVar_ListMVar []
|> IO.bind
(\workList ->
callback (Scope workList)
callback (T.BBW_Scope workList)
|> IO.bind
(\result ->
Utils.takeMVar (Decode.list Utils.mVarDecoder) workList
Utils.takeMVar_ListMVar workList
|> IO.bind
(\mvars ->
Utils.listTraverse_ (Utils.takeMVar (Decode.succeed ())) mvars
Expand All @@ -38,23 +33,23 @@ withScope callback =
)


writeBinary : (a -> Encode.Value) -> Scope -> String -> a -> IO ()
writeBinary encoder (Scope workList) path value =
writeBinary : (a -> Encode.Value) -> T.BBW_Scope -> String -> a -> IO ()
writeBinary encoder (T.BBW_Scope workList) path value =
Utils.newEmptyMVar
|> IO.bind
(\mvar ->
Utils.forkIO (File.writeBinary encoder path value |> IO.bind (\_ -> Utils.putMVar (\_ -> Encode.object []) mvar ()))
|> IO.bind
(\_ ->
Utils.takeMVar (Decode.list Utils.mVarDecoder) workList
Utils.takeMVar_ListMVar workList
|> IO.bind
(\oldWork ->
let
newWork : List (T.MVar ())
newWork =
mvar :: oldWork
in
Utils.putMVar (Encode.list Utils.mVarEncoder) workList newWork
Utils.putMVar_ListMVar workList newWork
)
)
)
28 changes: 9 additions & 19 deletions src/Builder/Elm/Details.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,7 +104,7 @@ loadInterfaces root (Details _ _ _ _ _ extras) =
-- VERIFY INSTALL -- used by Install


verifyInstall : BW.Scope -> T.FilePath -> T.BDS_Env -> Outline.Outline -> IO (Result Exit.Details ())
verifyInstall : T.BBW_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
Expand All @@ -131,7 +131,7 @@ verifyInstall scope root (T.BDS_Env cache manager connection registry) outline =
-- LOAD -- used by Make, Repl, Reactor


load : Reporting.Style -> BW.Scope -> T.FilePath -> IO (Result Exit.Details Details)
load : Reporting.Style -> T.BBW_Scope -> T.FilePath -> IO (Result Exit.Details Details)
load style scope root =
File.getTime (root ++ "/elm.json")
|> IO.bind
Expand All @@ -157,7 +157,7 @@ load style scope root =
-- GENERATE


generate : Reporting.Style -> BW.Scope -> T.FilePath -> T.BF_Time -> IO (Result Exit.Details Details)
generate : Reporting.Style -> T.BBW_Scope -> T.FilePath -> T.BF_Time -> IO (Result Exit.Details Details)
generate style scope root time =
Reporting.trackDetails style
(\key ->
Expand All @@ -184,10 +184,10 @@ generate style scope root time =


type Env
= Env Reporting.DKey BW.Scope T.FilePath T.BS_PackageCache T.BH_Manager T.BDS_Connection T.BDR_Registry
= Env Reporting.DKey T.BBW_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 : Reporting.DKey -> T.BBW_Scope -> T.FilePath -> IO (Result Exit.Details ( Env, Outline.Outline ))
initEnv key scope root =
fork_ResultRegistryProblemEnv Solver.initEnv
|> IO.bind
Expand Down Expand Up @@ -633,13 +633,13 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs =
|> IO.fmap (\_ -> Err (Just (T.BRE_BD_BadBuild pkg vsn f)))

Just statuses ->
Utils.newEmptyMVar
Utils.newEmptyMVar_DictRawMVarMaybeDResult
|> IO.bind
(\rmvar ->
Utils.mapTraverse identity compare (fork_Maybe_BED_DResult << compile pkg rmvar) statuses
|> IO.bind
(\rmvars ->
Utils.putMVar dictRawMVarMaybeDResultEncoder rmvar rmvars
Utils.putMVar_DictRawMVarMaybeDResult rmvar rmvars
|> IO.bind (\_ -> Utils.mapTraverse identity compare Utils.readMVar_Maybe_BED_DResult rmvars)
|> IO.bind
(\maybeResults ->
Expand Down Expand Up @@ -909,11 +909,11 @@ getDepHome fi =
-- COMPILE


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 : T.CEP_Name -> T.MVar_DictRawMVarMaybeDResult -> 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
Utils.readMVar_DictRawMVarMaybeDResult mvar
|> IO.bind
(\resultsDict ->
Utils.mapTraverse identity compare Utils.readMVar_Maybe_BED_DResult (Dict.intersection compare resultsDict deps)
Expand Down Expand Up @@ -1145,16 +1145,6 @@ artifactCacheDecoder =
(Decode.field "artifacts" artifactsDecoder)


dictRawMVarMaybeDResultEncoder : Dict String T.CEMN_Raw T.MVar_Maybe_BED_DResult -> Encode.Value
dictRawMVarMaybeDResultEncoder =
E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder_Maybe_BED_DResult


moduleNameRawMVarMaybeDResultDecoder : Decode.Decoder (Dict String T.CEMN_Raw T.MVar_Maybe_BED_DResult)
moduleNameRawMVarMaybeDResultDecoder =
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_Maybe_BED_Status statusDict
Expand Down
Loading

0 comments on commit abedcf9

Please sign in to comment.