diff --git a/elm.json b/elm.json index 46c07ce3a..46473f748 100644 --- a/elm.json +++ b/elm.json @@ -6,9 +6,13 @@ "elm-version": "0.19.1", "dependencies": { "direct": { + "bburdette/toop": "1.2.0", + "danfishgold/base64-bytes": "1.1.0", "dasch/levenshtein": "1.0.3", + "elm/bytes": "1.0.8", "elm/core": "1.0.5", "elm/json": "1.1.3", + "elm/regex": "1.0.0", "elm/time": "1.0.0", "elm/url": "1.0.0", "elm-community/array-extra": "2.6.0", @@ -24,7 +28,6 @@ "indirect": { "andre-dietrich/parser-combinators": "4.1.0", "elm/parser": "1.1.0", - "elm/regex": "1.0.0", "fredcy/elm-parseint": "2.0.1", "pilatch/flip": "1.0.0", "zwilias/elm-rosetree": "1.5.0" @@ -35,7 +38,6 @@ "elm-explorations/test": "2.2.0" }, "indirect": { - "elm/bytes": "1.0.8", "elm/html": "1.0.0", "elm/random": "1.0.0", "elm/virtual-dom": "1.0.3" diff --git a/src/Builder/BackgroundWriter.elm b/src/Builder/BackgroundWriter.elm index acac3eba4..f05aaec59 100644 --- a/src/Builder/BackgroundWriter.elm +++ b/src/Builder/BackgroundWriter.elm @@ -5,8 +5,7 @@ module Builder.BackgroundWriter exposing ) import Builder.File as File -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.IO as IO exposing (IO) import Utils.Main as Utils @@ -21,31 +20,31 @@ type Scope withScope : (Scope -> IO a) -> IO a withScope callback = - Utils.newMVar (Encode.list (\_ -> Encode.null)) [] + Utils.newMVar (Serialize.list Utils.mVarCodec) [] |> IO.bind (\workList -> callback (Scope workList) |> IO.bind (\result -> - Utils.takeMVar (Decode.list Utils.mVarDecoder) workList + Utils.takeMVar (Serialize.list Utils.mVarCodec) workList |> IO.bind (\mvars -> - Utils.listTraverse_ (Utils.takeMVar (Decode.succeed ())) mvars + Utils.listTraverse_ (Utils.takeMVar Serialize.unit) mvars |> IO.fmap (\_ -> result) ) ) ) -writeBinary : (a -> Encode.Value) -> Scope -> String -> a -> IO () -writeBinary encoder (Scope workList) path value = +writeBinary : Codec e a -> Scope -> String -> a -> IO () +writeBinary codec (Scope workList) path value = Utils.newEmptyMVar |> IO.bind (\mvar -> - Utils.forkIO (File.writeBinary encoder path value |> IO.bind (\_ -> Utils.putMVar (\_ -> Encode.object []) mvar ())) + Utils.forkIO (File.writeBinary codec path value |> IO.bind (\_ -> Utils.putMVar Serialize.unit mvar ())) |> IO.bind (\_ -> - Utils.takeMVar (Decode.list Utils.mVarDecoder) workList + Utils.takeMVar (Serialize.list Utils.mVarCodec) workList |> IO.bind (\oldWork -> let @@ -53,7 +52,7 @@ writeBinary encoder (Scope workList) path value = newWork = mvar :: oldWork in - Utils.putMVar (Encode.list Utils.mVarEncoder) workList newWork + Utils.putMVar (Serialize.list Utils.mVarCodec) workList newWork ) ) ) diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index 3d34e11c8..eb3be342e 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -7,7 +7,7 @@ module Builder.Build exposing , Module(..) , ReplArtifacts(..) , Root(..) - , cachedInterfaceDecoder + , cachedInterfaceCodec , fromExposed , fromPaths , fromRepl @@ -36,7 +36,6 @@ import Compiler.Elm.Docs as Docs import Compiler.Elm.Interface as I import Compiler.Elm.ModuleName as ModuleName import Compiler.Elm.Package as Pkg -import Compiler.Json.Decode as D import Compiler.Json.Encode as E import Compiler.Parse.Module as Parse import Compiler.Reporting.Annotation as A @@ -45,11 +44,11 @@ import Compiler.Reporting.Error.Docs as EDocs import Compiler.Reporting.Error.Import as Import import Compiler.Reporting.Error.Syntax as Syntax import Compiler.Reporting.Render.Type.Localizer as L +import Compiler.Serialize as S import Data.Graph as Graph import Data.Map as Dict exposing (Dict) import Data.Set as EverySet -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.IO as IO exposing (IO) import System.TypeCheck.IO as TypeCheck import Utils.Crash exposing (crash) @@ -111,28 +110,28 @@ addRelative (AbsoluteSrcDir srcDir) path = described in Chapter 13 of Parallel and Concurrent Programming in Haskell by Simon Marlow -} -fork : (a -> Encode.Value) -> IO a -> IO (MVar a) -fork encoder work = +fork : Codec e a -> IO a -> IO (MVar a) +fork codec work = Utils.newEmptyMVar |> IO.bind (\mvar -> - Utils.forkIO (IO.bind (Utils.putMVar encoder mvar) work) + Utils.forkIO (IO.bind (Utils.putMVar codec mvar) work) |> IO.fmap (\_ -> mvar) ) -forkWithKey : (k -> comparable) -> (k -> k -> Order) -> (b -> Encode.Value) -> (k -> a -> IO b) -> Dict comparable k a -> IO (Dict comparable k (MVar b)) -forkWithKey toComparable keyComparison encoder func dict = - Utils.mapTraverseWithKey toComparable keyComparison (\k v -> fork encoder (func k v)) dict +forkWithKey : (k -> comparable) -> (k -> k -> Order) -> Codec e b -> (k -> a -> IO b) -> Dict comparable k a -> IO (Dict comparable k (MVar b)) +forkWithKey toComparable keyComparison codec func dict = + Utils.mapTraverseWithKey toComparable keyComparison (\k v -> fork codec (func k v)) dict -- FROM EXPOSED -fromExposed : Decode.Decoder docs -> (docs -> Encode.Value) -> Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.Nonempty ModuleName.Raw -> IO (Result Exit.BuildProblem docs) -fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e es) as exposed) = - Reporting.trackBuild docsDecoder docsEncoder style <| +fromExposed : Codec (Serialize.Error e) docs -> Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.Nonempty ModuleName.Raw -> IO (Result Exit.BuildProblem docs) +fromExposed docsCodec style root details docsGoal ((NE.Nonempty e es) as exposed) = + Reporting.trackBuild docsCodec style <| \key -> makeEnv key root details |> IO.bind @@ -149,16 +148,16 @@ fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e docsNeed = toDocsNeed docsGoal in - Map.fromKeysA identity (fork statusEncoder << crawlModule env mvar docsNeed) (e :: es) + Map.fromKeysA identity (fork statusCodec << crawlModule env mvar docsNeed) (e :: es) |> IO.bind (\roots -> - Utils.putMVar statusDictEncoder mvar roots + Utils.putMVar statusDictCodec mvar roots |> IO.bind (\_ -> - Utils.dictMapM_ compare (Utils.readMVar statusDecoder) roots + Utils.dictMapM_ compare (Utils.readMVar statusCodec) roots |> IO.bind (\_ -> - IO.bind (Utils.mapTraverse identity compare (Utils.readMVar statusDecoder)) (Utils.readMVar statusDictDecoder mvar) + IO.bind (Utils.mapTraverse identity compare (Utils.readMVar statusCodec)) (Utils.readMVar statusDictCodec mvar) |> IO.bind (\statuses -> -- compile @@ -173,13 +172,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 identity compare bResultCodec (checkModule env foreigns rmvar) statuses |> IO.bind (\resultMVars -> - Utils.putMVar dictRawMVarBResultEncoder rmvar resultMVars + Utils.putMVar dictRawMVarBResultCodec rmvar resultMVars |> IO.bind (\_ -> - Utils.mapTraverse identity compare (Utils.readMVar bResultDecoder) resultMVars + Utils.mapTraverse identity compare (Utils.readMVar bResultCodec) resultMVars |> IO.bind (\results -> writeDetails root details results @@ -220,7 +219,7 @@ type alias Dependencies = fromPaths : Reporting.Style -> FilePath -> Details.Details -> NE.Nonempty FilePath -> IO (Result Exit.BuildProblem Artifacts) fromPaths style root details paths = - Reporting.trackBuild artifactsDecoder artifactsEncoder style <| + Reporting.trackBuild artifactsCodec style <| \key -> makeEnv key root details |> IO.bind @@ -237,16 +236,16 @@ fromPaths style root details paths = Details.loadInterfaces root details |> IO.bind (\dmvar -> - Utils.newMVar statusDictEncoder Dict.empty + Utils.newMVar statusDictCodec Dict.empty |> IO.bind (\smvar -> - Utils.nonEmptyListTraverse (fork rootStatusEncoder << crawlRoot env smvar) lroots + Utils.nonEmptyListTraverse (fork rootStatusCodec << crawlRoot env smvar) lroots |> IO.bind (\srootMVars -> - Utils.nonEmptyListTraverse (Utils.readMVar rootStatusDecoder) srootMVars + Utils.nonEmptyListTraverse (Utils.readMVar rootStatusCodec) 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 statusCodec)) (Utils.readMVar statusDictCodec smvar) |> IO.bind (\statuses -> checkMidpointAndRoots dmvar statuses sroots @@ -261,22 +260,22 @@ fromPaths style root details paths = Utils.newEmptyMVar |> IO.bind (\rmvar -> - forkWithKey identity compare bResultEncoder (checkModule env foreigns rmvar) statuses + forkWithKey identity compare bResultCodec (checkModule env foreigns rmvar) statuses |> IO.bind (\resultsMVars -> - Utils.putMVar resultDictEncoder rmvar resultsMVars + Utils.putMVar resultDictCodec rmvar resultsMVars |> IO.bind (\_ -> - Utils.nonEmptyListTraverse (fork rootResultEncoder << checkRoot env resultsMVars) sroots + Utils.nonEmptyListTraverse (fork rootResultCodec << checkRoot env resultsMVars) sroots |> IO.bind (\rrootMVars -> - Utils.mapTraverse identity compare (Utils.readMVar bResultDecoder) resultsMVars + Utils.mapTraverse identity compare (Utils.readMVar bResultCodec) resultsMVars |> IO.bind (\results -> writeDetails root details results |> IO.bind (\_ -> - IO.fmap (toArtifacts env foreigns results) (Utils.nonEmptyListTraverse (Utils.readMVar rootResultDecoder) rrootMVars) + IO.fmap (toArtifacts env foreigns results) (Utils.nonEmptyListTraverse (Utils.readMVar rootResultCodec) rrootMVars) ) ) ) @@ -334,9 +333,9 @@ crawlDeps env mvar deps blockedValue = let crawlNew : ModuleName.Raw -> () -> IO (MVar Status) crawlNew name () = - fork statusEncoder (crawlModule env mvar (DocsNeed False) name) + fork statusCodec (crawlModule env mvar (DocsNeed False) name) in - Utils.takeMVar statusDictDecoder mvar + Utils.takeMVar statusDictCodec mvar |> IO.bind (\statusDict -> let @@ -351,10 +350,10 @@ crawlDeps env mvar deps blockedValue = Utils.mapTraverseWithKey identity compare crawlNew newsDict |> IO.bind (\statuses -> - Utils.putMVar statusDictEncoder mvar (Dict.union statuses statusDict) + Utils.putMVar statusDictCodec mvar (Dict.union statuses statusDict) |> IO.bind (\_ -> - Utils.dictMapM_ compare (Utils.readMVar statusDecoder) statuses + Utils.dictMapM_ compare (Utils.readMVar statusCodec) statuses |> IO.fmap (\_ -> blockedValue) ) ) @@ -489,7 +488,7 @@ checkModule : Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name status = case status of SCached ((Details.Local path time deps hasMain lastChange lastCompile) as local) -> - Utils.readMVar resultDictDecoder resultsMVar + Utils.readMVar resultDictCodec resultsMVar |> IO.bind (\results -> checkDeps root results deps lastCompile @@ -511,7 +510,7 @@ checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name ) DepsSame _ _ -> - Utils.newMVar cachedInterfaceEncoder Unneeded + Utils.newMVar cachedInterfaceCodec Unneeded |> IO.fmap (\mvar -> RCached hasMain lastChange mvar @@ -538,7 +537,7 @@ checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name ) SChanged ((Details.Local path time deps _ _ lastCompile) as local) source ((Src.Module _ _ _ imports _ _ _ _ _) as modul) docsNeed -> - Utils.readMVar resultDictDecoder resultsMVar + Utils.readMVar resultDictCodec resultsMVar |> IO.bind (\results -> checkDeps root results deps lastCompile @@ -620,7 +619,7 @@ checkDepsHelp : FilePath -> ResultDict -> List ModuleName.Raw -> List Dep -> Lis 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 bResultCodec (Utils.find identity dep results) |> IO.bind (\result -> case result of @@ -712,10 +711,10 @@ toImportErrors (Env _ _ _ _ _ locals foreigns) results imports problems = loadInterfaces : FilePath -> List Dep -> List CDep -> IO (Maybe (Dict String ModuleName.Raw I.Interface)) loadInterfaces root same cached = - Utils.listTraverse (fork maybeDepEncoder << loadInterface root) cached + Utils.listTraverse (fork maybeDepCodec << loadInterface root) cached |> IO.bind (\loading -> - Utils.listTraverse (Utils.readMVar maybeDepDecoder) loading + Utils.listTraverse (Utils.readMVar maybeDepCodec) loading |> IO.bind (\maybeLoaded -> case Utils.sequenceListMaybe maybeLoaded of @@ -730,29 +729,29 @@ loadInterfaces root same cached = loadInterface : FilePath -> CDep -> IO (Maybe Dep) loadInterface root ( name, ciMvar ) = - Utils.takeMVar cachedInterfaceDecoder ciMvar + Utils.takeMVar cachedInterfaceCodec ciMvar |> IO.bind (\cachedInterface -> case cachedInterface of Corrupted -> - Utils.putMVar cachedInterfaceEncoder ciMvar cachedInterface + Utils.putMVar cachedInterfaceCodec ciMvar cachedInterface |> IO.fmap (\_ -> Nothing) Loaded iface -> - Utils.putMVar cachedInterfaceEncoder ciMvar cachedInterface + Utils.putMVar cachedInterfaceCodec ciMvar cachedInterface |> IO.fmap (\_ -> Just ( name, iface )) Unneeded -> - File.readBinary I.interfaceDecoder (Stuff.elmi root name) + File.readBinary I.interfaceCodec (Stuff.elmi root name) |> IO.bind (\maybeIface -> case maybeIface of Nothing -> - Utils.putMVar cachedInterfaceEncoder ciMvar Corrupted + Utils.putMVar cachedInterfaceCodec ciMvar Corrupted |> IO.fmap (\_ -> Nothing) Just iface -> - Utils.putMVar cachedInterfaceEncoder ciMvar (Loaded iface) + Utils.putMVar cachedInterfaceCodec ciMvar (Loaded iface) |> IO.fmap (\_ -> Just ( name, iface )) ) ) @@ -766,7 +765,7 @@ checkMidpoint : MVar (Maybe Dependencies) -> Dict String ModuleName.Raw Status - checkMidpoint dmvar statuses = case checkForCycles statuses of Nothing -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar maybeDependenciesCodec dmvar |> IO.fmap (\maybeForeigns -> case maybeForeigns of @@ -778,7 +777,7 @@ checkMidpoint dmvar statuses = ) Just (NE.Nonempty name names) -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar maybeDependenciesCodec dmvar |> IO.fmap (\_ -> Err (Exit.BP_Cycle name names)) @@ -788,7 +787,7 @@ checkMidpointAndRoots dmvar statuses sroots = Nothing -> case checkUniqueRoots statuses sroots of Nothing -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar maybeDependenciesCodec dmvar |> IO.bind (\maybeForeigns -> case maybeForeigns of @@ -800,11 +799,11 @@ checkMidpointAndRoots dmvar statuses sroots = ) Just problem -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar maybeDependenciesCodec dmvar |> IO.fmap (\_ -> Err problem) Just (NE.Nonempty name names) -> - Utils.readMVar maybeDependenciesDecoder dmvar + Utils.readMVar maybeDependenciesCodec dmvar |> IO.fmap (\_ -> Err (Exit.BP_Cycle name names)) @@ -980,10 +979,10 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path ti elmi = Stuff.elmi root name in - File.writeBinary Opt.localGraphEncoder (Stuff.elmo root name) objects + File.writeBinary Opt.localGraphCodec (Stuff.elmo root name) objects |> IO.bind (\_ -> - File.readBinary I.interfaceDecoder elmi + File.readBinary I.interfaceCodec elmi |> IO.bind (\maybeOldi -> case maybeOldi of @@ -1002,7 +1001,7 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path ti ) else - File.writeBinary I.interfaceEncoder elmi iface + File.writeBinary I.interfaceCodec elmi iface |> IO.bind (\_ -> Reporting.report key Reporting.BDone @@ -1019,7 +1018,7 @@ compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path ti _ -> -- iface may be lazy still - File.writeBinary I.interfaceEncoder elmi iface + File.writeBinary I.interfaceCodec elmi iface |> IO.bind (\_ -> Reporting.report key Reporting.BDone @@ -1059,7 +1058,7 @@ projectTypeToPkg projectType = writeDetails : FilePath -> Details.Details -> Dict String ModuleName.Raw BResult -> IO () writeDetails root (Details.Details time outline buildID locals foreigns extras) results = - File.writeBinary Details.detailsEncoder (Stuff.details root) <| + File.writeBinary Details.detailsCodec (Stuff.details root) <| Details.Details time outline buildID (Dict.foldr compare addNewLocal locals results) foreigns extras @@ -1292,13 +1291,13 @@ fromRepl root details source = deps = List.map Src.getImportName imports in - Utils.newMVar statusDictEncoder Dict.empty + Utils.newMVar statusDictCodec 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 statusCodec)) (Utils.readMVar statusDictCodec mvar) |> IO.bind (\statuses -> checkMidpoint dmvar statuses @@ -1312,13 +1311,13 @@ fromRepl root details source = Utils.newEmptyMVar |> IO.bind (\rmvar -> - forkWithKey identity compare bResultEncoder (checkModule env foreigns rmvar) statuses + forkWithKey identity compare bResultCodec (checkModule env foreigns rmvar) statuses |> IO.bind (\resultMVars -> - Utils.putMVar resultDictEncoder rmvar resultMVars + Utils.putMVar resultDictCodec rmvar resultMVars |> IO.bind (\_ -> - Utils.mapTraverse identity compare (Utils.readMVar bResultDecoder) resultMVars + Utils.mapTraverse identity compare (Utils.readMVar bResultCodec) resultMVars |> IO.bind (\results -> writeDetails root details results @@ -1423,10 +1422,10 @@ type RootLocation findRoots : Env -> NE.Nonempty FilePath -> IO (Result Exit.BuildProjectProblem (NE.Nonempty RootLocation)) findRoots env paths = - Utils.nonEmptyListTraverse (fork resultBuildProjectProblemRootInfoEncoder << getRootInfo env) paths + Utils.nonEmptyListTraverse (fork resultBuildProjectProblemRootInfoCodec << getRootInfo env) paths |> IO.bind (\mvars -> - Utils.nonEmptyListTraverse (Utils.readMVar resultBuildProjectProblemRootInfoDecoder) mvars + Utils.nonEmptyListTraverse (Utils.readMVar resultBuildProjectProblemRootInfoCodec) mvars |> IO.bind (\einfos -> IO.pure (Result.andThen checkRoots (Utils.sequenceNonemptyListResult einfos)) @@ -1600,13 +1599,13 @@ crawlRoot ((Env _ _ projectType _ buildID _ _) as env) mvar root = Utils.newEmptyMVar |> IO.bind (\statusMVar -> - Utils.takeMVar statusDictDecoder mvar + Utils.takeMVar statusDictCodec mvar |> IO.bind (\statusDict -> - Utils.putMVar statusDictEncoder mvar (Dict.insert identity name statusMVar statusDict) + Utils.putMVar statusDictCodec 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 statusCodec statusMVar) (crawlModule env mvar (DocsNeed False) name) |> IO.fmap (\_ -> SInside name) ) ) @@ -1834,564 +1833,261 @@ addOutside root modules = -- ENCODERS and DECODERS -dictRawMVarBResultEncoder : Dict String ModuleName.Raw (MVar BResult) -> Encode.Value -dictRawMVarBResultEncoder = - E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder - - -bResultEncoder : BResult -> Encode.Value -bResultEncoder bResult = - case bResult of - 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 - ) - ] - - 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 ) - ] - - RCached main lastChange (MVar ref) -> - Encode.object - [ ( "type", Encode.string "RCached" ) - , ( "main", Encode.bool main ) - , ( "lastChange", Encode.int lastChange ) - , ( "mvar", Encode.int ref ) - ] - - RNotFound importProblem -> - Encode.object - [ ( "type", Encode.string "RNotFound" ) - , ( "importProblem", Import.problemEncoder importProblem ) - ] +dictRawMVarBResultCodec : Codec e (Dict String ModuleName.Raw (MVar BResult)) +dictRawMVarBResultCodec = + S.assocListDict identity compare ModuleName.rawCodec Utils.mVarCodec - RProblem e -> - Encode.object - [ ( "type", Encode.string "RProblem" ) - , ( "e", Error.moduleEncoder e ) - ] - - RBlocked -> - Encode.object [ ( "type", Encode.string "RBlocked" ) ] - - RForeign iface -> - Encode.object - [ ( "type", Encode.string "RForeign" ) - , ( "iface", I.interfaceEncoder iface ) - ] - - RKernel -> - Encode.object [ ( "type", Encode.string "RKernel" ) ] - - -bResultDecoder : Decode.Decoder BResult -bResultDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "RNew" -> - Decode.map4 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 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 RCached - (Decode.field "main" Decode.bool) - (Decode.field "lastChange" Decode.int) - (Decode.field "mvar" (Decode.map MVar Decode.int)) - - "RNotFound" -> - Decode.map RNotFound - (Decode.field "importProblem" Import.problemDecoder) - - "RProblem" -> - Decode.map RProblem - (Decode.field "e" Error.moduleDecoder) - - "RBlocked" -> - Decode.succeed RBlocked - - "RForeign" -> - Decode.map RForeign - (Decode.field "iface" I.interfaceDecoder) - - "RKernel" -> - Decode.succeed 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 ) - ] +bResultCodec : Codec (Serialize.Error e) BResult +bResultCodec = + Serialize.customType + (\rNewEncoder rSameEncoder rCachedEncoder rNotFoundEncoder rProblemEncoder rBlockedEncoder rForeignEncoder rKernelEncoder bResult -> + case bResult of + RNew local iface objects docs -> + rNewEncoder local iface objects docs - SForeign home -> - Encode.object - [ ( "type", Encode.string "SForeign" ) - , ( "home", Pkg.nameEncoder home ) - ] + RSame local iface objects docs -> + rSameEncoder local iface objects docs - 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_) - ) + RCached main lastChange mVar -> + rCachedEncoder main lastChange mVar + RNotFound importProblem -> + rNotFoundEncoder importProblem -rootStatusEncoder : RootStatus -> Encode.Value -rootStatusEncoder rootStatus = - case rootStatus of - SInside name -> - Encode.object - [ ( "type", Encode.string "SInside" ) - , ( "name", ModuleName.rawEncoder name ) - ] - - SOutsideOk local source modul -> - Encode.object - [ ( "type", Encode.string "SOutsideOk" ) - , ( "local", Details.localEncoder local ) - , ( "source", Encode.string source ) - , ( "modul", Src.moduleEncoder modul ) - ] - - SOutsideErr err -> - Encode.object - [ ( "type", Encode.string "SOutsideErr" ) - , ( "err", Error.moduleEncoder err ) - ] - - -rootStatusDecoder : Decode.Decoder RootStatus -rootStatusDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "SInside" -> - Decode.map SInside (Decode.field "name" ModuleName.rawDecoder) - - "SOutsideOk" -> - Decode.map3 SOutsideOk - (Decode.field "local" Details.localDecoder) - (Decode.field "source" Decode.string) - (Decode.field "modul" Src.moduleDecoder) - - "SOutsideErr" -> - Decode.map SOutsideErr (Decode.field "err" Error.moduleDecoder) - - _ -> - Decode.fail ("Failed to decode RootStatus' type: " ++ type_) - ) - - -resultDictEncoder : ResultDict -> Encode.Value -resultDictEncoder = - E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder + RProblem e -> + rProblemEncoder e + RBlocked -> + rBlockedEncoder -resultDictDecoder : Decode.Decoder ResultDict -resultDictDecoder = - D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder + RForeign iface -> + rForeignEncoder iface + RKernel -> + rKernelEncoder + ) + |> Serialize.variant4 RNew + Details.localCodec + I.interfaceCodec + Opt.localGraphCodec + (Serialize.maybe Docs.moduleCodec) + |> Serialize.variant4 RSame + Details.localCodec + I.interfaceCodec + Opt.localGraphCodec + (Serialize.maybe Docs.moduleCodec) + |> Serialize.variant3 RCached + Serialize.bool + Serialize.int + (Serialize.int |> Serialize.map MVar (\(MVar ref) -> ref)) + |> Serialize.variant1 RNotFound Import.problemCodec + |> Serialize.variant1 RProblem Error.moduleCodec + |> Serialize.variant0 RBlocked + |> Serialize.variant1 RForeign I.interfaceCodec + |> Serialize.variant0 RKernel + |> Serialize.finishCustomType + + +statusDictCodec : Codec e StatusDict +statusDictCodec = + S.assocListDict identity compare ModuleName.rawCodec Utils.mVarCodec + + +statusCodec : Codec e Status +statusCodec = + Serialize.customType + (\sCachedEncoder sChangedEncoder sBadImportEncoder sBadSyntaxEncoder sForeignEncoder sKernelEncoder status -> + case status of + SCached local -> + sCachedEncoder local -rootResultEncoder : RootResult -> Encode.Value -rootResultEncoder rootResult = - case rootResult of - RInside name -> - Encode.object - [ ( "type", Encode.string "RInside" ) - , ( "name", ModuleName.rawEncoder name ) - ] - - ROutsideOk name iface objs -> - Encode.object - [ ( "type", Encode.string "ROutsideOk" ) - , ( "name", ModuleName.rawEncoder name ) - , ( "iface", I.interfaceEncoder iface ) - , ( "objs", Opt.localGraphEncoder objs ) - ] - - ROutsideErr err -> - Encode.object - [ ( "type", Encode.string "ROutsideErr" ) - , ( "err", Error.moduleEncoder err ) - ] - - ROutsideBlocked -> - Encode.object - [ ( "type", Encode.string "ROutsideBlocked" ) - ] - - -rootResultDecoder : Decode.Decoder RootResult -rootResultDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "RInside" -> - Decode.map RInside (Decode.field "name" ModuleName.rawDecoder) - - "ROutsideOk" -> - Decode.map3 ROutsideOk - (Decode.field "name" ModuleName.rawDecoder) - (Decode.field "iface" I.interfaceDecoder) - (Decode.field "objs" Opt.localGraphDecoder) - - "ROutsideErr" -> - Decode.map ROutsideErr (Decode.field "err" Error.moduleDecoder) - - "ROutsideBlocked" -> - Decode.succeed ROutsideBlocked - - _ -> - Decode.fail ("Failed to decode RootResult's type: " ++ type_) - ) - - -maybeDepEncoder : Maybe Dep -> Encode.Value -maybeDepEncoder = - E.maybe depEncoder - - -maybeDepDecoder : Decode.Decoder (Maybe Dep) -maybeDepDecoder = - Decode.maybe depDecoder - + SChanged local iface objects docs -> + sChangedEncoder local iface objects docs -depEncoder : Dep -> Encode.Value -depEncoder = - E.jsonPair ModuleName.rawEncoder I.interfaceEncoder + SBadImport importProblem -> + sBadImportEncoder importProblem + SBadSyntax path time source err -> + sBadSyntaxEncoder path time source err -depDecoder : Decode.Decoder Dep -depDecoder = - D.jsonPair ModuleName.rawDecoder I.interfaceDecoder + SForeign home -> + sForeignEncoder home + SKernel -> + sKernelEncoder + ) + |> Serialize.variant1 SCached Details.localCodec + |> Serialize.variant4 SChanged Details.localCodec Serialize.string Src.moduleCodec docsNeedCodec + |> Serialize.variant1 SBadImport Import.problemCodec + |> Serialize.variant4 SBadSyntax Serialize.string File.timeCodec Serialize.string Syntax.errorCodec + |> Serialize.variant1 SForeign Pkg.nameCodec + |> Serialize.variant0 SKernel + |> Serialize.finishCustomType + + +rootStatusCodec : Codec (Serialize.Error e) RootStatus +rootStatusCodec = + Serialize.customType + (\sInsideEncoder sOutsideOkEncoder sOutsideErrEncoder rootStatus -> + case rootStatus of + SInside name -> + sInsideEncoder name + + SOutsideOk local source modul -> + sOutsideOkEncoder local source modul + + SOutsideErr err -> + sOutsideErrEncoder err + ) + |> Serialize.variant1 SInside ModuleName.rawCodec + |> Serialize.variant3 SOutsideOk Details.localCodec Serialize.string Src.moduleCodec + |> Serialize.variant1 SOutsideErr Error.moduleCodec + |> Serialize.finishCustomType -maybeDependenciesDecoder : Decode.Decoder (Maybe Dependencies) -maybeDependenciesDecoder = - Decode.maybe (D.assocListDict ModuleName.toComparableCanonical ModuleName.canonicalDecoder I.dependencyInterfaceDecoder) +resultDictCodec : Codec e ResultDict +resultDictCodec = + S.assocListDict identity compare ModuleName.rawCodec Utils.mVarCodec -resultBuildProjectProblemRootInfoEncoder : Result Exit.BuildProjectProblem RootInfo -> Encode.Value -resultBuildProjectProblemRootInfoEncoder = - E.result Exit.buildProjectProblemEncoder rootInfoEncoder +rootResultCodec : Codec (Serialize.Error e) RootResult +rootResultCodec = + Serialize.customType + (\rInsideEncoder rOutsideOkEncoder rOutsideErrEncoder rOutsideBlockedEncoder rootResult -> + case rootResult of + RInside name -> + rInsideEncoder name -resultBuildProjectProblemRootInfoDecoder : Decode.Decoder (Result Exit.BuildProjectProblem RootInfo) -resultBuildProjectProblemRootInfoDecoder = - D.result Exit.buildProjectProblemDecoder rootInfoDecoder + ROutsideOk name iface objs -> + rOutsideOkEncoder name iface objs + ROutsideErr err -> + rOutsideErrEncoder err -cachedInterfaceEncoder : CachedInterface -> Encode.Value -cachedInterfaceEncoder cachedInterface = - case cachedInterface of - Unneeded -> - Encode.object - [ ( "type", Encode.string "Unneeded" ) - ] + ROutsideBlocked -> + rOutsideBlockedEncoder + ) + |> Serialize.variant1 RInside ModuleName.rawCodec + |> Serialize.variant3 ROutsideOk ModuleName.rawCodec I.interfaceCodec Opt.localGraphCodec + |> Serialize.variant1 ROutsideErr Error.moduleCodec + |> Serialize.variant0 ROutsideBlocked + |> Serialize.finishCustomType - Loaded iface -> - Encode.object - [ ( "type", Encode.string "Loaded" ) - , ( "iface", I.interfaceEncoder iface ) - ] - Corrupted -> - Encode.object - [ ( "type", Encode.string "Corrupted" ) - ] +maybeDepCodec : Codec e (Maybe Dep) +maybeDepCodec = + Serialize.maybe depCodec -cachedInterfaceDecoder : Decode.Decoder CachedInterface -cachedInterfaceDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Unneeded" -> - Decode.succeed Unneeded +depCodec : Codec e Dep +depCodec = + Serialize.tuple ModuleName.rawCodec I.interfaceCodec - "Loaded" -> - Decode.map Loaded (Decode.field "iface" I.interfaceDecoder) - "Corrupted" -> - Decode.succeed Corrupted +maybeDependenciesCodec : Codec e (Maybe Dependencies) +maybeDependenciesCodec = + Serialize.maybe (S.assocListDict ModuleName.toComparableCanonical ModuleName.compareCanonical ModuleName.canonicalCodec I.dependencyInterfaceCodec) - _ -> - Decode.fail ("Failed to decode CachedInterface's type: " ++ type_) - ) +resultBuildProjectProblemRootInfoCodec : Codec (Serialize.Error e) (Result Exit.BuildProjectProblem RootInfo) +resultBuildProjectProblemRootInfoCodec = + Serialize.result Exit.buildProjectProblemCodec rootInfoCodec -docsNeedEncoder : DocsNeed -> Encode.Value -docsNeedEncoder (DocsNeed isNeeded) = - Encode.bool isNeeded +cachedInterfaceCodec : Codec e CachedInterface +cachedInterfaceCodec = + Serialize.customType + (\unneededEncoder loadedEncoder corruptedEncoder cachedInterface -> + case cachedInterface of + Unneeded -> + unneededEncoder -docsNeedDecoder : Decode.Decoder DocsNeed -docsNeedDecoder = - Decode.map DocsNeed Decode.bool + Loaded iface -> + loadedEncoder iface + Corrupted -> + corruptedEncoder + ) + |> Serialize.variant0 Unneeded + |> Serialize.variant1 Loaded I.interfaceCodec + |> Serialize.variant0 Corrupted + |> Serialize.finishCustomType -artifactsEncoder : Artifacts -> Encode.Value -artifactsEncoder (Artifacts pkg ifaces roots modules) = - Encode.object - [ ( "type", Encode.string "Artifacts" ) - , ( "pkg", Pkg.nameEncoder pkg ) - , ( "ifaces", dependenciesEncoder ifaces ) - , ( "roots", E.nonempty rootEncoder roots ) - , ( "modules", Encode.list moduleEncoder modules ) - ] +docsNeedCodec : Codec e DocsNeed +docsNeedCodec = + Serialize.bool |> Serialize.map DocsNeed (\(DocsNeed isNeeded) -> isNeeded) -artifactsDecoder : Decode.Decoder Artifacts -artifactsDecoder = - Decode.map4 Artifacts - (Decode.field "pkg" Pkg.nameDecoder) - (Decode.field "ifaces" dependenciesDecoder) - (Decode.field "roots" (D.nonempty rootDecoder)) - (Decode.field "modules" (Decode.list moduleDecoder)) +artifactsCodec : Codec (Serialize.Error e) Artifacts +artifactsCodec = + Serialize.customType + (\artifactsCodecEncoder (Artifacts pkg ifaces roots modules) -> + artifactsCodecEncoder pkg ifaces roots modules + ) + |> Serialize.variant4 Artifacts Pkg.nameCodec dependenciesCodec (S.nonempty rootCodec) (Serialize.list moduleCodec) + |> Serialize.finishCustomType -dependenciesEncoder : Dependencies -> Encode.Value -dependenciesEncoder = - E.assocListDict ModuleName.compareCanonical ModuleName.canonicalEncoder I.dependencyInterfaceEncoder +dependenciesCodec : Codec e Dependencies +dependenciesCodec = + S.assocListDict ModuleName.toComparableCanonical ModuleName.compareCanonical ModuleName.canonicalCodec I.dependencyInterfaceCodec -dependenciesDecoder : Decode.Decoder Dependencies -dependenciesDecoder = - D.assocListDict ModuleName.toComparableCanonical ModuleName.canonicalDecoder I.dependencyInterfaceDecoder +rootCodec : Codec e Root +rootCodec = + Serialize.customType + (\insideEncoder outsideEncoder root -> + case root of + Inside name -> + insideEncoder name -rootEncoder : Root -> Encode.Value -rootEncoder root = - case root of - Inside name -> - Encode.object - [ ( "type", Encode.string "Inside" ) - , ( "name", ModuleName.rawEncoder name ) - ] - - Outside name main mvar -> - Encode.object - [ ( "type", Encode.string "Outside" ) - , ( "name", ModuleName.rawEncoder name ) - , ( "main", I.interfaceEncoder main ) - , ( "mvar", Opt.localGraphEncoder mvar ) - ] - - -rootDecoder : Decode.Decoder Root -rootDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Inside" -> - Decode.map Inside (Decode.field "name" ModuleName.rawDecoder) - - "Outside" -> - Decode.map3 Outside - (Decode.field "name" ModuleName.rawDecoder) - (Decode.field "main" I.interfaceDecoder) - (Decode.field "mvar" Opt.localGraphDecoder) - - _ -> - Decode.fail ("Failed to decode Root's type: " ++ type_) - ) - + Outside name main mvar -> + outsideEncoder name main mvar + ) + |> Serialize.variant1 Inside ModuleName.rawCodec + |> Serialize.variant3 Outside ModuleName.rawCodec I.interfaceCodec Opt.localGraphCodec + |> Serialize.finishCustomType -moduleEncoder : Module -> Encode.Value -moduleEncoder modul = - case modul of - Fresh name iface objs -> - Encode.object - [ ( "type", Encode.string "Fresh" ) - , ( "name", ModuleName.rawEncoder name ) - , ( "iface", I.interfaceEncoder iface ) - , ( "objs", Opt.localGraphEncoder objs ) - ] - - Cached name main mvar -> - Encode.object - [ ( "type", Encode.string "Cached" ) - , ( "name", ModuleName.rawEncoder name ) - , ( "main", Encode.bool main ) - , ( "mvar", Utils.mVarEncoder mvar ) - ] - - -moduleDecoder : Decode.Decoder Module -moduleDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Fresh" -> - Decode.map3 Fresh - (Decode.field "name" ModuleName.rawDecoder) - (Decode.field "iface" I.interfaceDecoder) - (Decode.field "objs" Opt.localGraphDecoder) - - "Cached" -> - Decode.map3 Cached - (Decode.field "name" ModuleName.rawDecoder) - (Decode.field "main" Decode.bool) - (Decode.field "mvar" Utils.mVarDecoder) - - _ -> - Decode.fail ("Failed to decode Module's type: " ++ type_) - ) +moduleCodec : Codec e Module +moduleCodec = + Serialize.customType + (\freshEncoder cachedEncoder modul -> + case modul of + Fresh name iface objs -> + freshEncoder name iface objs -rootInfoEncoder : RootInfo -> Encode.Value -rootInfoEncoder (RootInfo absolute relative location) = - Encode.object - [ ( "type", Encode.string "RootInfo" ) - , ( "absolute", Encode.string absolute ) - , ( "relative", Encode.string relative ) - , ( "location", rootLocationEncoder location ) - ] + Cached name main mvar -> + cachedEncoder name main mvar + ) + |> Serialize.variant3 Fresh ModuleName.rawCodec I.interfaceCodec Opt.localGraphCodec + |> Serialize.variant3 Cached ModuleName.rawCodec Serialize.bool Utils.mVarCodec + |> Serialize.finishCustomType -rootInfoDecoder : Decode.Decoder RootInfo -rootInfoDecoder = - Decode.map3 RootInfo - (Decode.field "absolute" Decode.string) - (Decode.field "relative" Decode.string) - (Decode.field "location" rootLocationDecoder) +rootInfoCodec : Codec e RootInfo +rootInfoCodec = + Serialize.customType + (\rootInfoCodecEncoder (RootInfo absolute relative location) -> + rootInfoCodecEncoder absolute relative location + ) + |> Serialize.variant3 RootInfo Serialize.string Serialize.string rootLocationCodec + |> Serialize.finishCustomType -rootLocationEncoder : RootLocation -> Encode.Value -rootLocationEncoder rootLocation = - case rootLocation of - LInside name -> - Encode.object - [ ( "type", Encode.string "LInside" ) - , ( "name", ModuleName.rawEncoder name ) - ] +rootLocationCodec : Codec e RootLocation +rootLocationCodec = + Serialize.customType + (\lInsideEncoder lOutsideEncoder rootLocation -> + case rootLocation of + LInside name -> + lInsideEncoder name - LOutside path -> - Encode.object - [ ( "type", Encode.string "LOutside" ) - , ( "path", Encode.string path ) - ] - - -rootLocationDecoder : Decode.Decoder RootLocation -rootLocationDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "LInside" -> - Decode.map LInside (Decode.field "name" ModuleName.rawDecoder) - - "LOutside" -> - Decode.map LOutside (Decode.field "path" Decode.string) - - _ -> - Decode.fail ("Failed to decode RootLocation's type: " ++ type_) - ) + LOutside path -> + lOutsideEncoder path + ) + |> Serialize.variant1 LInside ModuleName.rawCodec + |> Serialize.variant1 LOutside Serialize.string + |> Serialize.finishCustomType diff --git a/src/Builder/Deps/Registry.elm b/src/Builder/Deps/Registry.elm index df7d53dd3..2ac0a73c7 100644 --- a/src/Builder/Deps/Registry.elm +++ b/src/Builder/Deps/Registry.elm @@ -6,8 +6,7 @@ module Builder.Deps.Registry exposing , getVersions_ , latest , read - , registryDecoder - , registryEncoder + , registryCodec , update ) @@ -20,11 +19,10 @@ import Builder.Stuff as Stuff import Compiler.Elm.Package as Pkg import Compiler.Elm.Version as V import Compiler.Json.Decode as D -import Compiler.Json.Encode as E import Compiler.Parse.Primitives as P +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.IO as IO exposing (IO) @@ -40,19 +38,14 @@ type KnownVersions = KnownVersions V.Version (List V.Version) -knownVersionsDecoder : Decode.Decoder KnownVersions -knownVersionsDecoder = - Decode.map2 KnownVersions - (Decode.field "version" V.jsonDecoder) - (Decode.field "versions" (Decode.list V.jsonDecoder)) - - -knownVersionsEncoder : KnownVersions -> Encode.Value -knownVersionsEncoder (KnownVersions version versions) = - Encode.object - [ ( "version", V.jsonEncoder version ) - , ( "versions", Encode.list V.jsonEncoder versions ) - ] +knownVersionsCodec : Codec e KnownVersions +knownVersionsCodec = + Serialize.customType + (\knownVersionsCodecEncoder (KnownVersions version versions) -> + knownVersionsCodecEncoder version versions + ) + |> Serialize.variant2 KnownVersions V.jsonCodec (Serialize.list V.jsonCodec) + |> Serialize.finishCustomType @@ -61,7 +54,7 @@ knownVersionsEncoder (KnownVersions version versions) = read : Stuff.PackageCache -> IO (Maybe Registry) read cache = - File.readBinary registryDecoder (Stuff.registry cache) + File.readBinary registryCodec (Stuff.registry cache) @@ -85,7 +78,7 @@ fetch manager cache = path = Stuff.registry cache in - File.writeBinary registryEncoder path registry + File.writeBinary registryCodec path registry |> IO.fmap (\_ -> registry) @@ -143,7 +136,7 @@ update manager cache ((Registry size packages) as oldRegistry) = newRegistry = Registry newSize newPkgs in - File.writeBinary registryEncoder (Stuff.registry cache) newRegistry + File.writeBinary registryCodec (Stuff.registry cache) newRegistry |> IO.fmap (\_ -> newRegistry) @@ -249,16 +242,11 @@ post manager path decoder callback = -- ENCODERS and DECODERS -registryDecoder : Decode.Decoder Registry -registryDecoder = - Decode.map2 Registry - (Decode.field "size" Decode.int) - (Decode.field "packages" (D.assocListDict identity Pkg.nameDecoder knownVersionsDecoder)) - - -registryEncoder : Registry -> Encode.Value -registryEncoder (Registry size versions) = - Encode.object - [ ( "size", Encode.int size ) - , ( "packages", E.assocListDict Pkg.compareName Pkg.nameEncoder knownVersionsEncoder versions ) - ] +registryCodec : Codec e Registry +registryCodec = + Serialize.customType + (\registryCodecEncoder (Registry size packages) -> + registryCodecEncoder size packages + ) + |> Serialize.variant2 Registry Serialize.int (S.assocListDict identity Pkg.compareName Pkg.nameCodec knownVersionsCodec) + |> Serialize.finishCustomType diff --git a/src/Builder/Deps/Solver.elm b/src/Builder/Deps/Solver.elm index 99f2a761c..8fe875d17 100644 --- a/src/Builder/Deps/Solver.elm +++ b/src/Builder/Deps/Solver.elm @@ -7,8 +7,7 @@ module Builder.Deps.Solver exposing , SolverResult(..) , State , addToApp - , envDecoder - , envEncoder + , envCodec , initEnv , verify ) @@ -25,8 +24,7 @@ import Compiler.Elm.Package as Pkg import Compiler.Elm.Version as V import Compiler.Json.Decode as D import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.IO as IO exposing (IO) import Utils.Crash exposing (crash) import Utils.Main as Utils @@ -447,7 +445,7 @@ initEnv = Utils.newEmptyMVar |> IO.bind (\mvar -> - Utils.forkIO (IO.bind (Utils.putMVar Http.managerEncoder mvar) Http.getManager) + Utils.forkIO (IO.bind (Utils.putMVar Http.managerCodec mvar) Http.getManager) |> IO.bind (\_ -> Stuff.getPackageCache @@ -457,7 +455,7 @@ initEnv = (Registry.read cache |> IO.bind (\maybeRegistry -> - Utils.readMVar Http.managerDecoder mvar + Utils.readMVar Http.managerCodec mvar |> IO.bind (\manager -> case maybeRegistry of @@ -585,52 +583,27 @@ foldM f b = -- ENCODERS and DECODERS -envEncoder : Env -> Encode.Value -envEncoder (Env cache manager connection registry) = - Encode.object - [ ( "cache", Stuff.packageCacheEncoder cache ) - , ( "manager", Http.managerEncoder manager ) - , ( "connection", connectionEncoder connection ) - , ( "registry", Registry.registryEncoder registry ) - ] - - -envDecoder : Decode.Decoder Env -envDecoder = - Decode.map4 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 connection = - case connection of - Online manager -> - Encode.object - [ ( "type", Encode.string "Online" ) - , ( "manager", Http.managerEncoder manager ) - ] - - Offline -> - Encode.object - [ ( "type", Encode.string "Offline" ) - ] - - -connectionDecoder : Decode.Decoder Connection -connectionDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Online" -> - Decode.map Online (Decode.field "manager" Http.managerDecoder) - - "Offline" -> - Decode.succeed Offline - - _ -> - Decode.fail ("Failed to decode Connection's type: " ++ type_) - ) +envCodec : Codec e Env +envCodec = + Serialize.customType + (\envCodecEncoder (Env cache manager connection registry) -> + envCodecEncoder cache manager connection registry + ) + |> Serialize.variant4 Env Stuff.packageCacheCodec Http.managerCodec connectionCodec Registry.registryCodec + |> Serialize.finishCustomType + + +connectionCodec : Codec e Connection +connectionCodec = + Serialize.customType + (\onlineEncoder offlineEncoder value -> + case value of + Online manager -> + onlineEncoder manager + + Offline -> + offlineEncoder + ) + |> Serialize.variant1 Online Http.managerCodec + |> Serialize.variant0 Offline + |> Serialize.finishCustomType diff --git a/src/Builder/Elm/Details.elm b/src/Builder/Elm/Details.elm index 743b79dfc..07dd28cb1 100644 --- a/src/Builder/Elm/Details.elm +++ b/src/Builder/Elm/Details.elm @@ -7,12 +7,11 @@ module Builder.Elm.Details exposing , Local(..) , Status , ValidOutline(..) - , detailsEncoder + , detailsCodec , load , loadInterfaces , loadObjects - , localDecoder - , localEncoder + , localCodec , verifyInstall ) @@ -45,10 +44,10 @@ import Compiler.Json.Decode as D import Compiler.Json.Encode as E import Compiler.Parse.Module as Parse import Compiler.Reporting.Annotation as A +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) import Data.Set as EverySet exposing (EverySet) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.IO as IO exposing (IO) import System.TypeCheck.IO as TypeCheck import Utils.Crash exposing (crash) @@ -113,20 +112,20 @@ loadObjects : FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph)) loadObjects root (Details _ _ _ _ _ extras) = case extras of ArtifactsFresh _ o -> - Utils.newMVar (Utils.maybeEncoder Opt.globalGraphEncoder) (Just o) + Utils.newMVar (Serialize.maybe Opt.globalGraphCodec) (Just o) ArtifactsCached -> - fork (Utils.maybeEncoder Opt.globalGraphEncoder) (File.readBinary Opt.globalGraphDecoder (Stuff.objects root)) + fork (Serialize.maybe Opt.globalGraphCodec) (File.readBinary Opt.globalGraphCodec (Stuff.objects root)) loadInterfaces : FilePath -> Details -> IO (MVar (Maybe Interfaces)) loadInterfaces root (Details _ _ _ _ _ extras) = case extras of ArtifactsFresh i _ -> - Utils.newMVar (Utils.maybeEncoder interfacesEncoder) (Just i) + Utils.newMVar (Serialize.maybe interfacesCodec) (Just i) ArtifactsCached -> - fork (Utils.maybeEncoder interfacesEncoder) (File.readBinary interfacesDecoder (Stuff.interfaces root)) + fork (Serialize.maybe interfacesCodec) (File.readBinary interfacesCodec (Stuff.interfaces root)) @@ -165,7 +164,7 @@ load style scope root = File.getTime (root ++ "/elm.json") |> IO.bind (\newTime -> - File.readBinary detailsDecoder (Stuff.details root) + File.readBinary detailsCodec (Stuff.details root) |> IO.bind (\maybeDetails -> case maybeDetails of @@ -218,7 +217,7 @@ type Env initEnv : Reporting.DKey -> BW.Scope -> FilePath -> IO (Result Exit.Details ( Env, Outline.Outline )) initEnv key scope root = - fork resultRegistryProblemEnvEncoder Solver.initEnv + fork resultRegistryProblemEnvCodec Solver.initEnv |> IO.bind (\mvar -> Outline.read root @@ -229,7 +228,7 @@ initEnv key scope root = IO.pure (Err (Exit.DetailsBadOutline problem)) Ok outline -> - Utils.readMVar resultRegistryProblemEnvDecoder mvar + Utils.readMVar resultRegistryProblemEnvCodec mvar |> IO.fmap (\maybeEnv -> case maybeEnv of @@ -367,12 +366,12 @@ allowEqualDups _ v1 v2 = -- FORK -fork : (a -> Encode.Value) -> IO a -> IO (MVar a) -fork encoder work = +fork : Codec e a -> IO a -> IO (MVar a) +fork codec work = Utils.newEmptyMVar |> IO.bind (\mvar -> - Utils.forkIO (IO.bind (Utils.putMVar encoder mvar) work) + Utils.forkIO (IO.bind (Utils.putMVar codec mvar) work) |> IO.fmap (\_ -> mvar) ) @@ -389,13 +388,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 depCodec (verifyDep env mvar solution k v)) solution) |> IO.bind (\mvars -> - Utils.putMVar dictNameMVarDepEncoder mvar mvars + Utils.putMVar dictNameMVarDepCodec mvar mvars |> IO.bind (\_ -> - Utils.mapTraverse identity Pkg.compareName (Utils.readMVar depDecoder) mvars + Utils.mapTraverse identity Pkg.compareName (Utils.readMVar depCodec) mvars |> IO.bind (\deps -> case Utils.sequenceDictResult identity Pkg.compareName deps of @@ -427,9 +426,9 @@ verifyDependencies ((Env key scope root cache _ _ _) as env) time outline soluti details = Details time outline 0 Dict.empty foreigns (ArtifactsFresh ifaces objs) in - BW.writeBinary Opt.globalGraphEncoder scope (Stuff.objects root) objs - |> IO.bind (\_ -> BW.writeBinary interfacesEncoder scope (Stuff.interfaces root) ifaces) - |> IO.bind (\_ -> BW.writeBinary detailsEncoder scope (Stuff.details root) details) + BW.writeBinary Opt.globalGraphCodec scope (Stuff.objects root) objs + |> IO.bind (\_ -> BW.writeBinary interfacesCodec scope (Stuff.interfaces root) ifaces) + |> IO.bind (\_ -> BW.writeBinary detailsCodec scope (Stuff.details root) details) |> IO.fmap (\_ -> Ok details) ) ) @@ -502,7 +501,7 @@ verifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg ((Solver.Details Reporting.report key Reporting.DCached |> IO.bind (\_ -> - File.readBinary artifactCacheDecoder (Stuff.package cache pkg vsn ++ "/artifacts.json") + File.readBinary artifactCacheCodec (Stuff.package cache pkg vsn ++ "/artifacts.json") |> IO.bind (\maybeCache -> case maybeCache of @@ -575,10 +574,10 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = |> IO.fmap (\_ -> Err (Just (Exit.BD_BadBuild pkg vsn f))) Ok (Outline.Pkg (Outline.PkgOutline _ _ _ _ exposed deps _ _)) -> - Utils.readMVar dictPkgNameMVarDepDecoder depsMVar + Utils.readMVar dictPkgNameMVarDepCodec depsMVar |> IO.bind (\allDeps -> - Utils.mapTraverse identity Pkg.compareName (Utils.readMVar depDecoder) (Dict.intersection compare allDeps deps) + Utils.mapTraverse identity Pkg.compareName (Utils.readMVar depCodec) (Dict.intersection compare allDeps deps) |> IO.bind (\directDeps -> case Utils.sequenceDictResult identity Pkg.compareName directDeps of @@ -606,12 +605,12 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = Utils.newEmptyMVar |> IO.bind (\mvar -> - Utils.mapTraverseWithKey identity compare (always << fork (E.maybe statusEncoder) << crawlModule foreignDeps mvar pkg src docsStatus) exposedDict + Utils.mapTraverseWithKey identity compare (always << fork (Serialize.maybe statusCodec) << crawlModule foreignDeps mvar pkg src docsStatus) exposedDict |> IO.bind (\mvars -> - Utils.putMVar statusDictEncoder mvar mvars - |> IO.bind (\_ -> Utils.dictMapM_ compare (Utils.readMVar (Decode.maybe statusDecoder)) mvars) - |> IO.bind (\_ -> IO.bind (Utils.mapTraverse identity compare (Utils.readMVar (Decode.maybe statusDecoder))) (Utils.readMVar statusDictDecoder mvar)) + Utils.putMVar statusDictCodec mvar mvars + |> IO.bind (\_ -> Utils.dictMapM_ compare (Utils.readMVar (Serialize.maybe statusCodec)) mvars) + |> IO.bind (\_ -> IO.bind (Utils.mapTraverse identity compare (Utils.readMVar (Serialize.maybe statusCodec))) (Utils.readMVar statusDictCodec mvar)) |> IO.bind (\maybeStatuses -> case Utils.sequenceDictMaybe identity compare maybeStatuses of @@ -623,11 +622,11 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = Utils.newEmptyMVar |> IO.bind (\rmvar -> - Utils.mapTraverse identity compare (fork (E.maybe dResultEncoder) << compile pkg rmvar) statuses + Utils.mapTraverse identity compare (fork (Serialize.maybe dResultCodec) << compile pkg rmvar) statuses |> IO.bind (\rmvars -> - Utils.putMVar dictRawMVarMaybeDResultEncoder rmvar rmvars - |> IO.bind (\_ -> Utils.mapTraverse identity compare (Utils.readMVar (Decode.maybe dResultDecoder)) rmvars) + Utils.putMVar dictRawMVarMaybeDResultCodec rmvar rmvars + |> IO.bind (\_ -> Utils.mapTraverse identity compare (Utils.readMVar (Serialize.maybe dResultCodec)) rmvars) |> IO.bind (\maybeResults -> case Utils.sequenceDictMaybe identity compare maybeResults of @@ -658,7 +657,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) f fs = EverySet.insert toComparableFingerprint f fs in writeDocs cache pkg vsn docsStatus results - |> IO.bind (\_ -> File.writeBinary artifactCacheEncoder path (ArtifactCache fingerprints artifacts)) + |> IO.bind (\_ -> File.writeBinary artifactCacheCodec path (ArtifactCache fingerprints artifacts)) |> IO.bind (\_ -> Reporting.report key Reporting.DBuilt) |> IO.fmap (\_ -> Ok artifacts) ) @@ -843,7 +842,7 @@ crawlFile foreignDeps mvar pkg src docsStatus expectedName path = crawlImports : Dict String ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> List Src.Import -> IO (Dict String ModuleName.Raw ()) crawlImports foreignDeps mvar pkg src imports = - Utils.takeMVar statusDictDecoder mvar + Utils.takeMVar statusDictCodec mvar |> IO.bind (\statusDict -> let @@ -855,11 +854,11 @@ crawlImports foreignDeps mvar pkg src imports = news = Dict.diff deps statusDict in - Utils.mapTraverseWithKey identity compare (always << fork (E.maybe statusEncoder) << crawlModule foreignDeps mvar pkg src DocsNotNeeded) news + Utils.mapTraverseWithKey identity compare (always << fork (Serialize.maybe statusCodec) << crawlModule foreignDeps mvar pkg src DocsNotNeeded) news |> IO.bind (\mvars -> - Utils.putMVar statusDictEncoder mvar (Dict.union mvars statusDict) - |> IO.bind (\_ -> Utils.dictMapM_ compare (Utils.readMVar (Decode.maybe statusDecoder)) mvars) + Utils.putMVar statusDictCodec mvar (Dict.union mvars statusDict) + |> IO.bind (\_ -> Utils.dictMapM_ compare (Utils.readMVar (Serialize.maybe statusCodec)) mvars) |> IO.fmap (\_ -> deps) ) ) @@ -918,10 +917,10 @@ compile : Pkg.Name -> MVar (Dict String ModuleName.Raw (MVar (Maybe DResult))) - compile pkg mvar status = case status of SLocal docsStatus deps modul -> - Utils.readMVar moduleNameRawMVarMaybeDResultDecoder mvar + Utils.readMVar moduleNameRawMVarMaybeDResultCodec mvar |> IO.bind (\resultsDict -> - Utils.mapTraverse identity compare (Utils.readMVar (Decode.maybe dResultDecoder)) (Dict.intersection compare resultsDict deps) + Utils.mapTraverse identity compare (Utils.readMVar (Serialize.maybe dResultCodec)) (Dict.intersection compare resultsDict deps) |> IO.bind (\maybeResults -> case Utils.sequenceDictMaybe identity compare maybeResults of @@ -1089,377 +1088,198 @@ endpointDecoder = -- ENCODERS and DECODERS -detailsEncoder : Details -> Encode.Value -detailsEncoder (Details oldTime outline buildID locals foreigns extras) = - Encode.object - [ ( "type", Encode.string "Details" ) - , ( "oldTime", File.timeEncoder oldTime ) - , ( "outline", validOutlineEncoder outline ) - , ( "buildID", Encode.int buildID ) - , ( "locals", E.assocListDict compare ModuleName.rawEncoder localEncoder locals ) - , ( "foreigns", E.assocListDict compare ModuleName.rawEncoder foreignEncoder foreigns ) - , ( "extras", extrasEncoder extras ) - ] - - -detailsDecoder : Decode.Decoder Details -detailsDecoder = - Decode.map6 Details - (Decode.field "oldTime" File.timeDecoder) - (Decode.field "outline" validOutlineDecoder) - (Decode.field "buildID" Decode.int) - (Decode.field "locals" (D.assocListDict identity ModuleName.rawDecoder localDecoder)) - (Decode.field "foreigns" (D.assocListDict identity ModuleName.rawDecoder foreignDecoder)) - (Decode.field "extras" extrasDecoder) - - -interfacesEncoder : Interfaces -> Encode.Value -interfacesEncoder = - E.assocListDict ModuleName.compareCanonical ModuleName.canonicalEncoder I.dependencyInterfaceEncoder - - -interfacesDecoder : Decode.Decoder Interfaces -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) = - Encode.object - [ ( "type", Encode.string "Artifacts" ) - , ( "ifaces", E.assocListDict compare ModuleName.rawEncoder I.dependencyInterfaceEncoder ifaces ) - , ( "objects", Opt.globalGraphEncoder objects ) - ] - - -artifactsDecoder : Decode.Decoder Artifacts -artifactsDecoder = - Decode.map2 Artifacts - (Decode.field "ifaces" (D.assocListDict identity ModuleName.rawDecoder I.dependencyInterfaceDecoder)) - (Decode.field "objects" Opt.globalGraphDecoder) - - -dictNameMVarDepEncoder : Dict ( String, String ) Pkg.Name (MVar Dep) -> Encode.Value -dictNameMVarDepEncoder = - E.assocListDict compare Pkg.nameEncoder Utils.mVarEncoder - - -artifactCacheEncoder : ArtifactCache -> Encode.Value -artifactCacheEncoder (ArtifactCache fingerprints artifacts) = - Encode.object - [ ( "type", Encode.string "ArtifactCache" ) - , ( "fingerprints", E.everySet (\_ _ -> EQ) fingerprintEncoder fingerprints ) - , ( "artifacts", artifactsEncoder artifacts ) - ] - - -artifactCacheDecoder : Decode.Decoder ArtifactCache -artifactCacheDecoder = - Decode.map2 ArtifactCache - (Decode.field "fingerprints" (D.everySet toComparableFingerprint fingerprintDecoder)) - (Decode.field "artifacts" artifactsDecoder) - - -dictPkgNameMVarDepDecoder : Decode.Decoder (Dict ( String, String ) Pkg.Name (MVar Dep)) -dictPkgNameMVarDepDecoder = - D.assocListDict identity Pkg.nameDecoder Utils.mVarDecoder - - -statusEncoder : Status -> Encode.Value -statusEncoder status = - case status of - SLocal docsStatus deps modul -> - Encode.object - [ ( "type", Encode.string "SLocal" ) - , ( "docsStatus", docsStatusEncoder docsStatus ) - , ( "deps", E.assocListDict compare ModuleName.rawEncoder (\_ -> Encode.object []) deps ) - , ( "modul", Src.moduleEncoder modul ) - ] +detailsCodec : Codec (Serialize.Error e) Details +detailsCodec = + Serialize.customType + (\detailsCodecEncoder (Details oldTime outline buildID locals foreigns extras) -> + detailsCodecEncoder oldTime outline buildID locals foreigns extras + ) + |> Serialize.variant6 Details + File.timeCodec + validOutlineCodec + Serialize.int + (S.assocListDict identity compare ModuleName.rawCodec localCodec) + (S.assocListDict identity compare ModuleName.rawCodec foreignCodec) + extrasCodec + |> Serialize.finishCustomType - SForeign iface -> - Encode.object - [ ( "type", Encode.string "SForeign" ) - , ( "iface", I.interfaceEncoder iface ) - ] - SKernelLocal chunks -> - Encode.object - [ ( "type", Encode.string "SKernelLocal" ) - , ( "chunks", Encode.list Kernel.chunkEncoder chunks ) - ] +interfacesCodec : Codec e Interfaces +interfacesCodec = + S.assocListDict ModuleName.toComparableCanonical ModuleName.compareCanonical ModuleName.canonicalCodec I.dependencyInterfaceCodec - SKernelForeign -> - Encode.object - [ ( "type", Encode.string "SKernelForeign" ) - ] +resultRegistryProblemEnvCodec : Codec e (Result Exit.RegistryProblem Solver.Env) +resultRegistryProblemEnvCodec = + Serialize.result Exit.registryProblemCodec Solver.envCodec -statusDecoder : Decode.Decoder Status -statusDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "SLocal" -> - Decode.map3 SLocal - (Decode.field "docsStatus" docsStatusDecoder) - (Decode.field "deps" (D.assocListDict identity ModuleName.rawDecoder (Decode.succeed ()))) - (Decode.field "modul" Src.moduleDecoder) - "SForeign" -> - Decode.map SForeign (Decode.field "iface" I.interfaceDecoder) +depCodec : Codec e Dep +depCodec = + Serialize.result (Serialize.maybe Exit.detailsBadDepCodec) artifactsCodec - "SKernelLocal" -> - Decode.map SKernelLocal (Decode.field "chunks" (Decode.list Kernel.chunkDecoder)) - "SKernelForeign" -> - Decode.succeed SKernelForeign +artifactsCodec : Codec e Artifacts +artifactsCodec = + Serialize.customType + (\artifactsCodecEncoder (Artifacts ifaces objects) -> + artifactsCodecEncoder ifaces objects + ) + |> Serialize.variant2 Artifacts (S.assocListDict identity compare ModuleName.rawCodec I.dependencyInterfaceCodec) Opt.globalGraphCodec + |> Serialize.finishCustomType - _ -> - Decode.fail ("Failed to decode Status' type: " ++ type_) - ) +dictNameMVarDepCodec : Codec e (Dict ( String, String ) Pkg.Name (MVar Dep)) +dictNameMVarDepCodec = + S.assocListDict identity Pkg.compareName Pkg.nameCodec Utils.mVarCodec -dictRawMVarMaybeDResultEncoder : Dict String ModuleName.Raw (MVar (Maybe DResult)) -> Encode.Value -dictRawMVarMaybeDResultEncoder = - E.assocListDict compare ModuleName.rawEncoder Utils.mVarEncoder +artifactCacheCodec : Codec e ArtifactCache +artifactCacheCodec = + Serialize.customType + (\artifactCacheCodecEncoder (ArtifactCache fingerprints artifacts) -> + artifactCacheCodecEncoder fingerprints artifacts + ) + |> Serialize.variant2 ArtifactCache (S.everySet toComparableFingerprint (\_ _ -> EQ) fingerprintCodec) artifactsCodec + |> Serialize.finishCustomType -moduleNameRawMVarMaybeDResultDecoder : Decode.Decoder (Dict String ModuleName.Raw (MVar (Maybe DResult))) -moduleNameRawMVarMaybeDResultDecoder = - D.assocListDict identity ModuleName.rawDecoder Utils.mVarDecoder +dictPkgNameMVarDepCodec : Codec e (Dict ( String, String ) Pkg.Name (MVar Dep)) +dictPkgNameMVarDepCodec = + S.assocListDict identity Pkg.compareName Pkg.nameCodec Utils.mVarCodec -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 ) - ] +statusCodec : Codec e Status +statusCodec = + Serialize.customType + (\sLocalEncoder sForeignEncoder sKernelLocalEncoder sKernelForeignEncoder status -> + case status of + SLocal docsStatus deps modul -> + sLocalEncoder docsStatus deps modul - RKernelLocal chunks -> - Encode.object - [ ( "type", Encode.string "RKernelLocal" ) - , ( "chunks", Encode.list Kernel.chunkEncoder chunks ) - ] + SForeign iface -> + sForeignEncoder iface - RKernelForeign -> - Encode.object - [ ( "type", Encode.string "RKernelForeign" ) - ] + SKernelLocal chunks -> + sKernelLocalEncoder chunks + SKernelForeign -> + sKernelForeignEncoder + ) + |> Serialize.variant3 SLocal docsStatusCodec (S.assocListDict identity compare ModuleName.rawCodec Serialize.unit) Src.moduleCodec + |> Serialize.variant1 SForeign I.interfaceCodec + |> Serialize.variant1 SKernelLocal (Serialize.list Kernel.chunkCodec) + |> Serialize.variant0 SKernelForeign + |> Serialize.finishCustomType -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) +dictRawMVarMaybeDResultCodec : Codec e (Dict String ModuleName.Raw (MVar (Maybe DResult))) +dictRawMVarMaybeDResultCodec = + S.assocListDict identity compare ModuleName.rawCodec Utils.mVarCodec - "RKernelLocal" -> - Decode.map RKernelLocal (Decode.field "chunks" (Decode.list Kernel.chunkDecoder)) - "RKernelForeign" -> - Decode.succeed RKernelForeign +moduleNameRawMVarMaybeDResultCodec : Codec e (Dict String ModuleName.Raw (MVar (Maybe DResult))) +moduleNameRawMVarMaybeDResultCodec = + S.assocListDict identity compare ModuleName.rawCodec Utils.mVarCodec - _ -> - Decode.fail ("Failed to decode DResult's type: " ++ type_) - ) +dResultCodec : Codec e DResult +dResultCodec = + Serialize.customType + (\rLocalEncoder rForeignEncoder rKernelLocalEncoder rKernelForeignEncoder dResult -> + case dResult of + RLocal ifaces objects docs -> + rLocalEncoder ifaces objects docs -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 - - -localEncoder : Local -> Encode.Value -localEncoder (Local path time deps hasMain lastChange lastCompile) = - Encode.object - [ ( "type", Encode.string "Local" ) - , ( "path", Encode.string path ) - , ( "time", File.timeEncoder time ) - , ( "deps", Encode.list ModuleName.rawEncoder deps ) - , ( "hasMain", Encode.bool hasMain ) - , ( "lastChange", Encode.int lastChange ) - , ( "lastCompile", Encode.int lastCompile ) - ] - - -localDecoder : Decode.Decoder Local -localDecoder = - Decode.map6 Local - (Decode.field "path" Decode.string) - (Decode.field "time" File.timeDecoder) - (Decode.field "deps" (Decode.list ModuleName.rawDecoder)) - (Decode.field "hasMain" Decode.bool) - (Decode.field "lastChange" Decode.int) - (Decode.field "lastCompile" Decode.int) - - -validOutlineEncoder : ValidOutline -> Encode.Value -validOutlineEncoder validOutline = - case validOutline of - ValidApp srcDirs -> - Encode.object - [ ( "type", Encode.string "ValidApp" ) - , ( "srcDirs", E.nonempty Outline.srcDirEncoder srcDirs ) - ] - - ValidPkg pkg exposedList exactDeps -> - Encode.object - [ ( "type", Encode.string "ValidPkg" ) - , ( "pkg", Pkg.nameEncoder pkg ) - , ( "exposedList", Encode.list ModuleName.rawEncoder exposedList ) - , ( "exactDeps", E.assocListDict compare Pkg.nameEncoder V.versionEncoder exactDeps ) - ] - - -validOutlineDecoder : Decode.Decoder ValidOutline -validOutlineDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "ValidApp" -> - Decode.map ValidApp (Decode.field "srcDirs" (D.nonempty Outline.srcDirDecoder)) - - "ValidPkg" -> - Decode.map3 ValidPkg - (Decode.field "pkg" Pkg.nameDecoder) - (Decode.field "exposedList" (Decode.list ModuleName.rawDecoder)) - (Decode.field "exactDeps" (D.assocListDict identity Pkg.nameDecoder V.versionDecoder)) + RForeign iface -> + rForeignEncoder iface - _ -> - Decode.fail ("Failed to decode ValidOutline's type: " ++ type_) - ) + RKernelLocal chunks -> + rKernelLocalEncoder chunks + RKernelForeign -> + rKernelForeignEncoder + ) + |> Serialize.variant3 RLocal I.interfaceCodec Opt.localGraphCodec (Serialize.maybe Docs.moduleCodec) + |> Serialize.variant1 RForeign I.interfaceCodec + |> Serialize.variant1 RKernelLocal (Serialize.list Kernel.chunkCodec) + |> Serialize.variant0 RKernelForeign + |> Serialize.finishCustomType -foreignEncoder : Foreign -> Encode.Value -foreignEncoder (Foreign dep deps) = - Encode.object - [ ( "type", Encode.string "Foreign" ) - , ( "dep", Pkg.nameEncoder dep ) - , ( "deps", Encode.list Pkg.nameEncoder deps ) - ] +statusDictCodec : Codec e StatusDict +statusDictCodec = + S.assocListDict identity compare ModuleName.rawCodec Utils.mVarCodec -foreignDecoder : Decode.Decoder Foreign -foreignDecoder = - Decode.map2 Foreign - (Decode.field "dep" Pkg.nameDecoder) - (Decode.field "deps" (Decode.list Pkg.nameDecoder)) +localCodec : Codec e Local +localCodec = + Serialize.customType + (\localCodecEncoder (Local path time deps hasMain lastChange lastCompile) -> + localCodecEncoder path time deps hasMain lastChange lastCompile + ) + |> Serialize.variant6 Local Serialize.string File.timeCodec (Serialize.list ModuleName.rawCodec) Serialize.bool Serialize.int Serialize.int + |> Serialize.finishCustomType -extrasEncoder : Extras -> Encode.Value -extrasEncoder extras = - case extras of - ArtifactsCached -> - Encode.object - [ ( "type", Encode.string "ArtifactsCached" ) - ] - - ArtifactsFresh ifaces objs -> - Encode.object - [ ( "type", Encode.string "ArtifactsFresh" ) - , ( "ifaces", interfacesEncoder ifaces ) - , ( "objs", Opt.globalGraphEncoder objs ) - ] - - -extrasDecoder : Decode.Decoder Extras -extrasDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "ArtifactsCached" -> - Decode.succeed ArtifactsCached - - "ArtifactsFresh" -> - Decode.map2 ArtifactsFresh - (Decode.field "ifaces" interfacesDecoder) - (Decode.field "objs" Opt.globalGraphDecoder) - _ -> - Decode.fail ("Failed to decode Extras' type: " ++ type_) - ) +validOutlineCodec : Codec (Serialize.Error e) ValidOutline +validOutlineCodec = + Serialize.customType + (\validAppEncoder validPkgEncoder validOutline -> + case validOutline of + ValidApp srcDirs -> + validAppEncoder srcDirs + ValidPkg pkg exposedList exactDeps -> + validPkgEncoder pkg exposedList exactDeps + ) + |> Serialize.variant1 ValidApp (S.nonempty Outline.srcDirCodec) + |> Serialize.variant3 ValidPkg Pkg.nameCodec (Serialize.list ModuleName.rawCodec) (S.assocListDict identity Pkg.compareName Pkg.nameCodec V.versionCodec) + |> Serialize.finishCustomType -fingerprintEncoder : Fingerprint -> Encode.Value -fingerprintEncoder = - E.assocListDict compare Pkg.nameEncoder V.versionEncoder +foreignCodec : Codec e Foreign +foreignCodec = + Serialize.customType + (\foreignCodecEncoder (Foreign dep deps) -> + foreignCodecEncoder dep deps + ) + |> Serialize.variant2 Foreign Pkg.nameCodec (Serialize.list Pkg.nameCodec) + |> Serialize.finishCustomType -fingerprintDecoder : Decode.Decoder Fingerprint -fingerprintDecoder = - D.assocListDict identity Pkg.nameDecoder V.versionDecoder +extrasCodec : Codec e Extras +extrasCodec = + Serialize.customType + (\artifactsCachedEncoder artifactsFreshEncoder extras -> + case extras of + ArtifactsCached -> + artifactsCachedEncoder -docsStatusEncoder : DocsStatus -> Encode.Value -docsStatusEncoder docsStatus = - case docsStatus of - DocsNeeded -> - Encode.string "DocsNeeded" + ArtifactsFresh ifaces objs -> + artifactsFreshEncoder ifaces objs + ) + |> Serialize.variant0 ArtifactsCached + |> Serialize.variant2 ArtifactsFresh interfacesCodec Opt.globalGraphCodec + |> Serialize.finishCustomType - DocsNotNeeded -> - Encode.string "DocsNotNeeded" +fingerprintCodec : Codec e Fingerprint +fingerprintCodec = + S.assocListDict identity Pkg.compareName Pkg.nameCodec V.versionCodec -docsStatusDecoder : Decode.Decoder DocsStatus -docsStatusDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "DocsNeeded" -> - Decode.succeed DocsNeeded - "DocsNotNeeded" -> - Decode.succeed DocsNotNeeded +docsStatusCodec : Codec e DocsStatus +docsStatusCodec = + Serialize.customType + (\docsNeededEncoder docsNotNeededEncoder docsStatus -> + case docsStatus of + DocsNeeded -> + docsNeededEncoder - _ -> - Decode.fail ("Unknown DocsStatus: " ++ str) - ) + DocsNotNeeded -> + docsNotNeededEncoder + ) + |> Serialize.variant0 DocsNeeded + |> Serialize.variant0 DocsNotNeeded + |> Serialize.finishCustomType diff --git a/src/Builder/Elm/Outline.elm b/src/Builder/Elm/Outline.elm index 1bbd3208f..901595c84 100644 --- a/src/Builder/Elm/Outline.elm +++ b/src/Builder/Elm/Outline.elm @@ -9,8 +9,7 @@ module Builder.Elm.Outline exposing , defaultSummary , flattenExposed , read - , srcDirDecoder - , srcDirEncoder + , srcDirCodec , write ) @@ -28,8 +27,7 @@ import Compiler.Json.Decode as D import Compiler.Json.Encode as E import Compiler.Parse.Primitives as P import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.IO as IO exposing (IO) import Utils.Main as Utils exposing (FilePath) @@ -421,34 +419,17 @@ boundParser bound tooLong = Err (P.PErr P.Consumed row newCol (\_ _ -> tooLong)) -srcDirEncoder : SrcDir -> Encode.Value -srcDirEncoder srcDir = - case srcDir of - AbsoluteSrcDir dir -> - Encode.object - [ ( "type", Encode.string "AbsoluteSrcDir" ) - , ( "dir", Encode.string dir ) - ] - - RelativeSrcDir dir -> - Encode.object - [ ( "type", Encode.string "RelativeSrcDir" ) - , ( "dir", Encode.string dir ) - ] - - -srcDirDecoder : Decode.Decoder SrcDir -srcDirDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "AbsoluteSrcDir" -> - Decode.map AbsoluteSrcDir (Decode.field "dir" Decode.string) - - "RelativeSrcDir" -> - Decode.map RelativeSrcDir (Decode.field "dir" Decode.string) - - _ -> - Decode.fail ("Failed to decode SrcDir's type: " ++ type_) - ) +srcDirCodec : Codec e SrcDir +srcDirCodec = + Serialize.customType + (\absoluteSrcDirEncoder relativeSrcDirEncoder srcDir -> + case srcDir of + AbsoluteSrcDir dir -> + absoluteSrcDirEncoder dir + + RelativeSrcDir dir -> + relativeSrcDirEncoder dir + ) + |> Serialize.variant1 AbsoluteSrcDir Serialize.string + |> Serialize.variant1 RelativeSrcDir Serialize.string + |> Serialize.finishCustomType diff --git a/src/Builder/File.elm b/src/Builder/File.elm index 7ac13d8c9..45bd3b235 100644 --- a/src/Builder/File.elm +++ b/src/Builder/File.elm @@ -5,8 +5,7 @@ module Builder.File exposing , readBinary , readUtf8 , remove - , timeDecoder - , timeEncoder + , timeCodec , writeBinary , writeBuilder , writePackage @@ -15,8 +14,7 @@ module Builder.File exposing ) import Codec.Archive.Zip as Zip -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.IO as IO exposing (IO(..)) import Time import Utils.Main as Utils exposing (FilePath) @@ -44,24 +42,24 @@ zeroTime = -- BINARY -writeBinary : (a -> Encode.Value) -> FilePath -> a -> IO () -writeBinary encoder path value = +writeBinary : Codec e a -> FilePath -> a -> IO () +writeBinary codec path value = let dir : FilePath dir = Utils.fpDropFileName path in Utils.dirCreateDirectoryIfMissing True dir - |> IO.bind (\_ -> Utils.binaryEncodeFile encoder path value) + |> IO.bind (\_ -> Utils.binaryEncodeFile codec path value) -readBinary : Decode.Decoder a -> FilePath -> IO (Maybe a) -readBinary decoder path = +readBinary : Codec e a -> FilePath -> IO (Maybe a) +readBinary codec path = Utils.dirDoesFileExist path |> IO.bind (\pathExists -> if pathExists then - Utils.binaryDecodeFileOrFail decoder path + Utils.binaryDecodeFileOrFail codec path |> IO.bind (\result -> case result of @@ -188,11 +186,6 @@ remove path = -- ENCODERS and DECODERS -timeEncoder : Time -> Encode.Value -timeEncoder (Time posix) = - Encode.int (Time.posixToMillis posix) - - -timeDecoder : Decode.Decoder Time -timeDecoder = - Decode.map (Time << Time.millisToPosix) Decode.int +timeCodec : Codec e Time +timeCodec = + Serialize.int |> Serialize.map (Time << Time.millisToPosix) (\(Time posix) -> Time.posixToMillis posix) diff --git a/src/Builder/Generate.elm b/src/Builder/Generate.elm index a8ee9b996..aab010d0d 100644 --- a/src/Builder/Generate.elm +++ b/src/Builder/Generate.elm @@ -23,7 +23,7 @@ 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 Serialize import System.IO as IO exposing (IO) import System.TypeCheck.IO as TypeCheck import Utils.Main as Utils exposing (FilePath, MVar) @@ -197,14 +197,14 @@ loadObject : FilePath -> Build.Module -> IO ( ModuleName.Raw, MVar (Maybe Opt.Lo loadObject root modul = case modul of Build.Fresh name _ graph -> - Utils.newMVar (Utils.maybeEncoder Opt.localGraphEncoder) (Just graph) + Utils.newMVar (Serialize.maybe Opt.localGraphCodec) (Just graph) |> IO.fmap (\mvar -> ( name, mvar )) Build.Cached name _ _ -> Utils.newEmptyMVar |> IO.bind (\mvar -> - Utils.forkIO (IO.bind (Utils.putMVar (Utils.maybeEncoder Opt.localGraphEncoder) mvar) (File.readBinary Opt.localGraphDecoder (Stuff.elmo root name))) + Utils.forkIO (IO.bind (Utils.putMVar (Serialize.maybe Opt.localGraphCodec) mvar) (File.readBinary Opt.localGraphCodec (Stuff.elmo root name))) |> IO.fmap (\_ -> ( name, mvar )) ) @@ -220,10 +220,10 @@ type Objects finalizeObjects : LoadingObjects -> Task Objects finalizeObjects (LoadingObjects mvar mvars) = Task.eio identity - (Utils.readMVar (Decode.maybe Opt.globalGraphDecoder) mvar + (Utils.readMVar (Serialize.maybe Opt.globalGraphCodec) mvar |> IO.bind (\result -> - Utils.mapTraverse identity compare (Utils.readMVar (Decode.maybe Opt.localGraphDecoder)) mvars + Utils.mapTraverse identity compare (Utils.readMVar (Serialize.maybe Opt.localGraphCodec)) mvars |> IO.fmap (\results -> case Maybe.map2 Objects result (Utils.sequenceDictMaybe identity compare results) of @@ -257,7 +257,7 @@ loadTypes root ifaces modules = 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 (Serialize.maybe Extract.typesCodec)) mvars |> IO.fmap (\results -> case Utils.sequenceListMaybe results of @@ -275,10 +275,10 @@ loadTypesHelp : FilePath -> Build.Module -> IO (MVar (Maybe Extract.Types)) loadTypesHelp root modul = case modul of Build.Fresh name iface _ -> - Utils.newMVar (Utils.maybeEncoder Extract.typesEncoder) (Just (Extract.fromInterface name iface)) + Utils.newMVar (Serialize.maybe Extract.typesCodec) (Just (Extract.fromInterface name iface)) Build.Cached name _ ciMVar -> - Utils.readMVar Build.cachedInterfaceDecoder ciMVar + Utils.readMVar Build.cachedInterfaceCodec ciMVar |> IO.bind (\cachedInterface -> case cachedInterface of @@ -287,18 +287,18 @@ loadTypesHelp root modul = |> IO.bind (\mvar -> Utils.forkIO - (File.readBinary I.interfaceDecoder (Stuff.elmi root name) + (File.readBinary I.interfaceCodec (Stuff.elmi root name) |> IO.bind (\maybeIface -> - Utils.putMVar (Utils.maybeEncoder Extract.typesEncoder) mvar (Maybe.map (Extract.fromInterface name) maybeIface) + Utils.putMVar (Serialize.maybe Extract.typesCodec) mvar (Maybe.map (Extract.fromInterface name) maybeIface) ) ) |> IO.fmap (\_ -> mvar) ) Build.Loaded iface -> - Utils.newMVar (Utils.maybeEncoder Extract.typesEncoder) (Just (Extract.fromInterface name iface)) + Utils.newMVar (Serialize.maybe Extract.typesCodec) (Just (Extract.fromInterface name iface)) Build.Corrupted -> - Utils.newMVar (Utils.maybeEncoder Extract.typesEncoder) Nothing + Utils.newMVar (Serialize.maybe Extract.typesCodec) Nothing ) diff --git a/src/Builder/Http.elm b/src/Builder/Http.elm index 7bee272b8..368c961bb 100644 --- a/src/Builder/Http.elm +++ b/src/Builder/Http.elm @@ -5,15 +5,13 @@ module Builder.Http exposing , MultiPart , Sha , accept - , errorDecoder - , errorEncoder + , errorCodec , filePart , get , getArchive , getManager , jsonPart - , managerDecoder - , managerEncoder + , managerCodec , post , shaToChars , stringPart @@ -24,8 +22,8 @@ module Builder.Http exposing import Basics.Extra exposing (uncurry) import Codec.Archive.Zip as Zip import Compiler.Elm.Version as V -import Json.Decode as Decode import Json.Encode as Encode +import Serialize exposing (Codec) import System.IO as IO exposing (IO(..)) import Url.Builder import Utils.Main as Utils exposing (SomeException) @@ -39,23 +37,14 @@ type Manager = Manager -managerEncoder : Manager -> Encode.Value -managerEncoder _ = - Encode.object [ ( "type", Encode.string "Manager" ) ] - - -managerDecoder : Decode.Decoder Manager -managerDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Manager" -> - Decode.succeed Manager - - _ -> - Decode.fail "Failed to decode Http.Manager" - ) +managerCodec : Codec e Manager +managerCodec = + Serialize.customType + (\managerCodecEncoder Manager -> + managerCodecEncoder + ) + |> Serialize.variant0 Manager + |> Serialize.finishCustomType getManager : IO Manager @@ -244,52 +233,21 @@ stringPart name string = -- ENCODERS and DECODERS -errorEncoder : Error -> Encode.Value -errorEncoder error = - case error of - BadUrl url reason -> - Encode.object - [ ( "type", Encode.string "BadUrl" ) - , ( "url", Encode.string url ) - , ( "reason", Encode.string reason ) - ] - - BadHttp url httpExceptionContent -> - Encode.object - [ ( "type", Encode.string "BadHttp" ) - , ( "url", Encode.string url ) - , ( "httpExceptionContent", Utils.httpExceptionContentEncoder httpExceptionContent ) - ] - - BadMystery url someException -> - Encode.object - [ ( "type", Encode.string "BadMystery" ) - , ( "url", Encode.string url ) - , ( "someException", Utils.someExceptionEncoder someException ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "BadUrl" -> - Decode.map2 BadUrl - (Decode.field "url" Decode.string) - (Decode.field "reason" Decode.string) - - "BadHttp" -> - Decode.map2 BadHttp - (Decode.field "url" Decode.string) - (Decode.field "httpExceptionContent" Utils.httpExceptionContentDecoder) - - "BadMystery" -> - Decode.map2 BadMystery - (Decode.field "url" Decode.string) - (Decode.field "someException" Utils.someExceptionDecoder) - - _ -> - Decode.fail ("Failed to decode Error's type: " ++ type_) - ) +errorCodec : Codec e Error +errorCodec = + Serialize.customType + (\badUrlEncoder badHttpEncoder badMysteryEncoder value -> + case value of + BadUrl url reason -> + badUrlEncoder url reason + + BadHttp url httpExceptionContent -> + badHttpEncoder url httpExceptionContent + + BadMystery url someException -> + badMysteryEncoder url someException + ) + |> Serialize.variant2 BadUrl Serialize.string Serialize.string + |> Serialize.variant2 BadHttp Serialize.string Utils.httpExceptionContentCodec + |> Serialize.variant2 BadMystery Serialize.string Utils.someExceptionCodec + |> Serialize.finishCustomType diff --git a/src/Builder/Reporting.elm b/src/Builder/Reporting.elm index 962085e88..546457d67 100644 --- a/src/Builder/Reporting.elm +++ b/src/Builder/Reporting.elm @@ -24,11 +24,9 @@ import Compiler.Data.NonEmptyList as NE import Compiler.Elm.ModuleName as ModuleName import Compiler.Elm.Package as Pkg import Compiler.Elm.Version as V -import Compiler.Json.Decode as DecodeX import Compiler.Json.Encode as Encode import Compiler.Reporting.Doc as D -import Json.Decode as Decode -import Json.Encode as CoreEncode +import Serialize exposing (Codec) import System.Exit as Exit import System.IO as IO exposing (IO) import Utils.Main as Utils exposing (Chan, MVar) @@ -56,7 +54,7 @@ json = terminal : IO Style terminal = - IO.fmap Terminal (Utils.newMVar (\_ -> CoreEncode.bool True) ()) + IO.fmap Terminal (Utils.newMVar Serialize.unit ()) @@ -99,7 +97,7 @@ attemptWithStyle style toReport work = |> IO.bind (\_ -> Exit.exitFailure) Terminal mvar -> - Utils.readMVar (Decode.map (\_ -> ()) Decode.bool) mvar + Utils.readMVar Serialize.unit mvar |> IO.bind (\_ -> Exit.toStderr (toReport x)) |> IO.bind (\_ -> Exit.exitFailure) ) @@ -208,25 +206,25 @@ trackDetails style callback = callback (Key (\_ -> IO.pure ())) Terminal mvar -> - Utils.newChan Utils.mVarEncoder + Utils.newChan Utils.mVarCodec |> IO.bind (\chan -> Utils.forkIO - (Utils.takeMVar (Decode.succeed ()) mvar + (Utils.takeMVar Serialize.unit mvar |> IO.bind (\_ -> detailsLoop chan (DState 0 0 0 0 0 0 0)) - |> IO.bind (\_ -> Utils.putMVar (\_ -> CoreEncode.bool True) mvar ()) + |> IO.bind (\_ -> Utils.putMVar Serialize.unit mvar ()) ) |> IO.bind (\_ -> let - encoder : Maybe DMsg -> CoreEncode.Value - encoder = - Encode.maybe dMsgEncoder + codec : Codec e (Maybe DMsg) + codec = + Serialize.maybe dMsgCodec in - callback (Key (Utils.writeChan encoder chan << Just)) + callback (Key (Utils.writeChan codec chan << Just)) |> IO.bind (\answer -> - Utils.writeChan encoder chan Nothing + Utils.writeChan codec chan Nothing |> IO.fmap (\_ -> answer) ) ) @@ -235,7 +233,7 @@ trackDetails style callback = detailsLoop : Chan (Maybe DMsg) -> DState -> IO () detailsLoop chan ((DState total _ _ _ _ built _) as state) = - Utils.readChan (Decode.maybe dMsgDecoder) chan + Utils.readChan (Serialize.maybe dMsgCodec) chan |> IO.bind (\msg -> case msg of @@ -369,8 +367,8 @@ type alias BResult a = Result Exit.BuildProblem a -trackBuild : Decode.Decoder a -> (a -> CoreEncode.Value) -> Style -> (BKey -> IO (BResult a)) -> IO (BResult a) -trackBuild decoder encoder style callback = +trackBuild : Codec (Serialize.Error e) a -> Style -> (BKey -> IO (BResult a)) -> IO (BResult a) +trackBuild codec style callback = case style of Silent -> callback (Key (\_ -> IO.pure ())) @@ -379,24 +377,24 @@ trackBuild decoder encoder style callback = callback (Key (\_ -> IO.pure ())) Terminal mvar -> - Utils.newChan Utils.mVarEncoder + Utils.newChan Utils.mVarCodec |> IO.bind (\chan -> let - chanEncoder : Result BMsg (BResult a) -> CoreEncode.Value - chanEncoder = - Encode.result bMsgEncoder (bResultEncoder encoder) + chanCodec : Codec (Serialize.Error e) (Result BMsg (BResult a)) + chanCodec = + Serialize.result bMsgCodec (bResultCodec codec) in Utils.forkIO - (Utils.takeMVar (Decode.succeed ()) mvar + (Utils.takeMVar Serialize.unit mvar |> IO.bind (\_ -> putStrFlush "Compiling ...") - |> IO.bind (\_ -> buildLoop decoder chan 0) - |> IO.bind (\_ -> Utils.putMVar (\_ -> CoreEncode.bool True) mvar ()) + |> IO.bind (\_ -> buildLoop codec chan 0) + |> IO.bind (\_ -> Utils.putMVar Serialize.unit mvar ()) ) - |> IO.bind (\_ -> callback (Key (Utils.writeChan chanEncoder chan << Err))) + |> IO.bind (\_ -> callback (Key (Utils.writeChan chanCodec chan << Err))) |> IO.bind (\result -> - Utils.writeChan chanEncoder chan (Ok result) + Utils.writeChan chanCodec chan (Ok result) |> IO.fmap (\_ -> result) ) ) @@ -406,9 +404,9 @@ type BMsg = BDone -buildLoop : Decode.Decoder a -> Chan (Result BMsg (BResult a)) -> Int -> IO () -buildLoop decoder chan done = - Utils.readChan (DecodeX.result bMsgDecoder (bResultDecoder decoder)) chan +buildLoop : Codec (Serialize.Error e) a -> Chan (Result BMsg (BResult a)) -> Int -> IO () +buildLoop codec chan done = + Utils.readChan (Serialize.result bMsgCodec (bResultCodec codec)) chan |> IO.bind (\msg -> case msg of @@ -419,7 +417,7 @@ buildLoop decoder chan done = done + 1 in putStrFlush ("\u{000D}Compiling (" ++ String.fromInt done1 ++ ")") - |> IO.bind (\_ -> buildLoop decoder chan done1) + |> IO.bind (\_ -> buildLoop codec chan done1) Ok result -> let @@ -482,7 +480,7 @@ reportGenerate style names output = IO.pure () Terminal mvar -> - Utils.readMVar (Decode.map (\_ -> ()) Decode.bool) mvar + Utils.readMVar Serialize.unit mvar |> IO.bind (\_ -> let @@ -570,112 +568,52 @@ putStrFlush str = -- ENCODERS and DECODERS -dMsgEncoder : DMsg -> CoreEncode.Value -dMsgEncoder dMsg = - case dMsg of - DStart numDependencies -> - CoreEncode.object - [ ( "type", CoreEncode.string "DStart" ) - , ( "numDependencies", CoreEncode.int numDependencies ) - ] - - DCached -> - CoreEncode.object - [ ( "type", CoreEncode.string "DCached" ) - ] - - DRequested -> - CoreEncode.object - [ ( "type", CoreEncode.string "DRequested" ) - ] - - DReceived pkg vsn -> - CoreEncode.object - [ ( "type", CoreEncode.string "DReceived" ) - , ( "pkg", Pkg.nameEncoder pkg ) - , ( "vsn", V.versionEncoder vsn ) - ] - - DFailed pkg vsn -> - CoreEncode.object - [ ( "type", CoreEncode.string "DFailed" ) - , ( "pkg", Pkg.nameEncoder pkg ) - , ( "vsn", V.versionEncoder vsn ) - ] - - DBuilt -> - CoreEncode.object - [ ( "type", CoreEncode.string "DBuilt" ) - ] - - DBroken -> - CoreEncode.object - [ ( "type", CoreEncode.string "DBroken" ) - ] - - -dMsgDecoder : Decode.Decoder DMsg -dMsgDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "DStart" -> - Decode.map DStart (Decode.field "numDependencies" Decode.int) +dMsgCodec : Codec e DMsg +dMsgCodec = + Serialize.customType + (\dStartEncoder dCachedEncoder dRequestedEncoder dReceivedEncoder dFailedEncoder dBuiltEncoder dBrokenEncoder dMsg -> + case dMsg of + DStart numDependencies -> + dStartEncoder numDependencies - "DCached" -> - Decode.succeed DCached + DCached -> + dCachedEncoder - "DRequested" -> - Decode.succeed DRequested + DRequested -> + dRequestedEncoder - "DReceived" -> - Decode.map2 DReceived - (Decode.field "pkg" Pkg.nameDecoder) - (Decode.field "vsn" V.versionDecoder) + DReceived pkg vsn -> + dReceivedEncoder pkg vsn - "DFailed" -> - Decode.map2 DFailed - (Decode.field "pkg" Pkg.nameDecoder) - (Decode.field "vsn" V.versionDecoder) + DFailed pkg vsn -> + dFailedEncoder pkg vsn - "DBuilt" -> - Decode.succeed DBuilt + DBuilt -> + dBuiltEncoder - "DBroken" -> - Decode.succeed DBroken - - _ -> - Decode.fail ("Failed to decode DMsg's type: " ++ type_) - ) - - -bMsgEncoder : BMsg -> CoreEncode.Value -bMsgEncoder _ = - CoreEncode.object - [ ( "type", CoreEncode.string "BDone" ) - ] - - -bMsgDecoder : Decode.Decoder BMsg -bMsgDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "BDone" -> - Decode.succeed BDone - - _ -> - Decode.fail ("Failed to decode BDone's type: " ++ type_) - ) - - -bResultEncoder : (a -> CoreEncode.Value) -> BResult a -> CoreEncode.Value -bResultEncoder encoder bResult = - Encode.result Exit.buildProblemEncoder encoder bResult + DBroken -> + dBrokenEncoder + ) + |> Serialize.variant1 DStart Serialize.int + |> Serialize.variant0 DCached + |> Serialize.variant0 DRequested + |> Serialize.variant2 DReceived Pkg.nameCodec V.versionCodec + |> Serialize.variant2 DFailed Pkg.nameCodec V.versionCodec + |> Serialize.variant0 DBuilt + |> Serialize.variant0 DBroken + |> Serialize.finishCustomType + + +bMsgCodec : Codec e BMsg +bMsgCodec = + Serialize.customType + (\bMsgCodecEncoder BDone -> + bMsgCodecEncoder + ) + |> Serialize.variant0 BDone + |> Serialize.finishCustomType -bResultDecoder : Decode.Decoder a -> Decode.Decoder (BResult a) -bResultDecoder decoder = - DecodeX.result Exit.buildProblemDecoder decoder +bResultCodec : Codec (Serialize.Error e) a -> Codec (Serialize.Error e) (BResult a) +bResultCodec codec = + Serialize.result Exit.buildProblemCodec codec diff --git a/src/Builder/Reporting/Exit.elm b/src/Builder/Reporting/Exit.elm index e665d0c9f..fb4f0025e 100644 --- a/src/Builder/Reporting/Exit.elm +++ b/src/Builder/Reporting/Exit.elm @@ -17,21 +17,17 @@ module Builder.Reporting.Exit exposing , RegistryProblem(..) , Repl(..) , Solver(..) - , buildProblemDecoder - , buildProblemEncoder - , buildProjectProblemDecoder - , buildProjectProblemEncoder + , buildProblemCodec + , buildProjectProblemCodec , bumpToReport - , detailsBadDepDecoder - , detailsBadDepEncoder + , detailsBadDepCodec , diffToReport , initToReport , installToReport , makeToReport , newPackageOverview , publishToReport - , registryProblemDecoder - , registryProblemEncoder + , registryProblemCodec , replToReport , toJson , toStderr @@ -56,9 +52,9 @@ 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 Compiler.Serialize as S import Data.Map as Dict exposing (Dict) -import Json.Decode as CoreDecode -import Json.Encode as CoreEncode +import Serialize exposing (Codec) import System.IO exposing (IO) import Utils.Main as Utils exposing (FilePath) @@ -2824,304 +2820,121 @@ replToReport problem = -- ENCODERS and DECODERS -detailsBadDepEncoder : DetailsBadDep -> CoreEncode.Value -detailsBadDepEncoder detailsBadDep = - case detailsBadDep of - BD_BadDownload pkg vsn packageProblem -> - CoreEncode.object - [ ( "type", CoreEncode.string "BD_BadDownload" ) - , ( "pkg", Pkg.nameEncoder pkg ) - , ( "vsn", V.versionEncoder vsn ) - , ( "packageProblem", packageProblemEncoder packageProblem ) - ] - - BD_BadBuild pkg vsn fingerprint -> - CoreEncode.object - [ ( "type", CoreEncode.string "BD_BadBuild" ) - , ( "pkg", Pkg.nameEncoder pkg ) - , ( "vsn", V.versionEncoder vsn ) - , ( "fingerprint", Encode.assocListDict compare Pkg.nameEncoder V.versionEncoder fingerprint ) - ] - - -detailsBadDepDecoder : CoreDecode.Decoder DetailsBadDep -detailsBadDepDecoder = - CoreDecode.field "type" CoreDecode.string - |> CoreDecode.andThen - (\type_ -> - case type_ of - "BD_BadDownload" -> - CoreDecode.map3 BD_BadDownload - (CoreDecode.field "pkg" Pkg.nameDecoder) - (CoreDecode.field "vsn" V.versionDecoder) - (CoreDecode.field "packageProblem" packageProblemDecoder) - - "BD_BadBuild" -> - CoreDecode.map3 BD_BadBuild - (CoreDecode.field "pkg" Pkg.nameDecoder) - (CoreDecode.field "vsn" V.versionDecoder) - (CoreDecode.field "fingerprint" (Decode.assocListDict identity Pkg.nameDecoder V.versionDecoder)) - - _ -> - CoreDecode.fail ("Failed to decode DetailsBadDep's type: " ++ type_) - ) - - -buildProblemEncoder : BuildProblem -> CoreEncode.Value -buildProblemEncoder buildProblem = - case buildProblem of - BuildBadModules root e es -> - CoreEncode.object - [ ( "type", CoreEncode.string "BuildBadModules" ) - , ( "root", CoreEncode.string root ) - , ( "e", Error.moduleEncoder e ) - , ( "es", CoreEncode.list Error.jsonToJson es ) - ] - - BuildProjectProblem problem -> - CoreEncode.object - [ ( "type", CoreEncode.string "BuildProjectProblem" ) - , ( "problem", buildProjectProblemEncoder problem ) - ] - - -buildProblemDecoder : CoreDecode.Decoder BuildProblem -buildProblemDecoder = - CoreDecode.field "type" CoreDecode.string - |> CoreDecode.andThen - (\type_ -> - case type_ of - "BuildBadModules" -> - CoreDecode.map3 BuildBadModules - (CoreDecode.field "root" CoreDecode.string) - (CoreDecode.field "e" Error.moduleDecoder) - (CoreDecode.field "es" (CoreDecode.list Error.moduleDecoder)) - - "BuildProjectProblem" -> - CoreDecode.map BuildProjectProblem (CoreDecode.field "problem" buildProjectProblemDecoder) - - _ -> - CoreDecode.fail ("Failed to decode BuildProblem's type: " ++ type_) - ) - - -buildProjectProblemEncoder : BuildProjectProblem -> CoreEncode.Value -buildProjectProblemEncoder buildProjectProblem = - case buildProjectProblem of - BP_PathUnknown path -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_PathUnknown" ) - , ( "path", CoreEncode.string path ) - ] - - BP_WithBadExtension path -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_WithBadExtension" ) - , ( "path", CoreEncode.string path ) - ] - - BP_WithAmbiguousSrcDir path srcDir1 srcDir2 -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_WithAmbiguousSrcDir" ) - , ( "path", CoreEncode.string path ) - , ( "srcDir1", CoreEncode.string srcDir1 ) - , ( "srcDir2", CoreEncode.string srcDir2 ) - ] - - BP_MainPathDuplicate path1 path2 -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_MainPathDuplicate" ) - , ( "path1", CoreEncode.string path1 ) - , ( "path2", CoreEncode.string path2 ) - ] - - BP_RootNameDuplicate name outsidePath otherPath -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_RootNameDuplicate" ) - , ( "name", ModuleName.rawEncoder name ) - , ( "outsidePath", CoreEncode.string outsidePath ) - , ( "otherPath", CoreEncode.string otherPath ) - ] - - BP_RootNameInvalid givenPath srcDir names -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_RootNameInvalid" ) - , ( "givenPath", CoreEncode.string givenPath ) - , ( "srcDir", CoreEncode.string srcDir ) - , ( "names", CoreEncode.list CoreEncode.string names ) - ] - - BP_CannotLoadDependencies -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_CannotLoadDependencies" ) - ] - - BP_Cycle name names -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_Cycle" ) - , ( "name", ModuleName.rawEncoder name ) - , ( "names", CoreEncode.list ModuleName.rawEncoder names ) - ] - - BP_MissingExposed problems -> - CoreEncode.object - [ ( "type", CoreEncode.string "BP_MissingExposed" ) - , ( "problems", Encode.nonempty (Encode.jsonPair ModuleName.rawEncoder Import.problemEncoder) problems ) - ] - - -buildProjectProblemDecoder : CoreDecode.Decoder BuildProjectProblem -buildProjectProblemDecoder = - CoreDecode.field "type" CoreDecode.string - |> CoreDecode.andThen - (\type_ -> - case type_ of - "BP_PathUnknown" -> - CoreDecode.map BP_PathUnknown (CoreDecode.field "path" CoreDecode.string) - - "BP_WithBadExtension" -> - CoreDecode.map BP_WithBadExtension (CoreDecode.field "path" CoreDecode.string) - - "BP_WithAmbiguousSrcDir" -> - CoreDecode.map3 BP_WithAmbiguousSrcDir - (CoreDecode.field "path" CoreDecode.string) - (CoreDecode.field "srcDir1" CoreDecode.string) - (CoreDecode.field "srcDir2" CoreDecode.string) - - "BP_MainPathDuplicate" -> - CoreDecode.map2 BP_MainPathDuplicate - (CoreDecode.field "path1" CoreDecode.string) - (CoreDecode.field "path2" CoreDecode.string) - - "BP_RootNameDuplicate" -> - CoreDecode.map3 BP_RootNameDuplicate - (CoreDecode.field "name" ModuleName.rawDecoder) - (CoreDecode.field "outsidePath" CoreDecode.string) - (CoreDecode.field "otherPath" CoreDecode.string) - - "BP_RootNameInvalid" -> - CoreDecode.map3 BP_RootNameInvalid - (CoreDecode.field "givenPath" CoreDecode.string) - (CoreDecode.field "srcDir" CoreDecode.string) - (CoreDecode.field "names" (CoreDecode.list CoreDecode.string)) - - "BP_CannotLoadDependencies" -> - CoreDecode.succeed BP_CannotLoadDependencies - - "BP_Cycle" -> - CoreDecode.map2 BP_Cycle - (CoreDecode.field "name" ModuleName.rawDecoder) - (CoreDecode.field "names" (CoreDecode.list ModuleName.rawDecoder)) - - "BP_MissingExposed" -> - CoreDecode.map BP_MissingExposed - (CoreDecode.field "problems" - (Decode.nonempty - (Decode.jsonPair ModuleName.rawDecoder Import.problemDecoder) - ) - ) - - _ -> - CoreDecode.fail ("Failed to decode BuildProjectProblem's type: " ++ type_) - ) - - -registryProblemEncoder : RegistryProblem -> CoreEncode.Value -registryProblemEncoder registryProblem = - case registryProblem of - RP_Http err -> - CoreEncode.object - [ ( "type", CoreEncode.string "RP_Http" ) - , ( "err", Http.errorEncoder err ) - ] - - RP_Data url body -> - CoreEncode.object - [ ( "type", CoreEncode.string "RP_Data" ) - , ( "url", CoreEncode.string url ) - , ( "body", CoreEncode.string body ) - ] - - -registryProblemDecoder : CoreDecode.Decoder RegistryProblem -registryProblemDecoder = - CoreDecode.field "type" CoreDecode.string - |> CoreDecode.andThen - (\type_ -> - case type_ of - "RP_Http" -> - CoreDecode.map RP_Http (CoreDecode.field "err" Http.errorDecoder) - - "RP_Data" -> - CoreDecode.map2 RP_Data - (CoreDecode.field "url" CoreDecode.string) - (CoreDecode.field "body" CoreDecode.string) - - _ -> - CoreDecode.fail ("Failed to decode RegistryProblem's type: " ++ type_) - ) - - -packageProblemEncoder : PackageProblem -> CoreEncode.Value -packageProblemEncoder packageProblem = - case packageProblem of - PP_BadEndpointRequest httpError -> - CoreEncode.object - [ ( "type", CoreEncode.string "PP_BadEndpointRequest" ) - , ( "httpError", Http.errorEncoder httpError ) - ] - - PP_BadEndpointContent url -> - CoreEncode.object - [ ( "type", CoreEncode.string "PP_BadEndpointContent" ) - , ( "url", CoreEncode.string url ) - ] - - PP_BadArchiveRequest httpError -> - CoreEncode.object - [ ( "type", CoreEncode.string "PP_BadArchiveRequest" ) - , ( "httpError", Http.errorEncoder httpError ) - ] - - PP_BadArchiveContent url -> - CoreEncode.object - [ ( "type", CoreEncode.string "PP_BadArchiveContent" ) - , ( "url", CoreEncode.string url ) - ] - - PP_BadArchiveHash url expectedHash actualHash -> - CoreEncode.object - [ ( "type", CoreEncode.string "PP_BadArchiveHash" ) - , ( "url", CoreEncode.string url ) - , ( "expectedHash", CoreEncode.string expectedHash ) - , ( "actualHash", CoreEncode.string actualHash ) - ] - - -packageProblemDecoder : CoreDecode.Decoder PackageProblem -packageProblemDecoder = - CoreDecode.field "type" CoreDecode.string - |> CoreDecode.andThen - (\type_ -> - case type_ of - "PP_BadEndpointRequest" -> - CoreDecode.map PP_BadEndpointRequest (CoreDecode.field "httpError" Http.errorDecoder) - - "PP_BadEndpointContent" -> - CoreDecode.map PP_BadEndpointContent (CoreDecode.field "url" CoreDecode.string) - - "PP_BadArchiveRequest" -> - CoreDecode.map PP_BadArchiveRequest (CoreDecode.field "httpError" Http.errorDecoder) - - "PP_BadArchiveContent" -> - CoreDecode.map PP_BadArchiveContent (CoreDecode.field "url" CoreDecode.string) - - "PP_BadArchiveHash" -> - CoreDecode.map3 PP_BadArchiveHash - (CoreDecode.field "url" CoreDecode.string) - (CoreDecode.field "expectedHash" CoreDecode.string) - (CoreDecode.field "actualHash" CoreDecode.string) - - _ -> - CoreDecode.fail ("Failed to decode PackageProblem's type: " ++ type_) - ) +detailsBadDepCodec : Codec e DetailsBadDep +detailsBadDepCodec = + Serialize.customType + (\bdBadDownloadEncoder bdBadBuildEncoder detailsBadDep -> + case detailsBadDep of + BD_BadDownload pkg vsn packageProblem -> + bdBadDownloadEncoder pkg vsn packageProblem + + BD_BadBuild pkg vsn fingerprint -> + bdBadBuildEncoder pkg vsn fingerprint + ) + |> Serialize.variant3 BD_BadDownload Pkg.nameCodec V.versionCodec packageProblemCodec + |> Serialize.variant3 BD_BadBuild Pkg.nameCodec V.versionCodec (S.assocListDict identity Pkg.compareName Pkg.nameCodec V.versionCodec) + |> Serialize.finishCustomType + + +buildProblemCodec : Codec (Serialize.Error e) BuildProblem +buildProblemCodec = + Serialize.customType + (\buildBadModulesEncoder buildProjectProblemCodecEncoder buildProblem -> + case buildProblem of + BuildBadModules root e es -> + buildBadModulesEncoder root e es + + BuildProjectProblem problem -> + buildProjectProblemCodecEncoder problem + ) + |> Serialize.variant3 BuildBadModules Serialize.string Error.moduleCodec (Serialize.list Error.moduleCodec) + |> Serialize.variant1 BuildProjectProblem buildProjectProblemCodec + |> Serialize.finishCustomType + + +buildProjectProblemCodec : Codec (Serialize.Error e) BuildProjectProblem +buildProjectProblemCodec = + Serialize.customType + (\pathUnknownEncoder withBadExtensionEncoder withAmbiguousSrcDirEncoder mainPathDuplicateEncoder rootNameDuplicateEncoder rootNameInvalidEncoder cannotLoadDependenciesEncoder cycleEncoder missingExposedEncoder value -> + case value of + BP_PathUnknown path -> + pathUnknownEncoder path + + BP_WithBadExtension path -> + withBadExtensionEncoder path + + BP_WithAmbiguousSrcDir path srcDir1 srcDir2 -> + withAmbiguousSrcDirEncoder path srcDir1 srcDir2 + + BP_MainPathDuplicate path1 path2 -> + mainPathDuplicateEncoder path1 path2 + + BP_RootNameDuplicate name outsidePath otherPath -> + rootNameDuplicateEncoder name outsidePath otherPath + + BP_RootNameInvalid givenPath srcDir names -> + rootNameInvalidEncoder givenPath srcDir names + + BP_CannotLoadDependencies -> + cannotLoadDependenciesEncoder + + BP_Cycle name names -> + cycleEncoder name names + + BP_MissingExposed problems -> + missingExposedEncoder problems + ) + |> Serialize.variant1 BP_PathUnknown Serialize.string + |> Serialize.variant1 BP_WithBadExtension Serialize.string + |> Serialize.variant3 BP_WithAmbiguousSrcDir Serialize.string Serialize.string Serialize.string + |> Serialize.variant2 BP_MainPathDuplicate Serialize.string Serialize.string + |> Serialize.variant3 BP_RootNameDuplicate ModuleName.rawCodec Serialize.string Serialize.string + |> Serialize.variant3 BP_RootNameInvalid Serialize.string Serialize.string (Serialize.list Serialize.string) + |> Serialize.variant0 BP_CannotLoadDependencies + |> Serialize.variant2 BP_Cycle ModuleName.rawCodec (Serialize.list Serialize.string) + |> Serialize.variant1 BP_MissingExposed (S.nonempty (Serialize.tuple ModuleName.rawCodec Import.problemCodec)) + |> Serialize.finishCustomType + + +registryProblemCodec : Codec e RegistryProblem +registryProblemCodec = + Serialize.customType + (\httpEncoder dataEncoder value -> + case value of + RP_Http err -> + httpEncoder err + + RP_Data url body -> + dataEncoder url body + ) + |> Serialize.variant1 RP_Http Http.errorCodec + |> Serialize.variant2 RP_Data Serialize.string Serialize.string + |> Serialize.finishCustomType + + +packageProblemCodec : Codec e PackageProblem +packageProblemCodec = + Serialize.customType + (\badEndpointRequestEncoder badEndpointContentEncoder badArchiveRequestEncoder badArchiveContentEncoder badArchiveHashEncoder value -> + case value of + PP_BadEndpointRequest httpError -> + badEndpointRequestEncoder httpError + + PP_BadEndpointContent url -> + badEndpointContentEncoder url + + PP_BadArchiveRequest httpError -> + badArchiveRequestEncoder httpError + + PP_BadArchiveContent url -> + badArchiveContentEncoder url + + PP_BadArchiveHash url expectedHash actualHash -> + badArchiveHashEncoder url expectedHash actualHash + ) + |> Serialize.variant1 PP_BadEndpointRequest Http.errorCodec + |> Serialize.variant1 PP_BadEndpointContent Serialize.string + |> Serialize.variant1 PP_BadArchiveRequest Http.errorCodec + |> Serialize.variant1 PP_BadArchiveContent Serialize.string + |> Serialize.variant3 PP_BadArchiveHash Serialize.string Serialize.string Serialize.string + |> Serialize.finishCustomType diff --git a/src/Builder/Stuff.elm b/src/Builder/Stuff.elm index bf21b9bdb..45aea8da5 100644 --- a/src/Builder/Stuff.elm +++ b/src/Builder/Stuff.elm @@ -10,8 +10,7 @@ module Builder.Stuff exposing , interfaces , objects , package - , packageCacheDecoder - , packageCacheEncoder + , packageCacheCodec , prepublishDir , registry , withRegistryLock @@ -21,9 +20,8 @@ module Builder.Stuff exposing import Compiler.Elm.ModuleName as ModuleName import Compiler.Elm.Package as Pkg import Compiler.Elm.Version as V -import Json.Decode as Decode -import Json.Encode as Encode import Prelude +import Serialize exposing (Codec) import System.IO as IO exposing (IO) import Utils.Main as Utils @@ -39,17 +37,17 @@ stuff root = details : String -> String details root = - stuff root ++ "/d.json" + stuff root ++ "/d.dat" interfaces : String -> String interfaces root = - stuff root ++ "/i.json" + stuff root ++ "/i.dat" objects : String -> String objects root = - stuff root ++ "/o.json" + stuff root ++ "/o.dat" prepublishDir : String -> String @@ -150,7 +148,7 @@ getPackageCache = registry : PackageCache -> String registry (PackageCache dir) = - Utils.fpForwardSlash dir "registry.json" + Utils.fpForwardSlash dir "registry.dat" package : PackageCache -> Pkg.Name -> V.Version -> String @@ -200,14 +198,11 @@ getElmHome = -- ENCODERS and DECODERS -packageCacheEncoder : PackageCache -> Encode.Value -packageCacheEncoder (PackageCache dir) = - Encode.object - [ ( "type", Encode.string "PackageCache" ) - , ( "dir", Encode.string dir ) - ] - - -packageCacheDecoder : Decode.Decoder PackageCache -packageCacheDecoder = - Decode.map PackageCache (Decode.field "dir" Decode.string) +packageCacheCodec : Codec e PackageCache +packageCacheCodec = + Serialize.customType + (\packageCacheCodecEncoder (PackageCache dir) -> + packageCacheCodecEncoder dir + ) + |> Serialize.variant1 PackageCache Serialize.string + |> Serialize.finishCustomType diff --git a/src/Compiler/AST/Canonical.elm b/src/Compiler/AST/Canonical.elm index dab79d45c..b74fdd09e 100644 --- a/src/Compiler/AST/Canonical.elm +++ b/src/Compiler/AST/Canonical.elm @@ -24,19 +24,13 @@ module Compiler.AST.Canonical exposing , Port(..) , Type(..) , Union(..) - , aliasDecoder - , aliasEncoder - , annotationDecoder - , annotationEncoder - , ctorOptsDecoder - , ctorOptsEncoder - , fieldUpdateDecoder - , fieldUpdateEncoder + , aliasCodec + , annotationCodec + , ctorOptsCodec + , fieldUpdateCodec , fieldsToList - , typeDecoder - , typeEncoder - , unionDecoder - , unionEncoder + , typeCodec + , unionCodec ) {- Creating a canonical AST means finding the home module for all variables. @@ -64,12 +58,10 @@ import Compiler.AST.Utils.Shader as Shader import Compiler.Data.Index as Index import Compiler.Data.Name exposing (Name) import Compiler.Elm.ModuleName as ModuleName -import Compiler.Json.Decode as D -import Compiler.Json.Encode as E import Compiler.Reporting.Annotation as A +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.TypeCheck.IO as IO @@ -319,901 +311,430 @@ type Manager -- ENCODERS and DECODERS -annotationEncoder : Annotation -> Encode.Value -annotationEncoder (Forall freeVars tipe) = - Encode.object - [ ( "type", Encode.string "Forall" ) - , ( "freeVars", freeVarsEncoder freeVars ) - , ( "tipe", typeEncoder tipe ) - ] - - -annotationDecoder : Decode.Decoder Annotation -annotationDecoder = - Decode.map2 Forall - (Decode.field "freeVars" freeVarsDecoder) - (Decode.field "tipe" typeDecoder) - - -freeVarsEncoder : FreeVars -> Encode.Value -freeVarsEncoder = - E.assocListDict compare Encode.string (\_ -> Encode.object []) - - -freeVarsDecoder : Decode.Decoder FreeVars -freeVarsDecoder = - D.assocListDict identity Decode.string (Decode.succeed ()) - - -aliasEncoder : Alias -> Encode.Value -aliasEncoder (Alias vars tipe) = - Encode.object - [ ( "vars", Encode.list Encode.string vars ) - , ( "tipe", typeEncoder tipe ) - ] - - -aliasDecoder : Decode.Decoder Alias -aliasDecoder = - Decode.map2 Alias - (Decode.field "vars" (Decode.list Decode.string)) - (Decode.field "tipe" typeDecoder) - - -typeEncoder : Type -> Encode.Value -typeEncoder type_ = - case type_ of - TLambda a b -> - Encode.object - [ ( "type", Encode.string "TLambda" ) - , ( "a", typeEncoder a ) - , ( "b", typeEncoder b ) - ] - - TVar name -> - Encode.object - [ ( "type", Encode.string "TVar" ) - , ( "name", Encode.string name ) - ] - - TType home name args -> - Encode.object - [ ( "type", Encode.string "TType" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "args", Encode.list typeEncoder args ) - ] - - TRecord fields ext -> - Encode.object - [ ( "type", Encode.string "TRecord" ) - , ( "fields", E.assocListDict compare Encode.string fieldTypeEncoder fields ) - , ( "ext", E.maybe Encode.string ext ) - ] - - TUnit -> - Encode.object - [ ( "type", Encode.string "TUnit" ) - ] - - TTuple a b maybeC -> - Encode.object - [ ( "type", Encode.string "TTuple" ) - , ( "a", typeEncoder a ) - , ( "b", typeEncoder b ) - , ( "maybeC", E.maybe typeEncoder maybeC ) - ] - - TAlias home name args tipe -> - Encode.object - [ ( "type", Encode.string "TAlias" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "args", Encode.list (E.jsonPair Encode.string typeEncoder) args ) - , ( "tipe", aliasTypeEncoder tipe ) - ] - - -typeDecoder : Decode.Decoder Type -typeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "TLambda" -> - Decode.map2 TLambda - (Decode.field "a" typeDecoder) - (Decode.field "b" typeDecoder) - - "TVar" -> - Decode.map TVar - (Decode.field "name" Decode.string) - - "TType" -> - Decode.map3 TType - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list typeDecoder)) - - "TRecord" -> - Decode.map2 TRecord - (Decode.field "fields" (D.assocListDict identity Decode.string fieldTypeDecoder)) - (Decode.field "ext" (Decode.maybe Decode.string)) - - "TUnit" -> - Decode.succeed TUnit - - "TTuple" -> - Decode.map3 TTuple - (Decode.field "a" typeDecoder) - (Decode.field "b" typeDecoder) - (Decode.field "maybeC" (Decode.maybe typeDecoder)) - - "TAlias" -> - Decode.map4 TAlias - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list (D.jsonPair Decode.string typeDecoder))) - (Decode.field "tipe" aliasTypeDecoder) - - _ -> - Decode.fail ("Unknown Type's type: " ++ type_) - ) - - -fieldTypeEncoder : FieldType -> Encode.Value -fieldTypeEncoder (FieldType index tipe) = - Encode.object - [ ( "type", Encode.string "FieldType" ) - , ( "index", Encode.int index ) - , ( "tipe", typeEncoder tipe ) - ] - - -aliasTypeEncoder : AliasType -> Encode.Value -aliasTypeEncoder aliasType = - case aliasType of - Holey tipe -> - Encode.object - [ ( "type", Encode.string "Holey" ) - , ( "tipe", typeEncoder tipe ) - ] - - Filled tipe -> - Encode.object - [ ( "type", Encode.string "Filled" ) - , ( "tipe", typeEncoder tipe ) - ] - - -fieldTypeDecoder : Decode.Decoder FieldType -fieldTypeDecoder = - Decode.map2 FieldType - (Decode.field "index" Decode.int) - (Decode.field "tipe" typeDecoder) - - -aliasTypeDecoder : Decode.Decoder AliasType -aliasTypeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Holey" -> - Decode.map Holey - (Decode.field "tipe" typeDecoder) - - "Filled" -> - Decode.map Filled - (Decode.field "tipe" typeDecoder) - - _ -> - Decode.fail ("Unknown AliasType's type: " ++ type_) - ) - - -unionEncoder : Union -> Encode.Value -unionEncoder (Union vars ctors numAlts opts) = - Encode.object - [ ( "type", Encode.string "Union" ) - , ( "vars", Encode.list Encode.string vars ) - , ( "ctors", Encode.list ctorEncoder ctors ) - , ( "numAlts", Encode.int numAlts ) - , ( "opts", ctorOptsEncoder opts ) - ] - - -unionDecoder : Decode.Decoder Union -unionDecoder = - Decode.map4 Union - (Decode.field "vars" (Decode.list Decode.string)) - (Decode.field "ctors" (Decode.list ctorDecoder)) - (Decode.field "numAlts" Decode.int) - (Decode.field "opts" ctorOptsDecoder) - - -ctorEncoder : Ctor -> Encode.Value -ctorEncoder (Ctor ctor index numArgs args) = - Encode.object - [ ( "type", Encode.string "Ctor" ) - , ( "ctor", Encode.string ctor ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "numArgs", Encode.int numArgs ) - , ( "args", Encode.list typeEncoder args ) - ] - - -ctorDecoder : Decode.Decoder Ctor -ctorDecoder = - Decode.map4 Ctor - (Decode.field "ctor" Decode.string) - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "numArgs" Decode.int) - (Decode.field "args" (Decode.list typeDecoder)) - - -ctorOptsEncoder : CtorOpts -> Encode.Value -ctorOptsEncoder ctorOpts = - case ctorOpts of - Normal -> - Encode.string "Normal" - - Enum -> - Encode.string "Enum" - - Unbox -> - Encode.string "Unbox" - - -ctorOptsDecoder : Decode.Decoder CtorOpts -ctorOptsDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "Normal" -> - Decode.succeed Normal - - "Enum" -> - Decode.succeed Enum - - "Unbox" -> - Decode.succeed Unbox - - _ -> - Decode.fail ("Unknown CtorOpts: " ++ str) - ) - - -fieldUpdateEncoder : FieldUpdate -> Encode.Value -fieldUpdateEncoder (FieldUpdate fieldRegion expr) = - Encode.object - [ ( "type", Encode.string "FieldUpdate" ) - , ( "fieldRegion", A.regionEncoder fieldRegion ) - , ( "expr", exprEncoder expr ) - ] - - -fieldUpdateDecoder : Decode.Decoder FieldUpdate -fieldUpdateDecoder = - Decode.map2 FieldUpdate - (Decode.field "fieldRegion" A.regionDecoder) - (Decode.field "expr" exprDecoder) - - -exprEncoder : Expr -> Encode.Value -exprEncoder = - A.locatedEncoder expr_Encoder - - -exprDecoder : Decode.Decoder Expr -exprDecoder = - A.locatedDecoder expr_Decoder - - -expr_Encoder : Expr_ -> Encode.Value -expr_Encoder expr_ = - case expr_ of - VarLocal name -> - Encode.object - [ ( "type", Encode.string "VarLocal" ) - , ( "name", Encode.string name ) - ] - - VarTopLevel home name -> - Encode.object - [ ( "type", Encode.string "VarTopLevel" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - ] - - VarKernel home name -> - Encode.object - [ ( "type", Encode.string "VarKernel" ) - , ( "home", Encode.string home ) - , ( "name", Encode.string name ) - ] - - VarForeign home name annotation -> - Encode.object - [ ( "type", Encode.string "VarForeign" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "annotation", annotationEncoder annotation ) - ] - - VarCtor opts home name index annotation -> - Encode.object - [ ( "type", Encode.string "VarCtor" ) - , ( "opts", ctorOptsEncoder opts ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "annotation", annotationEncoder annotation ) - ] - - VarDebug home name annotation -> - Encode.object - [ ( "type", Encode.string "VarDebug" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "annotation", annotationEncoder annotation ) - ] - - VarOperator op home name annotation -> - Encode.object - [ ( "type", Encode.string "VarOperator" ) - , ( "op", Encode.string op ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "annotation", annotationEncoder annotation ) - ] - - Chr chr -> - Encode.object - [ ( "type", Encode.string "Chr" ) - , ( "chr", Encode.string chr ) - ] - - Str str -> - Encode.object - [ ( "type", Encode.string "Str" ) - , ( "str", Encode.string str ) - ] - - Int int -> - Encode.object - [ ( "type", Encode.string "Int" ) - , ( "int", Encode.int int ) - ] - - Float float -> - Encode.object - [ ( "type", Encode.string "Float" ) - , ( "float", Encode.float float ) - ] - - List entries -> - Encode.object - [ ( "type", Encode.string "List" ) - , ( "entries", Encode.list exprEncoder entries ) - ] - - Negate expr -> - Encode.object - [ ( "type", Encode.string "Negate" ) - , ( "expr", exprEncoder expr ) - ] - - Binop op home name annotation left right -> - Encode.object - [ ( "type", Encode.string "Binop" ) - , ( "op", Encode.string op ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "annotation", annotationEncoder annotation ) - , ( "left", exprEncoder left ) - , ( "right", exprEncoder right ) - ] - - Lambda args body -> - Encode.object - [ ( "type", Encode.string "Lambda" ) - , ( "args", Encode.list patternEncoder args ) - , ( "body", exprEncoder body ) - ] - - Call func args -> - Encode.object - [ ( "type", Encode.string "Call" ) - , ( "func", exprEncoder func ) - , ( "args", Encode.list exprEncoder args ) - ] - - If branches finally -> - Encode.object - [ ( "type", Encode.string "If" ) - , ( "branches", Encode.list (E.jsonPair exprEncoder exprEncoder) branches ) - , ( "finally", exprEncoder finally ) - ] - - Let def body -> - Encode.object - [ ( "type", Encode.string "Let" ) - , ( "def", defEncoder def ) - , ( "body", exprEncoder body ) - ] - - LetRec defs body -> - Encode.object - [ ( "type", Encode.string "LetRec" ) - , ( "defs", Encode.list defEncoder defs ) - , ( "body", exprEncoder body ) - ] - - LetDestruct pattern expr body -> - Encode.object - [ ( "type", Encode.string "LetDestruct" ) - , ( "pattern", patternEncoder pattern ) - , ( "expr", exprEncoder expr ) - , ( "body", exprEncoder body ) - ] - - Case expr branches -> - Encode.object - [ ( "type", Encode.string "Case" ) - , ( "expr", exprEncoder expr ) - , ( "branches", Encode.list caseBranchEncoder branches ) - ] - - Accessor field -> - Encode.object - [ ( "type", Encode.string "Accessor" ) - , ( "field", Encode.string field ) - ] - - Access record field -> - Encode.object - [ ( "type", Encode.string "Access" ) - , ( "record", exprEncoder record ) - , ( "field", A.locatedEncoder Encode.string field ) - ] - - Update name record updates -> - Encode.object - [ ( "type", Encode.string "Update" ) - , ( "name", Encode.string name ) - , ( "record", exprEncoder record ) - , ( "updates", E.assocListDict compare Encode.string fieldUpdateEncoder updates ) - ] - - Record fields -> - Encode.object - [ ( "type", Encode.string "Record" ) - , ( "fields", E.assocListDict compare Encode.string exprEncoder fields ) - ] - - Unit -> - Encode.object - [ ( "type", Encode.string "Unit" ) - ] - - Tuple a b maybeC -> - Encode.object - [ ( "type", Encode.string "Tuple" ) - , ( "a", exprEncoder a ) - , ( "b", exprEncoder b ) - , ( "maybeC", E.maybe exprEncoder maybeC ) - ] - - Shader src types -> - Encode.object - [ ( "type", Encode.string "Shader" ) - , ( "src", Shader.sourceEncoder src ) - , ( "types", Shader.typesEncoder types ) - ] - - -expr_Decoder : Decode.Decoder Expr_ -expr_Decoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "VarLocal" -> - Decode.map VarLocal (Decode.field "name" Decode.string) - - "VarTopLevel" -> - Decode.map2 VarTopLevel - (Decode.field "moduleName" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - - "VarKernel" -> - Decode.map2 VarKernel - (Decode.field "home" Decode.string) - (Decode.field "name" Decode.string) - - "VarForeign" -> - Decode.map3 VarForeign - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "annotation" annotationDecoder) - - "VarCtor" -> - Decode.map5 VarCtor - (Decode.field "opts" ctorOptsDecoder) - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "annotation" annotationDecoder) - - "VarDebug" -> - Decode.map3 VarDebug - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "annotation" annotationDecoder) - - "VarOperator" -> - Decode.map4 VarOperator - (Decode.field "op" Decode.string) - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "annotation" annotationDecoder) - - "Chr" -> - Decode.map Chr (Decode.field "chr" Decode.string) - - "Str" -> - Decode.map Str (Decode.field "str" Decode.string) - - "Int" -> - Decode.map Int (Decode.field "int" Decode.int) - - "Float" -> - Decode.map Float (Decode.field "float" Decode.float) - - "List" -> - Decode.map List (Decode.field "entries" (Decode.list exprDecoder)) - - "Negate" -> - Decode.map Negate (Decode.field "expr" exprDecoder) - - "Binop" -> - Decode.map6 Binop - (Decode.field "op" Decode.string) - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "annotation" annotationDecoder) - (Decode.field "left" exprDecoder) - (Decode.field "right" exprDecoder) - - "Lambda" -> - Decode.map2 Lambda - (Decode.field "args" (Decode.list patternDecoder)) - (Decode.field "body" exprDecoder) - - "Call" -> - Decode.map2 Call - (Decode.field "func" exprDecoder) - (Decode.field "args" (Decode.list exprDecoder)) - - "If" -> - Decode.map2 If - (Decode.field "branches" (Decode.list (D.jsonPair exprDecoder exprDecoder))) - (Decode.field "finally" exprDecoder) - - "Let" -> - Decode.map2 Let - (Decode.field "def" defDecoder) - (Decode.field "body" exprDecoder) - - "LetRec" -> - Decode.map2 LetRec - (Decode.field "defs" (Decode.list defDecoder)) - (Decode.field "body" exprDecoder) - - "LetDestruct" -> - Decode.map3 LetDestruct - (Decode.field "pattern" patternDecoder) - (Decode.field "expr" exprDecoder) - (Decode.field "body" exprDecoder) - - "Case" -> - Decode.map2 Case - (Decode.field "expr" exprDecoder) - (Decode.field "branches" (Decode.list caseBranchDecoder)) - - "Accessor" -> - Decode.map Accessor (Decode.field "field" Decode.string) - - "Access" -> - Decode.map2 Access - (Decode.field "record" exprDecoder) - (Decode.field "field" (A.locatedDecoder Decode.string)) - - "Update" -> - Decode.map3 Update - (Decode.field "name" Decode.string) - (Decode.field "record" exprDecoder) - (Decode.field "updates" (D.assocListDict identity Decode.string fieldUpdateDecoder)) - - "Record" -> - Decode.map Record - (Decode.field "fields" (D.assocListDict identity Decode.string exprDecoder)) - - "Unit" -> - Decode.succeed Unit - - "Tuple" -> - Decode.map3 Tuple - (Decode.field "a" exprDecoder) - (Decode.field "b" exprDecoder) - (Decode.field "maybeC" (Decode.maybe exprDecoder)) - - "Shader" -> - Decode.map2 Shader - (Decode.field "src" Shader.sourceDecoder) - (Decode.field "types" Shader.typesDecoder) - - _ -> - Decode.fail ("Unknown Expr_'s type: " ++ type_) - ) +annotationCodec : Codec e Annotation +annotationCodec = + Serialize.customType + (\forallEncoder (Forall freeVars tipe) -> + forallEncoder freeVars tipe + ) + |> Serialize.variant2 Forall freeVarsCodec typeCodec + |> Serialize.finishCustomType + + +freeVarsCodec : Codec e FreeVars +freeVarsCodec = + S.assocListDict identity compare Serialize.string Serialize.unit + + +aliasCodec : Codec e Alias +aliasCodec = + Serialize.customType + (\aliasCodecEncoder (Alias vars tipe) -> + aliasCodecEncoder vars tipe + ) + |> Serialize.variant2 Alias (Serialize.list Serialize.string) typeCodec + |> Serialize.finishCustomType + + +typeCodec : Codec e Type +typeCodec = + Serialize.customType + (\tLambdaEncoder tVarEncoder tTypeEncoder tRecordEncoder tUnitEncoder tTupleEncoder tAliasEncoder value -> + case value of + TLambda a b -> + tLambdaEncoder a b + + TVar name -> + tVarEncoder name + + TType home name args -> + tTypeEncoder home name args + + TRecord fields ext -> + tRecordEncoder fields ext + + TUnit -> + tUnitEncoder + + TTuple a b maybeC -> + tTupleEncoder a b maybeC + + TAlias home name args tipe -> + tAliasEncoder home name args tipe + ) + |> Serialize.variant2 TLambda (Serialize.lazy (\() -> typeCodec)) (Serialize.lazy (\() -> typeCodec)) + |> Serialize.variant1 TVar Serialize.string + |> Serialize.variant3 TType ModuleName.canonicalCodec Serialize.string (Serialize.list (Serialize.lazy (\() -> typeCodec))) + |> Serialize.variant2 TRecord (S.assocListDict identity compare Serialize.string fieldTypeCodec) (Serialize.maybe Serialize.string) + |> Serialize.variant0 TUnit + |> Serialize.variant3 TTuple (Serialize.lazy (\() -> typeCodec)) (Serialize.lazy (\() -> typeCodec)) (Serialize.maybe (Serialize.lazy (\() -> typeCodec))) + |> Serialize.variant4 TAlias ModuleName.canonicalCodec Serialize.string (Serialize.list (Serialize.tuple Serialize.string (Serialize.lazy (\() -> typeCodec)))) aliasTypeCodec + |> Serialize.finishCustomType + + +fieldTypeCodec : Codec e FieldType +fieldTypeCodec = + Serialize.customType + (\fieldTypeCodecEncoder (FieldType index tipe) -> + fieldTypeCodecEncoder index tipe + ) + |> Serialize.variant2 FieldType Serialize.int (Serialize.lazy (\() -> typeCodec)) + |> Serialize.finishCustomType + + +aliasTypeCodec : Codec e AliasType +aliasTypeCodec = + Serialize.customType + (\holeyEncoder filledEncoder value -> + case value of + Holey tipe -> + holeyEncoder tipe + + Filled tipe -> + filledEncoder tipe + ) + |> Serialize.variant1 Holey (Serialize.lazy (\() -> typeCodec)) + |> Serialize.variant1 Filled (Serialize.lazy (\() -> typeCodec)) + |> Serialize.finishCustomType + + +unionCodec : Codec e Union +unionCodec = + Serialize.customType + (\unionCodecEncoder (Union vars ctors numAlts opts) -> + unionCodecEncoder vars ctors numAlts opts + ) + |> Serialize.variant4 Union + (Serialize.list Serialize.string) + (Serialize.list ctorCodec) + Serialize.int + ctorOptsCodec + |> Serialize.finishCustomType + + +ctorCodec : Codec e Ctor +ctorCodec = + Serialize.customType + (\ctorCodecEncoder (Ctor ctor index numArgs args) -> + ctorCodecEncoder ctor index numArgs args + ) + |> Serialize.variant4 Ctor + Serialize.string + Index.zeroBasedCodec + Serialize.int + (Serialize.list typeCodec) + |> Serialize.finishCustomType + + +ctorOptsCodec : Codec e CtorOpts +ctorOptsCodec = + Serialize.customType + (\normalEncoder enumEncoder unboxEncoder value -> + case value of + Normal -> + normalEncoder + + Enum -> + enumEncoder + + Unbox -> + unboxEncoder + ) + |> Serialize.variant0 Normal + |> Serialize.variant0 Enum + |> Serialize.variant0 Unbox + |> Serialize.finishCustomType -patternEncoder : Pattern -> Encode.Value -patternEncoder = - A.locatedEncoder pattern_Encoder - - -patternDecoder : Decode.Decoder Pattern -patternDecoder = - A.locatedDecoder pattern_Decoder - - -pattern_Encoder : Pattern_ -> Encode.Value -pattern_Encoder pattern_ = - case pattern_ of - PAnything -> - Encode.object - [ ( "type", Encode.string "PAnything" ) - ] - - PVar name -> - Encode.object - [ ( "type", Encode.string "PVar" ) - , ( "name", Encode.string name ) - ] - - PRecord names -> - Encode.object - [ ( "type", Encode.string "PRecord" ) - , ( "names", Encode.list Encode.string names ) - ] - - PAlias pattern name -> - Encode.object - [ ( "type", Encode.string "PAlias" ) - , ( "pattern", patternEncoder pattern ) - , ( "name", Encode.string name ) - ] - - PUnit -> - Encode.object - [ ( "type", Encode.string "PUnit" ) - ] - - PTuple pattern1 pattern2 maybePattern3 -> - Encode.object - [ ( "type", Encode.string "PTuple" ) - , ( "pattern1", patternEncoder pattern1 ) - , ( "pattern2", patternEncoder pattern2 ) - , ( "pattern3", E.maybe patternEncoder maybePattern3 ) - ] - - PList patterns -> - Encode.object - [ ( "type", Encode.string "PList" ) - , ( "patterns", Encode.list patternEncoder patterns ) - ] - - PCons pattern1 pattern2 -> - Encode.object - [ ( "type", Encode.string "PCons" ) - , ( "pattern1", patternEncoder pattern1 ) - , ( "pattern2", patternEncoder pattern2 ) - ] - - PBool union bool -> - Encode.object - [ ( "type", Encode.string "PBool" ) - , ( "union", unionEncoder union ) - , ( "bool", Encode.bool bool ) - ] - - PChr chr -> - Encode.object - [ ( "type", Encode.string "PChr" ) - , ( "chr", Encode.string chr ) - ] - - PStr str -> - Encode.object - [ ( "type", Encode.string "PStr" ) - , ( "str", Encode.string str ) - ] - - PInt int -> - Encode.object - [ ( "type", Encode.string "PInt" ) - , ( "int", Encode.int int ) - ] - - PCtor { home, type_, union, name, index, args } -> - Encode.object - [ ( "type", Encode.string "PCtor" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "type_", Encode.string type_ ) - , ( "union", unionEncoder union ) - , ( "name", Encode.string name ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "args", Encode.list patternCtorArgEncoder args ) - ] - - -pattern_Decoder : Decode.Decoder Pattern_ -pattern_Decoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\patternType -> - case patternType of - "PAnything" -> - Decode.succeed PAnything - - "PVar" -> - Decode.map PVar - (Decode.field "name" Decode.string) - - "PRecord" -> - Decode.map PRecord - (Decode.field "names" (Decode.list Decode.string)) - - "PAlias" -> - Decode.map2 PAlias - (Decode.field "pattern" patternDecoder) - (Decode.field "name" Decode.string) - - "PUnit" -> - Decode.succeed PUnit - - "PTuple" -> - Decode.map3 PTuple - (Decode.field "pattern1" patternDecoder) - (Decode.field "pattern2" patternDecoder) - (Decode.field "pattern3" (Decode.maybe patternDecoder)) - - "PList" -> - Decode.map PList - (Decode.field "patterns" (Decode.list patternDecoder)) - - "PCons" -> - Decode.map2 PCons - (Decode.field "pattern1" patternDecoder) - (Decode.field "pattern2" patternDecoder) - - "PBool" -> - Decode.map2 PBool - (Decode.field "union" unionDecoder) - (Decode.field "bool" Decode.bool) - - "PChr" -> - Decode.map PChr (Decode.field "chr" Decode.string) - - "PStr" -> - Decode.map PStr (Decode.field "str" Decode.string) - - "PInt" -> - Decode.map PInt (Decode.field "int" Decode.int) - - "PCtor" -> - Decode.map6 - (\home type_ union name index args -> - PCtor - { home = home - , type_ = type_ - , union = union - , name = name - , index = index - , args = args - } - ) - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "type_" Decode.string) - (Decode.field "union" unionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "args" (Decode.list patternCtorArgDecoder)) - - _ -> - Decode.fail ("Unknown Pattern_'s type: " ++ patternType) +fieldUpdateCodec : Codec e FieldUpdate +fieldUpdateCodec = + Serialize.customType + (\fieldUpdateCodecEncoder (FieldUpdate fieldRegion expr) -> + fieldUpdateCodecEncoder fieldRegion expr + ) + |> Serialize.variant2 FieldUpdate A.regionCodec exprCodec + |> Serialize.finishCustomType + + +exprCodec : Codec e Expr +exprCodec = + A.locatedCodec (Serialize.lazy (\() -> expr_Codec)) + + +expr_Codec : Codec e Expr_ +expr_Codec = + Serialize.customType + (\varLocalEncoder varTopLevelEncoder varKernelEncoder varForeignEncoder varCtorEncoder varDebugEncoder varOperatorEncoder chrEncoder strEncoder intEncoder floatEncoder listEncoder negateEncoder binopEncoder lambdaEncoder callEncoder ifEncoder letEncoder letRecEncoder letDestructEncoder caseEncoder accessorEncoder accessEncoder updateEncoder recordEncoder unitEncoder tupleEncoder shaderEncoder value -> + case value of + VarLocal name -> + varLocalEncoder name + + VarTopLevel home name -> + varTopLevelEncoder home name + + VarKernel home name -> + varKernelEncoder home name + + VarForeign home name annotation -> + varForeignEncoder home name annotation + + VarCtor opts home name index annotation -> + varCtorEncoder opts home name index annotation + + VarDebug home name annotation -> + varDebugEncoder home name annotation + + VarOperator op home name annotation -> + varOperatorEncoder op home name annotation + + Chr chr -> + chrEncoder chr + + Str str -> + strEncoder str + + Int int -> + intEncoder int + + Float float -> + floatEncoder float + + List entries -> + listEncoder entries + + Negate expr -> + negateEncoder expr + + Binop op home name annotation left right -> + binopEncoder op home name annotation left right + + Lambda args body -> + lambdaEncoder args body + + Call func args -> + callEncoder func args + + If branches finally -> + ifEncoder branches finally + + Let def body -> + letEncoder def body + + LetRec defs body -> + letRecEncoder defs body + + LetDestruct pattern expr body -> + letDestructEncoder pattern expr body + + Case expr branches -> + caseEncoder expr branches + + Accessor field -> + accessorEncoder field + + Access record field -> + accessEncoder record field + + Update name record updates -> + updateEncoder name record updates + + Record fields -> + recordEncoder fields + + Unit -> + unitEncoder + + Tuple a b maybeC -> + tupleEncoder a b maybeC + + Shader src types -> + shaderEncoder src types + ) + |> Serialize.variant1 VarLocal Serialize.string + |> Serialize.variant2 VarTopLevel ModuleName.canonicalCodec Serialize.string + |> Serialize.variant2 VarKernel Serialize.string Serialize.string + |> Serialize.variant3 VarForeign ModuleName.canonicalCodec Serialize.string annotationCodec + |> Serialize.variant5 + VarCtor + ctorOptsCodec + ModuleName.canonicalCodec + Serialize.string + Index.zeroBasedCodec + annotationCodec + |> Serialize.variant3 VarDebug ModuleName.canonicalCodec Serialize.string annotationCodec + |> Serialize.variant4 VarOperator Serialize.string ModuleName.canonicalCodec Serialize.string annotationCodec + |> Serialize.variant1 Chr Serialize.string + |> Serialize.variant1 Str Serialize.string + |> Serialize.variant1 Int Serialize.int + |> Serialize.variant1 Float Serialize.float + |> Serialize.variant1 List (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + |> Serialize.variant1 Negate (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant6 + Binop + Serialize.string + ModuleName.canonicalCodec + Serialize.string + annotationCodec + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 + Lambda + (Serialize.list (A.locatedCodec pattern_Codec)) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 + Call + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + |> Serialize.variant2 + If + (Serialize.list + (Serialize.tuple + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + ) ) - - -patternCtorArgEncoder : PatternCtorArg -> Encode.Value -patternCtorArgEncoder (PatternCtorArg index srcType pattern) = - Encode.object - [ ( "type", Encode.string "PatternCtorArg" ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "srcType", typeEncoder srcType ) - , ( "pattern", patternEncoder pattern ) - ] - - -patternCtorArgDecoder : Decode.Decoder PatternCtorArg -patternCtorArgDecoder = - Decode.map3 PatternCtorArg - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "srcType" typeDecoder) - (Decode.field "pattern" patternDecoder) - - -defEncoder : Def -> Encode.Value -defEncoder def = - case def of - Def name args expr -> - Encode.object - [ ( "type", Encode.string "Def" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "args", Encode.list patternEncoder args ) - , ( "expr", exprEncoder expr ) - ] - - TypedDef name freeVars typedArgs expr srcResultType -> - Encode.object - [ ( "type", Encode.string "TypedDef" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "freeVars", freeVarsEncoder freeVars ) - , ( "typedArgs", Encode.list (E.jsonPair patternEncoder typeEncoder) typedArgs ) - , ( "expr", exprEncoder expr ) - , ( "srcResultType", typeEncoder srcResultType ) - ] - - -defDecoder : Decode.Decoder Def -defDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Def" -> - Decode.map3 Def - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "args" (Decode.list patternDecoder)) - (Decode.field "expr" exprDecoder) - - "TypedDef" -> - Decode.map5 TypedDef - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "freeVars" freeVarsDecoder) - (Decode.field "typedArgs" (Decode.list (D.jsonPair patternDecoder typeDecoder))) - (Decode.field "expr" exprDecoder) - (Decode.field "srcResultType" typeDecoder) - - _ -> - Decode.fail ("Unknown Def's type: " ++ type_) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 Let defCodec exprCodec + |> Serialize.variant2 LetRec (Serialize.list defCodec) (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant3 + LetDestruct + (A.locatedCodec pattern_Codec) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 + Case + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (Serialize.list caseBranchCodec) + |> Serialize.variant1 Accessor Serialize.string + |> Serialize.variant2 + Access + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (A.locatedCodec Serialize.string) + |> Serialize.variant3 + Update + Serialize.string + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (S.assocListDict identity compare Serialize.string fieldUpdateCodec) + |> Serialize.variant1 Record (S.assocListDict identity compare Serialize.string (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + |> Serialize.variant0 Unit + |> Serialize.variant3 + Tuple + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (Serialize.maybe (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + |> Serialize.variant2 Shader Shader.sourceCodec Shader.typesCodec + |> Serialize.finishCustomType + + +patternCodec : Codec e Pattern +patternCodec = + A.locatedCodec (Serialize.lazy (\() -> pattern_Codec)) + + +pattern_Codec : Codec e Pattern_ +pattern_Codec = + Serialize.customType + (\pAnythingEncoder pVarEncoder pRecordEncoder pAliasEncoder pUnitEncoder pTupleEncoder pListEncoder pConsEncoder pBoolEncoder pChrEncoder pStrEncoder pIntEncoder pCtorEncoder value -> + case value of + PAnything -> + pAnythingEncoder + + PVar name -> + pVarEncoder name + + PRecord names -> + pRecordEncoder names + + PAlias pattern name -> + pAliasEncoder pattern name + + PUnit -> + pUnitEncoder + + PTuple pattern1 pattern2 maybePattern3 -> + pTupleEncoder pattern1 pattern2 maybePattern3 + + PList patterns -> + pListEncoder patterns + + PCons pattern1 pattern2 -> + pConsEncoder pattern1 pattern2 + + PBool union bool -> + pBoolEncoder union bool + + PChr chr -> + pChrEncoder chr + + PStr str -> + pStrEncoder str + + PInt int -> + pIntEncoder int + + PCtor ctor -> + pCtorEncoder ctor + ) + |> Serialize.variant0 PAnything + |> Serialize.variant1 PVar Serialize.string + |> Serialize.variant1 PRecord (Serialize.list Serialize.string) + |> Serialize.variant2 PAlias patternCodec Serialize.string + |> Serialize.variant0 PUnit + |> Serialize.variant3 PTuple patternCodec patternCodec (Serialize.maybe patternCodec) + |> Serialize.variant1 PList (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec)))) + |> Serialize.variant2 PCons patternCodec patternCodec + |> Serialize.variant2 PBool unionCodec Serialize.bool + |> Serialize.variant1 PChr Serialize.string + |> Serialize.variant1 PStr Serialize.string + |> Serialize.variant1 PInt Serialize.int + |> Serialize.variant1 + PCtor + (Serialize.record + (\home type_ union name index args -> + { home = home, type_ = type_, union = union, name = name, index = index, args = args } + ) + |> Serialize.field .home ModuleName.canonicalCodec + |> Serialize.field .type_ Serialize.string + |> Serialize.field .union unionCodec + |> Serialize.field .name Serialize.string + |> Serialize.field .index Index.zeroBasedCodec + |> Serialize.field .args (Serialize.list patternCtorArgCodec) + |> Serialize.finishRecord ) - - -caseBranchEncoder : CaseBranch -> Encode.Value -caseBranchEncoder (CaseBranch pattern expr) = - Encode.object - [ ( "type", Encode.string "CaseBranch" ) - , ( "pattern", patternEncoder pattern ) - , ( "expr", exprEncoder expr ) - ] - - -caseBranchDecoder : Decode.Decoder CaseBranch -caseBranchDecoder = - Decode.map2 CaseBranch - (Decode.field "pattern" patternDecoder) - (Decode.field "expr" exprDecoder) + |> Serialize.finishCustomType + + +patternCtorArgCodec : Codec e PatternCtorArg +patternCtorArgCodec = + Serialize.customType + (\patternCtorArgCodecEncoder (PatternCtorArg index srcType pattern) -> + patternCtorArgCodecEncoder index srcType pattern + ) + |> Serialize.variant3 PatternCtorArg Index.zeroBasedCodec typeCodec patternCodec + |> Serialize.finishCustomType + + +defCodec : Codec e Def +defCodec = + Serialize.customType + (\defCodecEncoder typedDefEncoder def -> + case def of + Def name args expr -> + defCodecEncoder name args expr + + TypedDef name freeVars typedArgs expr srcResultType -> + typedDefEncoder name freeVars typedArgs expr srcResultType + ) + |> Serialize.variant3 Def (A.locatedCodec Serialize.string) (Serialize.list patternCodec) exprCodec + |> Serialize.variant5 TypedDef (A.locatedCodec Serialize.string) freeVarsCodec (Serialize.list (Serialize.tuple patternCodec typeCodec)) exprCodec typeCodec + |> Serialize.finishCustomType + + +caseBranchCodec : Codec e CaseBranch +caseBranchCodec = + Serialize.customType + (\caseBranchCodecEncoder (CaseBranch pattern expr) -> + caseBranchCodecEncoder pattern expr + ) + |> Serialize.variant2 CaseBranch patternCodec exprCodec + |> Serialize.finishCustomType diff --git a/src/Compiler/AST/Optimized.elm b/src/Compiler/AST/Optimized.elm index 8ffa1669b..570cb9a24 100644 --- a/src/Compiler/AST/Optimized.elm +++ b/src/Compiler/AST/Optimized.elm @@ -16,10 +16,8 @@ module Compiler.AST.Optimized exposing , addLocalGraph , compareGlobal , empty - , globalGraphDecoder - , globalGraphEncoder - , localGraphDecoder - , localGraphEncoder + , globalGraphCodec + , localGraphCodec , toComparableGlobal , toKernelGlobal ) @@ -31,14 +29,12 @@ import Compiler.Data.Name as Name exposing (Name) import Compiler.Elm.Kernel as K import Compiler.Elm.ModuleName as ModuleName import Compiler.Elm.Package as Pkg -import Compiler.Json.Decode as D -import Compiler.Json.Encode as E import Compiler.Optimize.DecisionTree as DT import Compiler.Reporting.Annotation as A +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) import Data.Set as EverySet exposing (EverySet) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.TypeCheck.IO as IO @@ -250,773 +246,324 @@ toKernelGlobal shortName = -- ENCODERS and DECODERS -globalGraphEncoder : GlobalGraph -> Encode.Value -globalGraphEncoder (GlobalGraph nodes fields) = - Encode.object - [ ( "type", Encode.string "GlobalGraph" ) - , ( "nodes", E.assocListDict compareGlobal globalEncoder nodeEncoder nodes ) - , ( "fields", E.assocListDict compare Encode.string Encode.int fields ) - ] - - -globalGraphDecoder : Decode.Decoder GlobalGraph -globalGraphDecoder = - Decode.map2 GlobalGraph - (Decode.field "nodes" (D.assocListDict toComparableGlobal globalDecoder nodeDecoder)) - (Decode.field "fields" (D.assocListDict identity Decode.string Decode.int)) - - -localGraphEncoder : LocalGraph -> Encode.Value -localGraphEncoder (LocalGraph main nodes fields) = - Encode.object - [ ( "type", Encode.string "LocalGraph" ) - , ( "main", E.maybe mainEncoder main ) - , ( "nodes", E.assocListDict compareGlobal globalEncoder nodeEncoder nodes ) - , ( "fields", E.assocListDict compare Encode.string Encode.int fields ) - ] - - -localGraphDecoder : Decode.Decoder LocalGraph -localGraphDecoder = - Decode.map3 LocalGraph - (Decode.field "main" (Decode.maybe mainDecoder)) - (Decode.field "nodes" (D.assocListDict toComparableGlobal globalDecoder nodeDecoder)) - (Decode.field "fields" (D.assocListDict identity Decode.string Decode.int)) - - -mainEncoder : Main -> Encode.Value -mainEncoder main_ = - case main_ of - Static -> - Encode.object - [ ( "type", Encode.string "Static" ) - ] - - Dynamic msgType decoder -> - Encode.object - [ ( "type", Encode.string "Dynamic" ) - , ( "msgType", Can.typeEncoder msgType ) - , ( "decoder", exprEncoder decoder ) - ] - - -mainDecoder : Decode.Decoder Main -mainDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Static" -> - Decode.succeed Static - - "Dynamic" -> - Decode.map2 Dynamic - (Decode.field "msgType" Can.typeDecoder) - (Decode.field "decoder" exprDecoder) - - _ -> - Decode.fail ("Unknown Main's type: " ++ type_) - ) - - -globalEncoder : Global -> Encode.Value -globalEncoder (Global home name) = - Encode.object - [ ( "type", Encode.string "Global" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - ] - - -globalDecoder : Decode.Decoder Global -globalDecoder = - Decode.map2 Global - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - - -nodeEncoder : Node -> Encode.Value -nodeEncoder node = - case node of - Define expr deps -> - Encode.object - [ ( "type", Encode.string "Define" ) - , ( "expr", exprEncoder expr ) - , ( "deps", E.everySet compareGlobal globalEncoder deps ) - ] - - DefineTailFunc argNames body deps -> - Encode.object - [ ( "type", Encode.string "DefineTailFunc" ) - , ( "argNames", Encode.list Encode.string argNames ) - , ( "body", exprEncoder body ) - , ( "deps", E.everySet compareGlobal globalEncoder deps ) - ] - - Ctor index arity -> - Encode.object - [ ( "type", Encode.string "Ctor" ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "arity", Encode.int arity ) - ] - - Enum index -> - Encode.object - [ ( "type", Encode.string "Enum" ) - , ( "index", Index.zeroBasedEncoder index ) - ] - - Box -> - Encode.object - [ ( "type", Encode.string "Box" ) - ] - - Link linkedGlobal -> - Encode.object - [ ( "type", Encode.string "Link" ) - , ( "linkedGlobal", globalEncoder linkedGlobal ) - ] - - Cycle names values functions deps -> - Encode.object - [ ( "type", Encode.string "Cycle" ) - , ( "names", Encode.list Encode.string names ) - , ( "values", Encode.list (E.jsonPair Encode.string exprEncoder) values ) - , ( "functions", Encode.list defEncoder functions ) - , ( "deps", E.everySet compareGlobal globalEncoder deps ) - ] - - Manager effectsType -> - Encode.object - [ ( "type", Encode.string "Manager" ) - , ( "effectsType", effectsTypeEncoder effectsType ) - ] - - Kernel chunks deps -> - Encode.object - [ ( "type", Encode.string "Kernel" ) - , ( "chunks", Encode.list K.chunkEncoder chunks ) - , ( "deps", E.everySet compareGlobal globalEncoder deps ) - ] - - PortIncoming decoder deps -> - Encode.object - [ ( "type", Encode.string "PortIncoming" ) - , ( "decoder", exprEncoder decoder ) - , ( "deps", E.everySet compareGlobal globalEncoder deps ) - ] - - PortOutgoing encoder deps -> - Encode.object - [ ( "type", Encode.string "PortOutgoing" ) - , ( "encoder", exprEncoder encoder ) - , ( "deps", E.everySet compareGlobal globalEncoder deps ) - ] - - -nodeDecoder : Decode.Decoder Node -nodeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Define" -> - Decode.map2 Define - (Decode.field "expr" exprDecoder) - (Decode.field "deps" (D.everySet toComparableGlobal globalDecoder)) - - "DefineTailFunc" -> - Decode.map3 DefineTailFunc - (Decode.field "argNames" (Decode.list Decode.string)) - (Decode.field "body" exprDecoder) - (Decode.field "deps" (D.everySet toComparableGlobal globalDecoder)) - - "Ctor" -> - Decode.map2 Ctor - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "arity" Decode.int) - - "Enum" -> - Decode.map Enum - (Decode.field "index" Index.zeroBasedDecoder) - - "Box" -> - Decode.succeed Box - - "Link" -> - Decode.map Link (Decode.field "linkedGlobal" globalDecoder) - - "Cycle" -> - Decode.map4 Cycle - (Decode.field "names" (Decode.list Decode.string)) - (Decode.field "values" (Decode.list (D.jsonPair Decode.string exprDecoder))) - (Decode.field "functions" (Decode.list defDecoder)) - (Decode.field "deps" (D.everySet toComparableGlobal globalDecoder)) - - "Manager" -> - Decode.map Manager (Decode.field "effectsType" effectsTypeDecoder) - - "Kernel" -> - Decode.map2 Kernel - (Decode.field "chunks" (Decode.list K.chunkDecoder)) - (Decode.field "deps" (D.everySet toComparableGlobal globalDecoder)) - - "PortIncoming" -> - Decode.map2 PortIncoming - (Decode.field "decoder" exprDecoder) - (Decode.field "deps" (D.everySet toComparableGlobal globalDecoder)) - - "PortOutgoing" -> - Decode.map2 PortOutgoing - (Decode.field "encoder" exprDecoder) - (Decode.field "deps" (D.everySet toComparableGlobal globalDecoder)) - - _ -> - Decode.fail ("Unknown Node's type: " ++ type_) - ) - - -exprEncoder : Expr -> Encode.Value -exprEncoder expr = - case expr of - Bool value -> - Encode.object - [ ( "type", Encode.string "Bool" ) - , ( "value", Encode.bool value ) - ] - - Chr value -> - Encode.object - [ ( "type", Encode.string "Chr" ) - , ( "value", Encode.string value ) - ] - - Str value -> - Encode.object - [ ( "type", Encode.string "Str" ) - , ( "value", Encode.string value ) - ] - - Int value -> - Encode.object - [ ( "type", Encode.string "Int" ) - , ( "value", Encode.int value ) - ] - - Float value -> - Encode.object - [ ( "type", Encode.string "Float" ) - , ( "value", Encode.float value ) - ] - - VarLocal value -> - Encode.object - [ ( "type", Encode.string "VarLocal" ) - , ( "value", Encode.string value ) - ] - - VarGlobal value -> - Encode.object - [ ( "type", Encode.string "VarGlobal" ) - , ( "value", globalEncoder value ) - ] - - VarEnum global index -> - Encode.object - [ ( "type", Encode.string "VarEnum" ) - , ( "global", globalEncoder global ) - , ( "index", Index.zeroBasedEncoder index ) - ] - - VarBox value -> - Encode.object - [ ( "type", Encode.string "VarBox" ) - , ( "value", globalEncoder value ) - ] - - VarCycle home name -> - Encode.object - [ ( "type", Encode.string "VarCycle" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - ] - - VarDebug name home region unhandledValueName -> - Encode.object - [ ( "type", Encode.string "VarDebug" ) - , ( "name", Encode.string name ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "region", A.regionEncoder region ) - , ( "unhandledValueName", E.maybe Encode.string unhandledValueName ) - ] - - VarKernel home name -> - Encode.object - [ ( "type", Encode.string "VarKernel" ) - , ( "home", Encode.string home ) - , ( "name", Encode.string name ) - ] - - List value -> - Encode.object - [ ( "type", Encode.string "List" ) - , ( "value", Encode.list exprEncoder value ) - ] - - Function args body -> - Encode.object - [ ( "type", Encode.string "Function" ) - , ( "args", Encode.list Encode.string args ) - , ( "body", exprEncoder body ) - ] - - Call func args -> - Encode.object - [ ( "type", Encode.string "Call" ) - , ( "func", exprEncoder func ) - , ( "args", Encode.list exprEncoder args ) - ] - - TailCall name args -> - Encode.object - [ ( "type", Encode.string "TailCall" ) - , ( "name", Encode.string name ) - , ( "args", Encode.list (E.jsonPair Encode.string exprEncoder) args ) - ] - - If branches final -> - Encode.object - [ ( "type", Encode.string "If" ) - , ( "branches", Encode.list (E.jsonPair exprEncoder exprEncoder) branches ) - , ( "final", exprEncoder final ) - ] - - Let def body -> - Encode.object - [ ( "type", Encode.string "Let" ) - , ( "def", defEncoder def ) - , ( "body", exprEncoder body ) - ] - - Destruct destructor body -> - Encode.object - [ ( "type", Encode.string "Destruct" ) - , ( "destructor", destructorEncoder destructor ) - , ( "body", exprEncoder body ) - ] - - Case label root decider jumps -> - Encode.object - [ ( "type", Encode.string "Case" ) - , ( "label", Encode.string label ) - , ( "root", Encode.string root ) - , ( "decider", deciderEncoder choiceEncoder decider ) - , ( "jumps", Encode.list (E.jsonPair Encode.int exprEncoder) jumps ) - ] - - Accessor field -> - Encode.object - [ ( "type", Encode.string "Accessor" ) - , ( "field", Encode.string field ) - ] - - Access record field -> - Encode.object - [ ( "type", Encode.string "Access" ) - , ( "record", exprEncoder record ) - , ( "field", Encode.string field ) - ] - - Update record fields -> - Encode.object - [ ( "type", Encode.string "Update" ) - , ( "record", exprEncoder record ) - , ( "fields", E.assocListDict compare Encode.string exprEncoder fields ) - ] - - Record value -> - Encode.object - [ ( "type", Encode.string "Record" ) - , ( "value", E.assocListDict compare Encode.string exprEncoder value ) - ] - - Unit -> - Encode.object - [ ( "type", Encode.string "Unit" ) - ] - - Tuple a b maybeC -> - Encode.object - [ ( "type", Encode.string "Tuple" ) - , ( "a", exprEncoder a ) - , ( "b", exprEncoder b ) - , ( "maybeC", E.maybe exprEncoder maybeC ) - ] - - Shader src attributes uniforms -> - Encode.object - [ ( "type", Encode.string "Shader" ) - , ( "src", Shader.sourceEncoder src ) - , ( "attributes", E.everySet compare Encode.string attributes ) - , ( "uniforms", E.everySet compare Encode.string uniforms ) - ] - - -exprDecoder : Decode.Decoder Expr -exprDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Bool" -> - Decode.map Bool (Decode.field "value" Decode.bool) - - "Chr" -> - Decode.map Chr (Decode.field "value" Decode.string) - - "Str" -> - Decode.map Str (Decode.field "value" Decode.string) - - "Int" -> - Decode.map Int (Decode.field "value" Decode.int) - - "Float" -> - Decode.map Float (Decode.field "value" Decode.float) - - "VarLocal" -> - Decode.map VarLocal (Decode.field "value" Decode.string) - - "VarGlobal" -> - Decode.map VarGlobal (Decode.field "value" globalDecoder) - - "VarEnum" -> - Decode.map2 VarEnum - (Decode.field "global" globalDecoder) - (Decode.field "index" Index.zeroBasedDecoder) - - "VarBox" -> - Decode.map VarBox (Decode.field "value" globalDecoder) - - "VarCycle" -> - Decode.map2 VarCycle - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - - "VarDebug" -> - Decode.map4 VarDebug - (Decode.field "name" Decode.string) - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "region" A.regionDecoder) - (Decode.field "unhandledValueName" (Decode.maybe Decode.string)) - - "VarKernel" -> - Decode.map2 VarKernel - (Decode.field "home" Decode.string) - (Decode.field "name" Decode.string) - - "List" -> - Decode.map List (Decode.field "value" (Decode.list exprDecoder)) - - "Function" -> - Decode.map2 Function - (Decode.field "args" (Decode.list Decode.string)) - (Decode.field "body" exprDecoder) - - "Call" -> - Decode.map2 Call - (Decode.field "func" exprDecoder) - (Decode.field "args" (Decode.list exprDecoder)) - - "TailCall" -> - Decode.map2 TailCall - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list (D.jsonPair Decode.string exprDecoder))) - - "If" -> - Decode.map2 If - (Decode.field "branches" (Decode.list (D.jsonPair exprDecoder exprDecoder))) - (Decode.field "final" exprDecoder) - - "Let" -> - Decode.map2 Let - (Decode.field "def" defDecoder) - (Decode.field "body" exprDecoder) - - "Destruct" -> - Decode.map2 Destruct - (Decode.field "destructor" destructorDecoder) - (Decode.field "body" exprDecoder) - - "Case" -> - Decode.map4 Case - (Decode.field "label" Decode.string) - (Decode.field "root" Decode.string) - (Decode.field "decider" (deciderDecoder choiceDecoder)) - (Decode.field "jumps" (Decode.list (D.jsonPair Decode.int exprDecoder))) - - "Accessor" -> - Decode.map Accessor (Decode.field "field" Decode.string) - - "Access" -> - Decode.map2 Access - (Decode.field "record" exprDecoder) - (Decode.field "field" Decode.string) - - "Update" -> - Decode.map2 Update - (Decode.field "record" exprDecoder) - (Decode.field "fields" (D.assocListDict identity Decode.string exprDecoder)) - - "Record" -> - Decode.map Record (Decode.field "value" (D.assocListDict identity Decode.string exprDecoder)) - - "Unit" -> - Decode.succeed Unit - - "Tuple" -> - Decode.map3 Tuple - (Decode.field "a" exprDecoder) - (Decode.field "b" exprDecoder) - (Decode.field "maybeC" (Decode.maybe exprDecoder)) - - "Shader" -> - Decode.map3 Shader - (Decode.field "src" Shader.sourceDecoder) - (Decode.field "attributes" (D.everySet identity Decode.string)) - (Decode.field "uniforms" (D.everySet identity Decode.string)) - - _ -> - Decode.fail ("Unknown Expr's type: " ++ type_) - ) - - -defEncoder : Def -> Encode.Value -defEncoder def = - case def of - Def name expr -> - Encode.object - [ ( "type", Encode.string "Def" ) - , ( "name", Encode.string name ) - , ( "expr", exprEncoder expr ) - ] - - TailDef name args expr -> - Encode.object - [ ( "type", Encode.string "TailDef" ) - , ( "name", Encode.string name ) - , ( "args", Encode.list Encode.string args ) - , ( "expr", exprEncoder expr ) - ] - - -defDecoder : Decode.Decoder Def -defDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Def" -> - Decode.map2 Def - (Decode.field "name" Decode.string) - (Decode.field "expr" exprDecoder) - - "TailDef" -> - Decode.map3 TailDef - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list Decode.string)) - (Decode.field "expr" exprDecoder) - - _ -> - Decode.fail ("Unknown Def's type: " ++ type_) - ) - - -destructorEncoder : Destructor -> Encode.Value -destructorEncoder (Destructor name path) = - Encode.object - [ ( "type", Encode.string "Destructor" ) - , ( "name", Encode.string name ) - , ( "path", pathEncoder path ) - ] - - -destructorDecoder : Decode.Decoder Destructor -destructorDecoder = - Decode.map2 Destructor - (Decode.field "name" Decode.string) - (Decode.field "path" pathDecoder) - - -deciderEncoder : (a -> Encode.Value) -> Decider a -> Encode.Value -deciderEncoder encoder decider = - case decider of - Leaf value -> - Encode.object - [ ( "type", Encode.string "Leaf" ) - , ( "value", encoder value ) - ] - - Chain testChain success failure -> - Encode.object - [ ( "type", Encode.string "Chain" ) - , ( "testChain", Encode.list (E.jsonPair DT.pathEncoder DT.testEncoder) testChain ) - , ( "success", deciderEncoder encoder success ) - , ( "failure", deciderEncoder encoder failure ) - ] - - FanOut path edges fallback -> - Encode.object - [ ( "type", Encode.string "FanOut" ) - , ( "path", DT.pathEncoder path ) - , ( "edges", Encode.list (E.jsonPair DT.testEncoder (deciderEncoder encoder)) edges ) - , ( "fallback", deciderEncoder encoder fallback ) - ] - - -deciderDecoder : Decode.Decoder a -> Decode.Decoder (Decider a) -deciderDecoder decoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Leaf" -> - Decode.map Leaf (Decode.field "value" decoder) - - "Chain" -> - Decode.map3 Chain - (Decode.field "testChain" (Decode.list (D.jsonPair DT.pathDecoder DT.testDecoder))) - (Decode.field "success" (deciderDecoder decoder)) - (Decode.field "failure" (deciderDecoder decoder)) - - "FanOut" -> - Decode.map3 FanOut - (Decode.field "path" DT.pathDecoder) - (Decode.field "edges" (Decode.list (D.jsonPair DT.testDecoder (deciderDecoder decoder)))) - (Decode.field "fallback" (deciderDecoder decoder)) - - _ -> - Decode.fail ("Unknown Decider's type: " ++ type_) - ) - - -choiceEncoder : Choice -> Encode.Value -choiceEncoder choice = - case choice of - Inline value -> - Encode.object - [ ( "type", Encode.string "Inline" ) - , ( "value", exprEncoder value ) - ] - - Jump value -> - Encode.object - [ ( "type", Encode.string "Jump" ) - , ( "value", Encode.int value ) - ] - - -choiceDecoder : Decode.Decoder Choice -choiceDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Inline" -> - Decode.map Inline (Decode.field "value" exprDecoder) - - "Jump" -> - Decode.map Jump (Decode.field "value" Decode.int) - - _ -> - Decode.fail ("Unknown Choice's type: " ++ type_) - ) - - -pathEncoder : Path -> Encode.Value -pathEncoder path = - case path of - Index index subPath -> - Encode.object - [ ( "type", Encode.string "Index" ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "subPath", pathEncoder subPath ) - ] - - Field field subPath -> - Encode.object - [ ( "type", Encode.string "Field" ) - , ( "field", Encode.string field ) - , ( "subPath", pathEncoder subPath ) - ] - - Unbox subPath -> - Encode.object - [ ( "type", Encode.string "Unbox" ) - , ( "subPath", pathEncoder subPath ) - ] - - Root name -> - Encode.object - [ ( "type", Encode.string "Root" ) - , ( "name", Encode.string name ) - ] - - -pathDecoder : Decode.Decoder Path -pathDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Index" -> - Decode.map2 Index - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "subPath" pathDecoder) - - "Field" -> - Decode.map2 Field - (Decode.field "field" Decode.string) - (Decode.field "subPath" pathDecoder) - - "Unbox" -> - Decode.map Unbox (Decode.field "subPath" pathDecoder) - - "Root" -> - Decode.map Root (Decode.field "name" Decode.string) - - _ -> - Decode.fail ("Unknown Path's type: " ++ type_) - ) - - -effectsTypeEncoder : EffectsType -> Encode.Value -effectsTypeEncoder effectsType = - case effectsType of - Cmd -> - Encode.string "Cmd" - - Sub -> - Encode.string "Sub" - - Fx -> - Encode.string "Fx" - - -effectsTypeDecoder : Decode.Decoder EffectsType -effectsTypeDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "Cmd" -> - Decode.succeed Cmd - - "Sub" -> - Decode.succeed Sub - - "Fx" -> - Decode.succeed Fx - - _ -> - Decode.fail ("Unknown EffectsType: " ++ str) - ) +globalGraphCodec : Codec e GlobalGraph +globalGraphCodec = + Serialize.customType + (\globalGraphCodecEncoder (GlobalGraph nodes fields) -> + globalGraphCodecEncoder nodes fields + ) + |> Serialize.variant2 GlobalGraph (S.assocListDict toComparableGlobal compareGlobal globalCodec nodeCodec) (S.assocListDict identity compare Serialize.string Serialize.int) + |> Serialize.finishCustomType + + +localGraphCodec : Codec e LocalGraph +localGraphCodec = + Serialize.customType + (\localGraphCodecEncoder (LocalGraph main nodes fields) -> + localGraphCodecEncoder main nodes fields + ) + |> Serialize.variant3 LocalGraph + (Serialize.maybe mainCodec) + (S.assocListDict toComparableGlobal compareGlobal globalCodec nodeCodec) + (S.assocListDict identity compare Serialize.string Serialize.int) + |> Serialize.finishCustomType + + +mainCodec : Codec c Main +mainCodec = + Serialize.customType + (\staticEncoder dynamicEncoder value -> + case value of + Static -> + staticEncoder + + Dynamic msgType decoder -> + dynamicEncoder msgType decoder + ) + |> Serialize.variant0 Static + |> Serialize.variant2 Dynamic Can.typeCodec exprCodec + |> Serialize.finishCustomType + + +globalCodec : Codec e Global +globalCodec = + Serialize.customType + (\globalCodecEncoder (Global home name) -> + globalCodecEncoder home name + ) + |> Serialize.variant2 Global ModuleName.canonicalCodec Serialize.string + |> Serialize.finishCustomType + + +nodeCodec : Codec e Node +nodeCodec = + Serialize.customType + (\defineEncoder defineTailFuncEncoder ctorEncoder enumEncoder boxEncoder linkEncoder cycleEncoder managerEncoder kernelEncoder portIncomingEncoder portOutgoingEncoder node -> + case node of + Define expr deps -> + defineEncoder expr deps + + DefineTailFunc argNames body deps -> + defineTailFuncEncoder argNames body deps + + Ctor index arity -> + ctorEncoder index arity + + Enum index -> + enumEncoder index + + Box -> + boxEncoder + + Link linkedGlobal -> + linkEncoder linkedGlobal + + Cycle names values functions deps -> + cycleEncoder names values functions deps + + Manager effectsType -> + managerEncoder effectsType + + Kernel chunks deps -> + kernelEncoder chunks deps + + PortIncoming decoder deps -> + portIncomingEncoder decoder deps + + PortOutgoing encoder deps -> + portOutgoingEncoder encoder deps + ) + |> Serialize.variant2 Define exprCodec (S.everySet toComparableGlobal compareGlobal globalCodec) + |> Serialize.variant3 DefineTailFunc (Serialize.list Serialize.string) exprCodec (S.everySet toComparableGlobal compareGlobal globalCodec) + |> Serialize.variant2 Ctor Index.zeroBasedCodec Serialize.int + |> Serialize.variant1 Enum Index.zeroBasedCodec + |> Serialize.variant0 Box + |> Serialize.variant1 Link globalCodec + |> Serialize.variant4 Cycle (Serialize.list Serialize.string) (Serialize.list (Serialize.tuple Serialize.string exprCodec)) (Serialize.list defCodec) (S.everySet toComparableGlobal compareGlobal globalCodec) + |> Serialize.variant1 Manager effectsTypeCodec + |> Serialize.variant2 Kernel (Serialize.list K.chunkCodec) (S.everySet toComparableGlobal compareGlobal globalCodec) + |> Serialize.variant2 PortIncoming exprCodec (S.everySet toComparableGlobal compareGlobal globalCodec) + |> Serialize.variant2 PortOutgoing exprCodec (S.everySet toComparableGlobal compareGlobal globalCodec) + |> Serialize.finishCustomType + + +exprCodec : Codec e Expr +exprCodec = + Serialize.customType + (\boolEncoder chrEncoder strEncoder intEncoder floatEncoder varLocalEncoder varGlobalEncoder varEnumEncoder varBoxEncoder varCycleEncoder varDebugEncoder varKernelEncoder listEncoder functionEncoder callEncoder tailCallEncoder ifEncoder letEncoder destructEncoder caseEncoder accessorEncoder accessEncoder updateEncoder recordEncoder unitEncoder tupleEncoder shaderEncoder expr -> + case expr of + Bool value -> + boolEncoder value + + Chr value -> + chrEncoder value + + Str value -> + strEncoder value + + Int value -> + intEncoder value + + Float value -> + floatEncoder value + + VarLocal value -> + varLocalEncoder value + + VarGlobal value -> + varGlobalEncoder value + + VarEnum global index -> + varEnumEncoder global index + + VarBox value -> + varBoxEncoder value + + VarCycle home name -> + varCycleEncoder home name + + VarDebug name home region unhandledValueName -> + varDebugEncoder name home region unhandledValueName + + VarKernel home name -> + varKernelEncoder home name + + List value -> + listEncoder value + + Function args body -> + functionEncoder args body + + Call func args -> + callEncoder func args + + TailCall name args -> + tailCallEncoder name args + + If branches final -> + ifEncoder branches final + + Let def body -> + letEncoder def body + + Destruct destructor body -> + destructEncoder destructor body + + Case label root decider jumps -> + caseEncoder label root decider jumps + + Accessor field -> + accessorEncoder field + + Access record field -> + accessEncoder record field + + Update record fields -> + updateEncoder record fields + + Record value -> + recordEncoder value + + Unit -> + unitEncoder + + Tuple a b maybeC -> + tupleEncoder a b maybeC + + Shader src attributes uniforms -> + shaderEncoder src attributes uniforms + ) + |> Serialize.variant1 Bool Serialize.bool + |> Serialize.variant1 Chr Serialize.string + |> Serialize.variant1 Str Serialize.string + |> Serialize.variant1 Int Serialize.int + |> Serialize.variant1 Float Serialize.float + |> Serialize.variant1 VarLocal Serialize.string + |> Serialize.variant1 VarGlobal globalCodec + |> Serialize.variant2 VarEnum globalCodec Index.zeroBasedCodec + |> Serialize.variant1 VarBox globalCodec + |> Serialize.variant2 VarCycle ModuleName.canonicalCodec Serialize.string + |> Serialize.variant4 VarDebug Serialize.string ModuleName.canonicalCodec A.regionCodec (Serialize.maybe Serialize.string) + |> Serialize.variant2 VarKernel Serialize.string Serialize.string + |> Serialize.variant1 List (Serialize.list (Serialize.lazy (\() -> exprCodec))) + |> Serialize.variant2 Function (Serialize.list Serialize.string) (Serialize.lazy (\() -> exprCodec)) + |> Serialize.variant2 Call (Serialize.lazy (\() -> exprCodec)) (Serialize.list (Serialize.lazy (\() -> exprCodec))) + |> Serialize.variant2 TailCall Serialize.string (Serialize.list (Serialize.tuple Serialize.string (Serialize.lazy (\() -> exprCodec)))) + |> Serialize.variant2 If (Serialize.list (Serialize.tuple (Serialize.lazy (\() -> exprCodec)) (Serialize.lazy (\() -> exprCodec)))) (Serialize.lazy (\() -> exprCodec)) + |> Serialize.variant2 Let defCodec (Serialize.lazy (\() -> exprCodec)) + |> Serialize.variant2 Destruct destructorCodec (Serialize.lazy (\() -> exprCodec)) + |> Serialize.variant4 Case Serialize.string Serialize.string (deciderCodec choiceCodec) (Serialize.list (Serialize.tuple Serialize.int (Serialize.lazy (\() -> exprCodec)))) + |> Serialize.variant1 Accessor Serialize.string + |> Serialize.variant2 Access (Serialize.lazy (\() -> exprCodec)) Serialize.string + |> Serialize.variant2 Update (Serialize.lazy (\() -> exprCodec)) (S.assocListDict identity compare Serialize.string (Serialize.lazy (\() -> exprCodec))) + |> Serialize.variant1 Record (S.assocListDict identity compare Serialize.string (Serialize.lazy (\() -> exprCodec))) + |> Serialize.variant0 Unit + |> Serialize.variant3 Tuple (Serialize.lazy (\() -> exprCodec)) (Serialize.lazy (\() -> exprCodec)) (Serialize.maybe (Serialize.lazy (\() -> exprCodec))) + |> Serialize.variant3 Shader Shader.sourceCodec (S.everySet identity compare Serialize.string) (S.everySet identity compare Serialize.string) + |> Serialize.finishCustomType + + +defCodec : Codec e Def +defCodec = + Serialize.customType + (\defCodecEncoder tailDefEncoder value -> + case value of + Def name expr -> + defCodecEncoder name expr + + TailDef name args expr -> + tailDefEncoder name args expr + ) + |> Serialize.variant2 Def Serialize.string (Serialize.lazy (\() -> exprCodec)) + |> Serialize.variant3 TailDef Serialize.string (Serialize.list Serialize.string) (Serialize.lazy (\() -> exprCodec)) + |> Serialize.finishCustomType + + +destructorCodec : Codec e Destructor +destructorCodec = + Serialize.customType + (\destructorCodecEncoder (Destructor name path) -> + destructorCodecEncoder name path + ) + |> Serialize.variant2 Destructor Serialize.string pathCodec + |> Serialize.finishCustomType + + +deciderCodec : Codec e a -> Codec e (Decider a) +deciderCodec codec = + Serialize.customType + (\leafEncoder chainEncoder fanOutEncoder decider -> + case decider of + Leaf value -> + leafEncoder value + + Chain testChain success failure -> + chainEncoder testChain success failure + + FanOut path edges fallback -> + fanOutEncoder path edges fallback + ) + |> Serialize.variant1 Leaf codec + |> Serialize.variant3 Chain (Serialize.list (Serialize.tuple DT.pathCodec DT.testCodec)) (Serialize.lazy (\() -> deciderCodec codec)) (Serialize.lazy (\() -> deciderCodec codec)) + |> Serialize.variant3 FanOut DT.pathCodec (Serialize.list (Serialize.tuple DT.testCodec (Serialize.lazy (\() -> deciderCodec codec)))) (Serialize.lazy (\() -> deciderCodec codec)) + |> Serialize.finishCustomType + + +choiceCodec : Codec e Choice +choiceCodec = + Serialize.customType + (\inlineEncoder jumpEncoder choice -> + case choice of + Inline value -> + inlineEncoder value + + Jump value -> + jumpEncoder value + ) + |> Serialize.variant1 Inline (Serialize.lazy (\() -> exprCodec)) + |> Serialize.variant1 Jump Serialize.int + |> Serialize.finishCustomType + + +pathCodec : Codec e Path +pathCodec = + Serialize.customType + (\indexEncoder fieldEncoder unboxEncoder rootEncoder path -> + case path of + Index index subPath -> + indexEncoder index subPath + + Field field subPath -> + fieldEncoder field subPath + + Unbox subPath -> + unboxEncoder subPath + + Root name -> + rootEncoder name + ) + |> Serialize.variant2 Index Index.zeroBasedCodec (Serialize.lazy (\() -> pathCodec)) + |> Serialize.variant2 Field Serialize.string (Serialize.lazy (\() -> pathCodec)) + |> Serialize.variant1 Unbox (Serialize.lazy (\() -> pathCodec)) + |> Serialize.variant1 Root Serialize.string + |> Serialize.finishCustomType + + +effectsTypeCodec : Codec e EffectsType +effectsTypeCodec = + Serialize.customType + (\cmdEncoder subEncoder fxEncoder effectsType -> + case effectsType of + Cmd -> + cmdEncoder + + Sub -> + subEncoder + + Fx -> + fxEncoder + ) + |> Serialize.variant0 Cmd + |> Serialize.variant0 Sub + |> Serialize.variant0 Fx + |> Serialize.finishCustomType diff --git a/src/Compiler/AST/Source.elm b/src/Compiler/AST/Source.elm index 7d8bc7ac8..54296950c 100644 --- a/src/Compiler/AST/Source.elm +++ b/src/Compiler/AST/Source.elm @@ -23,20 +23,16 @@ module Compiler.AST.Source exposing , VarType(..) , getImportName , getName - , moduleDecoder - , moduleEncoder - , typeDecoder - , typeEncoder + , moduleCodec + , typeCodec ) import Compiler.AST.Utils.Binop as Binop import Compiler.AST.Utils.Shader as Shader import Compiler.Data.Name as Name exposing (Name) -import Compiler.Json.Encode as E import Compiler.Parse.Primitives as P import Compiler.Reporting.Annotation as A -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -220,1052 +216,536 @@ type Privacy -- ENCODERS and DECODERS -typeEncoder : Type -> Encode.Value -typeEncoder = - A.locatedEncoder internalTypeEncoder - - -typeDecoder : Decode.Decoder Type -typeDecoder = - A.locatedDecoder internalTypeDecoder - - -internalTypeEncoder : Type_ -> Encode.Value -internalTypeEncoder type_ = - case type_ of - TLambda arg result -> - Encode.object - [ ( "type", Encode.string "TLambda" ) - , ( "arg", typeEncoder arg ) - , ( "result", typeEncoder result ) - ] - - TVar name -> - Encode.object - [ ( "type", Encode.string "TVar" ) - , ( "name", Encode.string name ) - ] - - TType region name args -> - Encode.object - [ ( "type", Encode.string "TType" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "args", Encode.list typeEncoder args ) - ] - - TTypeQual region home name args -> - Encode.object - [ ( "type", Encode.string "TTypeQual" ) - , ( "region", A.regionEncoder region ) - , ( "home", Encode.string home ) - , ( "name", Encode.string name ) - , ( "args", Encode.list typeEncoder args ) - ] - - TRecord fields ext -> - Encode.object - [ ( "type", Encode.string "TRecord" ) - , ( "fields", Encode.list (E.jsonPair (A.locatedEncoder Encode.string) typeEncoder) fields ) - , ( "ext", E.maybe (A.locatedEncoder Encode.string) ext ) - ] - - TUnit -> - Encode.object - [ ( "type", Encode.string "TUnit" ) - ] - - TTuple a b cs -> - Encode.object - [ ( "type", Encode.string "TTuple" ) - , ( "a", typeEncoder a ) - , ( "b", typeEncoder b ) - , ( "cs", Encode.list typeEncoder cs ) - ] - - -internalTypeDecoder : Decode.Decoder Type_ -internalTypeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "TLambda" -> - Decode.map2 TLambda - (Decode.field "arg" typeDecoder) - (Decode.field "result" typeDecoder) - - "TVar" -> - Decode.map TVar (Decode.field "name" Decode.string) - - "TType" -> - Decode.map3 TType - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list typeDecoder)) - - "TTypeQual" -> - Decode.map4 TTypeQual - (Decode.field "region" A.regionDecoder) - (Decode.field "home" Decode.string) - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list typeDecoder)) - - "TRecord" -> - Decode.map2 TRecord - (Decode.field "fields" - (Decode.list - (Decode.map2 Tuple.pair - (Decode.field "a" (A.locatedDecoder Decode.string)) - (Decode.field "b" typeDecoder) - ) - ) - ) - (Decode.field "ext" (Decode.maybe (A.locatedDecoder Decode.string))) - - "TUnit" -> - Decode.succeed TUnit - - "TTuple" -> - Decode.map3 TTuple - (Decode.field "a" typeDecoder) - (Decode.field "b" typeDecoder) - (Decode.field "cs" (Decode.list typeDecoder)) - - _ -> - Decode.fail ("Failed to decode Type_'s type: " ++ type_) - ) +typeCodec : Codec e Type +typeCodec = + A.locatedCodec type_Codec -moduleEncoder : Module -> Encode.Value -moduleEncoder (Module maybeName exports docs imports values unions aliases binops effects) = - Encode.object - [ ( "type", Encode.string "Module" ) - , ( "maybeName", E.maybe (A.locatedEncoder Encode.string) maybeName ) - , ( "exports", A.locatedEncoder exposingEncoder exports ) - , ( "docs", docsEncoder docs ) - , ( "imports", Encode.list importEncoder imports ) - , ( "values", Encode.list (A.locatedEncoder valueEncoder) values ) - , ( "unions", Encode.list (A.locatedEncoder unionEncoder) unions ) - , ( "aliases", Encode.list (A.locatedEncoder aliasEncoder) aliases ) - , ( "binops", Encode.list (A.locatedEncoder infixEncoder) binops ) - , ( "effects", effectsEncoder effects ) - ] - - -moduleDecoder : Decode.Decoder Module -moduleDecoder = - Decode.map8 (\( maybeName, exports ) -> Module maybeName exports) - (Decode.map2 Tuple.pair - (Decode.field "maybeName" (Decode.maybe (A.locatedDecoder Decode.string))) - (Decode.field "exports" (A.locatedDecoder exposingDecoder)) - ) - (Decode.field "docs" docsDecoder) - (Decode.field "imports" (Decode.list importDecoder)) - (Decode.field "values" (Decode.list (A.locatedDecoder valueDecoder))) - (Decode.field "unions" (Decode.list (A.locatedDecoder unionDecoder))) - (Decode.field "aliases" (Decode.list (A.locatedDecoder aliasDecoder))) - (Decode.field "binops" (Decode.list (A.locatedDecoder infixDecoder))) - (Decode.field "effects" effectsDecoder) - - -exposingEncoder : Exposing -> Encode.Value -exposingEncoder exposing_ = - case exposing_ of - Open -> - Encode.object - [ ( "type", Encode.string "Open" ) - ] - - Explicit exposedList -> - Encode.object - [ ( "type", Encode.string "Explicit" ) - , ( "exposedList", Encode.list exposedEncoder exposedList ) - ] - - -exposingDecoder : Decode.Decoder Exposing -exposingDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Open" -> - Decode.succeed Open - - "Explicit" -> - Decode.map Explicit (Decode.field "exposedList" (Decode.list exposedDecoder)) - - _ -> - Decode.fail ("Failed to decode Exposing's type: " ++ type_) - ) +type_Codec : Codec e Type_ +type_Codec = + Serialize.customType + (\tLambdaEncoder tVarEncoder tTypeEncoder tTypeQualEncoder tRecordEncoder tUnitEncoder tTupleEncoder value -> + case value of + TLambda arg result -> + tLambdaEncoder arg result + TVar name -> + tVarEncoder name -docsEncoder : Docs -> Encode.Value -docsEncoder docs = - case docs of - NoDocs region -> - Encode.object - [ ( "type", Encode.string "NoDocs" ) - , ( "region", A.regionEncoder region ) - ] - - YesDocs overview comments -> - Encode.object - [ ( "type", Encode.string "YesDocs" ) - , ( "overview", commentEncoder overview ) - , ( "comments", Encode.list (E.jsonPair Encode.string commentEncoder) comments ) - ] - - -docsDecoder : Decode.Decoder Docs -docsDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "NoDocs" -> - Decode.map NoDocs (Decode.field "region" A.regionDecoder) - - "YesDocs" -> - Decode.map2 YesDocs - (Decode.field "overview" commentDecoder) - (Decode.field "comments" - (Decode.list - (Decode.map2 Tuple.pair - (Decode.field "a" Decode.string) - (Decode.field "b" commentDecoder) - ) - ) - ) - - _ -> - Decode.fail ("Failed to decode Docs's type: " ++ type_) - ) + TType region name args -> + tTypeEncoder region name args + TTypeQual region home name args -> + tTypeQualEncoder region home name args -importEncoder : Import -> Encode.Value -importEncoder (Import importName maybeAlias exposing_) = - Encode.object - [ ( "type", Encode.string "Import" ) - , ( "importName", A.locatedEncoder Encode.string importName ) - , ( "maybeAlias", E.maybe Encode.string maybeAlias ) - , ( "exposing", exposingEncoder exposing_ ) - ] - - -importDecoder : Decode.Decoder Import -importDecoder = - Decode.map3 Import - (Decode.field "importName" (A.locatedDecoder Decode.string)) - (Decode.field "maybeAlias" (Decode.maybe Decode.string)) - (Decode.field "exposing" exposingDecoder) - - -valueEncoder : Value -> Encode.Value -valueEncoder (Value name srcArgs body maybeType) = - Encode.object - [ ( "type", Encode.string "Value" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "srcArgs", Encode.list patternEncoder srcArgs ) - , ( "body", exprEncoder body ) - , ( "maybeType", E.maybe typeEncoder maybeType ) - ] - - -valueDecoder : Decode.Decoder Value -valueDecoder = - Decode.map4 Value - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "srcArgs" (Decode.list patternDecoder)) - (Decode.field "body" exprDecoder) - (Decode.field "maybeType" (Decode.maybe typeDecoder)) - - -unionEncoder : Union -> Encode.Value -unionEncoder (Union name args constructors) = - Encode.object - [ ( "type", Encode.string "Union" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "args", Encode.list (A.locatedEncoder Encode.string) args ) - , ( "constructors", Encode.list (E.jsonPair (A.locatedEncoder Encode.string) (Encode.list typeEncoder)) constructors ) - ] - - -unionDecoder : Decode.Decoder Union -unionDecoder = - Decode.map3 Union - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "args" (Decode.list (A.locatedDecoder Decode.string))) - (Decode.field "constructors" - (Decode.list - (Decode.map2 Tuple.pair - (Decode.field "a" (A.locatedDecoder Decode.string)) - (Decode.field "b" (Decode.list typeDecoder)) - ) + TRecord fields ext -> + tRecordEncoder fields ext + + TUnit -> + tUnitEncoder + + TTuple a b cs -> + tTupleEncoder a b cs + ) + |> Serialize.variant2 + TLambda + (A.locatedCodec (Serialize.lazy (\() -> type_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> type_Codec))) + |> Serialize.variant1 TVar Serialize.string + |> Serialize.variant3 + TType + A.regionCodec + Serialize.string + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> type_Codec)))) + |> Serialize.variant4 + TTypeQual + A.regionCodec + Serialize.string + Serialize.string + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> type_Codec)))) + |> Serialize.variant2 + TRecord + (Serialize.list + (Serialize.tuple (A.locatedCodec Serialize.string) (A.locatedCodec (Serialize.lazy (\() -> type_Codec)))) ) + (Serialize.maybe (A.locatedCodec Serialize.string)) + |> Serialize.variant0 TUnit + |> Serialize.variant3 + TTuple + (A.locatedCodec (Serialize.lazy (\() -> type_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> type_Codec))) + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> type_Codec)))) + |> Serialize.finishCustomType + + +moduleCodec : Codec e Module +moduleCodec = + Serialize.customType + (\moduleCodecEncoder (Module maybeName exports docs imports values unions aliases binops effects) -> + moduleCodecEncoder maybeName exports docs imports values unions aliases binops effects + ) + |> Serialize.variant9 + Module + (Serialize.maybe (A.locatedCodec Serialize.string)) + (A.locatedCodec exposingCodec) + docsCodec + (Serialize.list importCodec) + (Serialize.list (A.locatedCodec valueCodec)) + (Serialize.list (A.locatedCodec unionCodec)) + (Serialize.list (A.locatedCodec aliasCodec)) + (Serialize.list (A.locatedCodec infixCodec)) + effectsCodec + |> Serialize.finishCustomType + + +exposingCodec : Codec e Exposing +exposingCodec = + Serialize.customType + (\openEncoder explicitEncoder value -> + case value of + Open -> + openEncoder + + Explicit exposedList -> + explicitEncoder exposedList ) + |> Serialize.variant0 Open + |> Serialize.variant1 Explicit (Serialize.list exposedCodec) + |> Serialize.finishCustomType -aliasEncoder : Alias -> Encode.Value -aliasEncoder (Alias name args tipe) = - Encode.object - [ ( "type", Encode.string "Alias" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "args", Encode.list (A.locatedEncoder Encode.string) args ) - , ( "tipe", typeEncoder tipe ) - ] - - -aliasDecoder : Decode.Decoder Alias -aliasDecoder = - Decode.map3 Alias - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "args" (Decode.list (A.locatedDecoder Decode.string))) - (Decode.field "tipe" typeDecoder) - - -infixEncoder : Infix -> Encode.Value -infixEncoder (Infix op associativity precedence name) = - Encode.object - [ ( "type", Encode.string "Infix" ) - , ( "op", Encode.string op ) - , ( "associativity", Binop.associativityEncoder associativity ) - , ( "precedence", Binop.precedenceEncoder precedence ) - , ( "name", Encode.string name ) - ] - - -infixDecoder : Decode.Decoder Infix -infixDecoder = - Decode.map4 Infix - (Decode.field "op" Decode.string) - (Decode.field "associativity" Binop.associativityDecoder) - (Decode.field "precedence" Binop.precedenceDecoder) - (Decode.field "name" Decode.string) - - -effectsEncoder : Effects -> Encode.Value -effectsEncoder effects = - case effects of - NoEffects -> - Encode.object - [ ( "type", Encode.string "NoEffects" ) - ] - - Ports ports -> - Encode.object - [ ( "type", Encode.string "Ports" ) - , ( "ports", Encode.list portEncoder ports ) - ] - - Manager region manager -> - Encode.object - [ ( "type", Encode.string "Manager" ) - , ( "region", A.regionEncoder region ) - , ( "manager", managerEncoder manager ) - ] - - -effectsDecoder : Decode.Decoder Effects -effectsDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "NoEffects" -> - Decode.succeed NoEffects - - "Ports" -> - Decode.map Ports (Decode.field "ports" (Decode.list portDecoder)) - - "Manager" -> - Decode.map2 Manager - (Decode.field "region" A.regionDecoder) - (Decode.field "manager" managerDecoder) - - _ -> - Decode.fail ("Failed to decode Effects' type: " ++ type_) - ) +docsCodec : Codec e Docs +docsCodec = + Serialize.customType + (\noDocsEncoder yesDocsEncoder value -> + case value of + NoDocs region -> + noDocsEncoder region + YesDocs overview comments -> + yesDocsEncoder overview comments + ) + |> Serialize.variant1 NoDocs A.regionCodec + |> Serialize.variant2 YesDocs commentCodec (Serialize.list (Serialize.tuple Serialize.string commentCodec)) + |> Serialize.finishCustomType -commentEncoder : Comment -> Encode.Value -commentEncoder (Comment snippet) = - P.snippetEncoder snippet +importCodec : Codec e Import +importCodec = + Serialize.customType + (\importCodecEncoder (Import importName maybeAlias exposing_) -> + importCodecEncoder importName maybeAlias exposing_ + ) + |> Serialize.variant3 Import (A.locatedCodec Serialize.string) (Serialize.maybe Serialize.string) exposingCodec + |> Serialize.finishCustomType -commentDecoder : Decode.Decoder Comment -commentDecoder = - Decode.map Comment P.snippetDecoder +valueCodec : Codec e Value +valueCodec = + Serialize.customType + (\valueCodecEncoder (Value name srcArgs body maybeType) -> + valueCodecEncoder name srcArgs body maybeType + ) + |> Serialize.variant4 + Value + (A.locatedCodec Serialize.string) + (Serialize.list (A.locatedCodec pattern_Codec)) + (A.locatedCodec expr_Codec) + (Serialize.maybe (A.locatedCodec type_Codec)) + |> Serialize.finishCustomType + + +unionCodec : Codec e Union +unionCodec = + Serialize.customType + (\unionCodecEncoder (Union name args constructors) -> + unionCodecEncoder name args constructors + ) + |> Serialize.variant3 + Union + (A.locatedCodec Serialize.string) + (Serialize.list (A.locatedCodec Serialize.string)) + (Serialize.list + (Serialize.tuple (A.locatedCodec Serialize.string) (Serialize.list (A.locatedCodec type_Codec))) + ) + |> Serialize.finishCustomType -portEncoder : Port -> Encode.Value -portEncoder (Port name tipe) = - Encode.object - [ ( "type", Encode.string "Port" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "tipe", typeEncoder tipe ) - ] +aliasCodec : Codec e Alias +aliasCodec = + Serialize.customType + (\aliasCodecEncoder (Alias name args tipe) -> + aliasCodecEncoder name args tipe + ) + |> Serialize.variant3 + Alias + (A.locatedCodec Serialize.string) + (Serialize.list (A.locatedCodec Serialize.string)) + (A.locatedCodec type_Codec) + |> Serialize.finishCustomType + + +infixCodec : Codec e Infix +infixCodec = + Serialize.customType + (\infixCodecEncoder (Infix op associativity precedence name) -> + infixCodecEncoder op associativity precedence name + ) + |> Serialize.variant4 Infix Serialize.string Binop.associativityCodec Binop.precedenceCodec Serialize.string + |> Serialize.finishCustomType -portDecoder : Decode.Decoder Port -portDecoder = - Decode.map2 Port - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "tipe" typeDecoder) +effectsCodec : Codec e Effects +effectsCodec = + Serialize.customType + (\noEffectsEncoder portsEncoder managerCodecEncoder value -> + case value of + NoEffects -> + noEffectsEncoder -managerEncoder : Manager -> Encode.Value -managerEncoder manager = - case manager of - Cmd cmdType -> - Encode.object - [ ( "type", Encode.string "Cmd" ) - , ( "cmdType", A.locatedEncoder Encode.string cmdType ) - ] + Ports ports -> + portsEncoder ports - Sub subType -> - Encode.object - [ ( "type", Encode.string "Sub" ) - , ( "subType", A.locatedEncoder Encode.string subType ) - ] + Manager region manager -> + managerCodecEncoder region manager + ) + |> Serialize.variant0 NoEffects + |> Serialize.variant1 Ports (Serialize.list portCodec) + |> Serialize.variant2 Manager A.regionCodec managerCodec + |> Serialize.finishCustomType - Fx cmdType subType -> - Encode.object - [ ( "type", Encode.string "Fx" ) - , ( "cmdType", A.locatedEncoder Encode.string cmdType ) - , ( "subType", A.locatedEncoder Encode.string subType ) - ] +commentCodec : Codec e Comment +commentCodec = + Serialize.customType + (\commentCodecEncoder (Comment snippet) -> + commentCodecEncoder snippet + ) + |> Serialize.variant1 Comment P.snippetCodec + |> Serialize.finishCustomType -managerDecoder : Decode.Decoder Manager -managerDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Cmd" -> - Decode.map Cmd (Decode.field "cmdType" (A.locatedDecoder Decode.string)) - "Sub" -> - Decode.map Sub (Decode.field "subType" (A.locatedDecoder Decode.string)) +portCodec : Codec e Port +portCodec = + Serialize.customType + (\portCodecEncoder (Port name tipe) -> + portCodecEncoder name tipe + ) + |> Serialize.variant2 Port (A.locatedCodec Serialize.string) (A.locatedCodec type_Codec) + |> Serialize.finishCustomType - "Fx" -> - Decode.map2 Fx - (Decode.field "cmdType" (A.locatedDecoder Decode.string)) - (Decode.field "subType" (A.locatedDecoder Decode.string)) - _ -> - Decode.fail ("Failed to decode Manager's type: " ++ type_) - ) +managerCodec : Codec e Manager +managerCodec = + Serialize.customType + (\cmdEncoder subEncoder fxEncoder value -> + case value of + Cmd cmdType -> + cmdEncoder cmdType + Sub subType -> + subEncoder subType -exposedEncoder : Exposed -> Encode.Value -exposedEncoder exposed = - case exposed of - Lower name -> - Encode.object - [ ( "type", Encode.string "Lower" ) - , ( "name", A.locatedEncoder Encode.string name ) - ] - - Upper name dotDotRegion -> - Encode.object - [ ( "type", Encode.string "Upper" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "dotDotRegion", privacyEncoder dotDotRegion ) - ] - - Operator region name -> - Encode.object - [ ( "type", Encode.string "Operator" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - ] - - -exposedDecoder : Decode.Decoder Exposed -exposedDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Lower" -> - Decode.map Lower (Decode.field "name" (A.locatedDecoder Decode.string)) - - "Upper" -> - Decode.map2 Upper - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "dotDotRegion" privacyDecoder) - - "Operator" -> - Decode.map2 Operator - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - - _ -> - Decode.fail ("Failed to decode Exposed's type: " ++ type_) - ) + Fx cmdType subType -> + fxEncoder cmdType subType + ) + |> Serialize.variant1 Cmd (A.locatedCodec Serialize.string) + |> Serialize.variant1 Sub (A.locatedCodec Serialize.string) + |> Serialize.variant2 Fx (A.locatedCodec Serialize.string) (A.locatedCodec Serialize.string) + |> Serialize.finishCustomType -privacyEncoder : Privacy -> Encode.Value -privacyEncoder privacy = - case privacy of - Public region -> - Encode.object - [ ( "type", Encode.string "Public" ) - , ( "region", A.regionEncoder region ) - ] +exposedCodec : Codec e Exposed +exposedCodec = + Serialize.customType + (\lowerEncoder upperEncoder operatorEncoder value -> + case value of + Lower name -> + lowerEncoder name - Private -> - Encode.object - [ ( "type", Encode.string "Private" ) - ] + Upper name dotDotRegion -> + upperEncoder name dotDotRegion + Operator region name -> + operatorEncoder region name + ) + |> Serialize.variant1 Lower (A.locatedCodec Serialize.string) + |> Serialize.variant2 Upper (A.locatedCodec Serialize.string) privacyCodec + |> Serialize.variant2 Operator A.regionCodec Serialize.string + |> Serialize.finishCustomType + + +privacyCodec : Codec e Privacy +privacyCodec = + Serialize.customType + (\publicEncoder privateEncoder value -> + case value of + Public region -> + publicEncoder region + + Private -> + privateEncoder + ) + |> Serialize.variant1 Public A.regionCodec + |> Serialize.variant0 Private + |> Serialize.finishCustomType -privacyDecoder : Decode.Decoder Privacy -privacyDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Public" -> - Decode.map Public (Decode.field "region" A.regionDecoder) - "Private" -> - Decode.succeed Private +patternCodec : Codec e Pattern +patternCodec = + A.locatedCodec pattern_Codec - _ -> - Decode.fail ("Failed to decode Privacy's type: " ++ type_) - ) +pattern_Codec : Codec e Pattern_ +pattern_Codec = + Serialize.customType + (\pAnythingEncoder pVarEncoder pRecordEncoder pAliasEncoder pUnitEncoder pTupleEncoder pCtorEncoder pCtorQualEncoder pListEncoder pConsEncoder pChrEncoder pStrEncoder pIntEncoder value -> + case value of + PAnything -> + pAnythingEncoder -patternEncoder : Pattern -> Encode.Value -patternEncoder = - A.locatedEncoder pattern_Encoder - - -patternDecoder : Decode.Decoder Pattern -patternDecoder = - A.locatedDecoder pattern_Decoder - - -pattern_Encoder : Pattern_ -> Encode.Value -pattern_Encoder pattern_ = - case pattern_ of - PAnything -> - Encode.object - [ ( "type", Encode.string "PAnything" ) - ] - - PVar name -> - Encode.object - [ ( "type", Encode.string "PVar" ) - , ( "name", Encode.string name ) - ] - - PRecord fields -> - Encode.object - [ ( "type", Encode.string "PRecord" ) - , ( "fields", Encode.list (A.locatedEncoder Encode.string) fields ) - ] - - PAlias aliasPattern name -> - Encode.object - [ ( "type", Encode.string "PAlias" ) - , ( "aliasPattern", patternEncoder aliasPattern ) - , ( "name", A.locatedEncoder Encode.string name ) - ] - - PUnit -> - Encode.object - [ ( "type", Encode.string "PUnit" ) - ] - - PTuple a b cs -> - Encode.object - [ ( "type", Encode.string "PTuple" ) - , ( "a", patternEncoder a ) - , ( "b", patternEncoder b ) - , ( "cs", Encode.list patternEncoder cs ) - ] - - PCtor nameRegion name patterns -> - Encode.object - [ ( "type", Encode.string "PCtor" ) - , ( "nameRegion", A.regionEncoder nameRegion ) - , ( "name", Encode.string name ) - , ( "patterns", Encode.list patternEncoder patterns ) - ] - - PCtorQual nameRegion home name patterns -> - Encode.object - [ ( "type", Encode.string "PCtorQual" ) - , ( "nameRegion", A.regionEncoder nameRegion ) - , ( "home", Encode.string home ) - , ( "name", Encode.string name ) - , ( "patterns", Encode.list patternEncoder patterns ) - ] - - PList patterns -> - Encode.object - [ ( "type", Encode.string "PList" ) - , ( "patterns", Encode.list patternEncoder patterns ) - ] - - PCons hd tl -> - Encode.object - [ ( "type", Encode.string "PCons" ) - , ( "hd", patternEncoder hd ) - , ( "tl", patternEncoder tl ) - ] - - PChr chr -> - Encode.object - [ ( "type", Encode.string "PChr" ) - , ( "chr", Encode.string chr ) - ] - - PStr str -> - Encode.object - [ ( "type", Encode.string "PStr" ) - , ( "str", Encode.string str ) - ] - - PInt int -> - Encode.object - [ ( "type", Encode.string "PInt" ) - , ( "int", Encode.int int ) - ] - - -pattern_Decoder : Decode.Decoder Pattern_ -pattern_Decoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PAnything" -> - Decode.succeed PAnything - - "PVar" -> - Decode.map PVar (Decode.field "name" Decode.string) - - "PRecord" -> - Decode.map PRecord (Decode.field "fields" (Decode.list (A.locatedDecoder Decode.string))) - - "PAlias" -> - Decode.map2 PAlias - (Decode.field "aliasPattern" patternDecoder) - (Decode.field "name" (A.locatedDecoder Decode.string)) - - "PUnit" -> - Decode.succeed PUnit - - "PTuple" -> - Decode.map3 PTuple - (Decode.field "a" patternDecoder) - (Decode.field "b" patternDecoder) - (Decode.field "cs" (Decode.list patternDecoder)) - - "PCtor" -> - Decode.map3 PCtor - (Decode.field "nameRegion" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "patterns" (Decode.list patternDecoder)) - - "PCtorQual" -> - Decode.map4 PCtorQual - (Decode.field "nameRegion" A.regionDecoder) - (Decode.field "home" Decode.string) - (Decode.field "name" Decode.string) - (Decode.field "patterns" (Decode.list patternDecoder)) - - "PList" -> - Decode.map PList (Decode.field "patterns" (Decode.list patternDecoder)) - - "PCons" -> - Decode.map2 PCons - (Decode.field "hd" patternDecoder) - (Decode.field "tl" patternDecoder) - - "PChr" -> - Decode.map PChr (Decode.field "chr" Decode.string) - - "PStr" -> - Decode.map PStr (Decode.field "str" Decode.string) - - "PInt" -> - Decode.map PInt (Decode.field "int" Decode.int) - - _ -> - Decode.fail ("Failed to decode Pattern_'s type: " ++ type_) - ) + PVar name -> + pVarEncoder name + PRecord fields -> + pRecordEncoder fields -exprEncoder : Expr -> Encode.Value -exprEncoder = - A.locatedEncoder expr_Encoder - - -exprDecoder : Decode.Decoder Expr -exprDecoder = - A.locatedDecoder expr_Decoder - - -expr_Encoder : Expr_ -> Encode.Value -expr_Encoder expr_ = - case expr_ of - Chr char -> - Encode.object - [ ( "type", Encode.string "Chr" ) - , ( "char", Encode.string char ) - ] - - Str string -> - Encode.object - [ ( "type", Encode.string "Str" ) - , ( "string", Encode.string string ) - ] - - Int int -> - Encode.object - [ ( "type", Encode.string "Int" ) - , ( "int", Encode.int int ) - ] - - Float float -> - Encode.object - [ ( "type", Encode.string "Float" ) - , ( "float", Encode.float float ) - ] - - Var varType name -> - Encode.object - [ ( "type", Encode.string "Var" ) - , ( "varType", varTypeEncoder varType ) - , ( "name", Encode.string name ) - ] - - VarQual varType prefix name -> - Encode.object - [ ( "type", Encode.string "VarQual" ) - , ( "varType", varTypeEncoder varType ) - , ( "prefix", Encode.string prefix ) - , ( "name", Encode.string name ) - ] - - List list -> - Encode.object - [ ( "type", Encode.string "List" ) - , ( "list", Encode.list exprEncoder list ) - ] - - Op op -> - Encode.object - [ ( "type", Encode.string "Op" ) - , ( "op", Encode.string op ) - ] - - Negate expr -> - Encode.object - [ ( "type", Encode.string "Negate" ) - , ( "expr", exprEncoder expr ) - ] - - Binops ops final -> - Encode.object - [ ( "type", Encode.string "Binops" ) - , ( "ops", Encode.list (E.jsonPair exprEncoder (A.locatedEncoder Encode.string)) ops ) - , ( "final", exprEncoder final ) - ] - - Lambda srcArgs body -> - Encode.object - [ ( "type", Encode.string "Lambda" ) - , ( "srcArgs", Encode.list patternEncoder srcArgs ) - , ( "body", exprEncoder body ) - ] - - Call func args -> - Encode.object - [ ( "type", Encode.string "Call" ) - , ( "func", exprEncoder func ) - , ( "args", Encode.list exprEncoder args ) - ] - - If branches finally -> - Encode.object - [ ( "type", Encode.string "If" ) - , ( "branches", Encode.list (E.jsonPair exprEncoder exprEncoder) branches ) - , ( "finally", exprEncoder finally ) - ] - - Let defs expr -> - Encode.object - [ ( "type", Encode.string "Let" ) - , ( "defs", Encode.list (A.locatedEncoder defEncoder) defs ) - , ( "expr", exprEncoder expr ) - ] - - Case expr branches -> - Encode.object - [ ( "type", Encode.string "Case" ) - , ( "expr", exprEncoder expr ) - , ( "branches", Encode.list (E.jsonPair patternEncoder exprEncoder) branches ) - ] - - Accessor field -> - Encode.object - [ ( "type", Encode.string "Accessor" ) - , ( "field", Encode.string field ) - ] - - Access record field -> - Encode.object - [ ( "type", Encode.string "Access" ) - , ( "record", exprEncoder record ) - , ( "field", A.locatedEncoder Encode.string field ) - ] - - Update name fields -> - Encode.object - [ ( "type", Encode.string "Update" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "fields", Encode.list (E.jsonPair (A.locatedEncoder Encode.string) exprEncoder) fields ) - ] - - Record fields -> - Encode.object - [ ( "type", Encode.string "Record" ) - , ( "fields", Encode.list (E.jsonPair (A.locatedEncoder Encode.string) exprEncoder) fields ) - ] - - Unit -> - Encode.object - [ ( "type", Encode.string "Unit" ) - ] - - Tuple a b cs -> - Encode.object - [ ( "type", Encode.string "Tuple" ) - , ( "a", exprEncoder a ) - , ( "b", exprEncoder b ) - , ( "cs", Encode.list exprEncoder cs ) - ] - - Shader src tipe -> - Encode.object - [ ( "type", Encode.string "Shader" ) - , ( "src", Shader.sourceEncoder src ) - , ( "tipe", Shader.typesEncoder tipe ) - ] - - -expr_Decoder : Decode.Decoder Expr_ -expr_Decoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Chr" -> - Decode.map Chr (Decode.field "char" Decode.string) - - "Str" -> - Decode.map Str (Decode.field "string" Decode.string) - - "Int" -> - Decode.map Int (Decode.field "int" Decode.int) - - "Float" -> - Decode.map Float (Decode.field "float" Decode.float) - - "Var" -> - Decode.map2 Var - (Decode.field "varType" varTypeDecoder) - (Decode.field "name" Decode.string) - - "VarQual" -> - Decode.map3 VarQual - (Decode.field "varType" varTypeDecoder) - (Decode.field "prefix" Decode.string) - (Decode.field "name" Decode.string) - - "List" -> - Decode.map List (Decode.field "list" (Decode.list exprDecoder)) - - "Op" -> - Decode.map Op (Decode.field "op" Decode.string) - - "Negate" -> - Decode.map Negate (Decode.field "expr" exprDecoder) - - "Binops" -> - Decode.map2 Binops - (Decode.field "ops" - (Decode.list - (Decode.map2 Tuple.pair - (Decode.field "a" exprDecoder) - (Decode.field "b" (A.locatedDecoder Decode.string)) - ) - ) - ) - (Decode.field "final" exprDecoder) - - "Lambda" -> - Decode.map2 Lambda - (Decode.field "srcArgs" (Decode.list patternDecoder)) - (Decode.field "body" exprDecoder) - - "Call" -> - Decode.map2 Call - (Decode.field "func" exprDecoder) - (Decode.field "args" (Decode.list exprDecoder)) - - "If" -> - Decode.map2 If - (Decode.field "branches" - (Decode.list - (Decode.map2 Tuple.pair - (Decode.field "a" exprDecoder) - (Decode.field "b" exprDecoder) - ) - ) - ) - (Decode.field "finally" exprDecoder) - - "Let" -> - Decode.map2 Let - (Decode.field "defs" (Decode.list (A.locatedDecoder defDecoder))) - (Decode.field "expr" exprDecoder) - - "Case" -> - Decode.map2 Case - (Decode.field "expr" exprDecoder) - (Decode.field "branches" - (Decode.list - (Decode.map2 Tuple.pair - (Decode.field "a" patternDecoder) - (Decode.field "b" exprDecoder) - ) - ) - ) - - "Accessor" -> - Decode.map Accessor (Decode.field "field" Decode.string) - - "Access" -> - Decode.map2 Access - (Decode.field "record" exprDecoder) - (Decode.field "field" (A.locatedDecoder Decode.string)) - - "Update" -> - Decode.map2 Update - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "fields" - (Decode.list - (Decode.map2 Tuple.pair - (Decode.field "a" (A.locatedDecoder Decode.string)) - (Decode.field "b" exprDecoder) - ) - ) - ) - - "Record" -> - Decode.map Record - (Decode.field "fields" - (Decode.list - (Decode.map2 Tuple.pair - (Decode.field "a" (A.locatedDecoder Decode.string)) - (Decode.field "b" exprDecoder) - ) - ) - ) - - "Unit" -> - Decode.succeed Unit - - "Tuple" -> - Decode.map3 Tuple - (Decode.field "a" exprDecoder) - (Decode.field "b" exprDecoder) - (Decode.field "cs" (Decode.list exprDecoder)) - - "Shader" -> - Decode.map2 Shader - (Decode.field "src" Shader.sourceDecoder) - (Decode.field "tipe" Shader.typesDecoder) - - _ -> - Decode.fail ("Failed to decode Expr_'s type: " ++ type_) - ) + PAlias aliasPattern name -> + pAliasEncoder aliasPattern name + PUnit -> + pUnitEncoder -varTypeEncoder : VarType -> Encode.Value -varTypeEncoder varType = - case varType of - LowVar -> - Encode.string "LowVar" + PTuple a b cs -> + pTupleEncoder a b cs - CapVar -> - Encode.string "CapVar" + PCtor nameRegion name patterns -> + pCtorEncoder nameRegion name patterns + PCtorQual nameRegion home name patterns -> + pCtorQualEncoder nameRegion home name patterns -varTypeDecoder : Decode.Decoder VarType -varTypeDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "LowVar" -> - Decode.succeed LowVar + PList patterns -> + pListEncoder patterns - "CapVar" -> - Decode.succeed CapVar + PCons hd tl -> + pConsEncoder hd tl - _ -> - Decode.fail ("Unknown VarType: " ++ str) - ) + PChr chr -> + pChrEncoder chr + PStr str -> + pStrEncoder str -defEncoder : Def -> Encode.Value -defEncoder def = - case def of - Define name srcArgs body maybeType -> - Encode.object - [ ( "type", Encode.string "Define" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "srcArgs", Encode.list patternEncoder srcArgs ) - , ( "body", exprEncoder body ) - , ( "maybeType", E.maybe typeEncoder maybeType ) - ] - - Destruct pattern body -> - Encode.object - [ ( "type", Encode.string "Destruct" ) - , ( "pattern", patternEncoder pattern ) - , ( "body", exprEncoder body ) - ] - - -defDecoder : Decode.Decoder Def -defDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Define" -> - Decode.map4 Define - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "srcArgs" (Decode.list patternDecoder)) - (Decode.field "body" exprDecoder) - (Decode.field "maybeType" (Decode.maybe typeDecoder)) - - "Destruct" -> - Decode.map2 Destruct - (Decode.field "pattern" patternDecoder) - (Decode.field "body" exprDecoder) - - _ -> - Decode.fail ("Failed to decode Def's type: " ++ type_) + PInt int -> + pIntEncoder int + ) + |> Serialize.variant0 PAnything + |> Serialize.variant1 PVar Serialize.string + |> Serialize.variant1 PRecord (Serialize.list (A.locatedCodec Serialize.string)) + |> Serialize.variant2 + PAlias + (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec))) + (A.locatedCodec Serialize.string) + |> Serialize.variant0 PUnit + |> Serialize.variant3 + PTuple + (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec))) + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec)))) + |> Serialize.variant3 + PCtor + A.regionCodec + Serialize.string + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec)))) + |> Serialize.variant4 + PCtorQual + A.regionCodec + Serialize.string + Serialize.string + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec)))) + |> Serialize.variant1 PList (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec)))) + |> Serialize.variant2 + PCons + (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> pattern_Codec))) + |> Serialize.variant1 PChr Serialize.string + |> Serialize.variant1 PStr Serialize.string + |> Serialize.variant1 PInt Serialize.int + |> Serialize.finishCustomType + + +exprCodec : Codec e Expr +exprCodec = + A.locatedCodec (Serialize.lazy (\() -> expr_Codec)) + + +expr_Codec : Codec e Expr_ +expr_Codec = + Serialize.customType + (\chrEncoder strEncoder intEncoder floatEncoder varEncoder varQualEncoder listEncoder opEncoder negateEncoder binopsEncoder lambdaEncoder callEncoder ifEncoder letEncoder caseEncoder accessorEncoder accessEncoder updateEncoder recordEncoder unitEncoder tupleEncoder shaderEncoder value -> + case value of + Chr char -> + chrEncoder char + + Str string -> + strEncoder string + + Int int -> + intEncoder int + + Float float -> + floatEncoder float + + Var varType name -> + varEncoder varType name + + VarQual varType prefix name -> + varQualEncoder varType prefix name + + List list -> + listEncoder list + + Op op -> + opEncoder op + + Negate expr -> + negateEncoder expr + + Binops ops final -> + binopsEncoder ops final + + Lambda srcArgs body -> + lambdaEncoder srcArgs body + + Call func args -> + callEncoder func args + + If branches finally -> + ifEncoder branches finally + + Let defs expr -> + letEncoder defs expr + + Case expr branches -> + caseEncoder expr branches + + Accessor field -> + accessorEncoder field + + Access record field -> + accessEncoder record field + + Update name fields -> + updateEncoder name fields + + Record fields -> + recordEncoder fields + + Unit -> + unitEncoder + + Tuple a b cs -> + tupleEncoder a b cs + + Shader src tipe -> + shaderEncoder src tipe + ) + |> Serialize.variant1 Chr Serialize.string + |> Serialize.variant1 Str Serialize.string + |> Serialize.variant1 Int Serialize.int + |> Serialize.variant1 Float Serialize.float + |> Serialize.variant2 Var varTypeCodec Serialize.string + |> Serialize.variant3 VarQual varTypeCodec Serialize.string Serialize.string + |> Serialize.variant1 List (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + |> Serialize.variant1 Op Serialize.string + |> Serialize.variant1 Negate (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 + Binops + (Serialize.list + (Serialize.tuple (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) (A.locatedCodec Serialize.string)) ) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 + Lambda + (Serialize.list (A.locatedCodec pattern_Codec)) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 + Call + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + |> Serialize.variant2 + If + (Serialize.list + (Serialize.tuple + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + ) + ) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 + Let + (Serialize.list (A.locatedCodec defCodec)) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + |> Serialize.variant2 + Case + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (Serialize.list + (Serialize.tuple (A.locatedCodec pattern_Codec) (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + ) + |> Serialize.variant1 Accessor Serialize.string + |> Serialize.variant2 + Access + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (A.locatedCodec Serialize.string) + |> Serialize.variant2 + Update + (A.locatedCodec Serialize.string) + (Serialize.list + (Serialize.tuple (A.locatedCodec Serialize.string) (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + ) + |> Serialize.variant1 + Record + (Serialize.list + (Serialize.tuple (A.locatedCodec Serialize.string) (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + ) + |> Serialize.variant0 Unit + |> Serialize.variant3 + Tuple + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (A.locatedCodec (Serialize.lazy (\() -> expr_Codec))) + (Serialize.list (A.locatedCodec (Serialize.lazy (\() -> expr_Codec)))) + |> Serialize.variant2 Shader Shader.sourceCodec Shader.typesCodec + |> Serialize.finishCustomType + + +varTypeCodec : Codec e VarType +varTypeCodec = + Serialize.customType + (\lowVarEncoder capVarEncoder value -> + case value of + LowVar -> + lowVarEncoder + + CapVar -> + capVarEncoder + ) + |> Serialize.variant0 LowVar + |> Serialize.variant0 CapVar + |> Serialize.finishCustomType + + +defCodec : Codec e Def +defCodec = + Serialize.customType + (\defineEncoder destructEncoder value -> + case value of + Define name srcArgs body maybeType -> + defineEncoder name srcArgs body maybeType + + Destruct pattern body -> + destructEncoder pattern body + ) + |> Serialize.variant4 Define (A.locatedCodec Serialize.string) (Serialize.list patternCodec) exprCodec (Serialize.maybe typeCodec) + |> Serialize.variant2 Destruct patternCodec exprCodec + |> Serialize.finishCustomType diff --git a/src/Compiler/AST/Utils/Binop.elm b/src/Compiler/AST/Utils/Binop.elm index c6ffcc4de..bea5ee8ab 100644 --- a/src/Compiler/AST/Utils/Binop.elm +++ b/src/Compiler/AST/Utils/Binop.elm @@ -1,14 +1,11 @@ module Compiler.AST.Utils.Binop exposing ( Associativity(..) , Precedence - , associativityDecoder - , associativityEncoder - , precedenceDecoder - , precedenceEncoder + , associativityCodec + , precedenceCodec ) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -25,44 +22,26 @@ type Associativity | Right -precedenceEncoder : Precedence -> Encode.Value -precedenceEncoder = - Encode.int +precedenceCodec : Codec e Precedence +precedenceCodec = + Serialize.int -precedenceDecoder : Decode.Decoder Precedence -precedenceDecoder = - Decode.int +associativityCodec : Codec e Associativity +associativityCodec = + Serialize.customType + (\leftEncoder nonEncoder rightEncoder value -> + case value of + Left -> + leftEncoder + Non -> + nonEncoder -associativityEncoder : Associativity -> Encode.Value -associativityEncoder associativity = - case associativity of - Left -> - Encode.string "Left" - - Non -> - Encode.string "Non" - - Right -> - Encode.string "Right" - - -associativityDecoder : Decode.Decoder Associativity -associativityDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "Left" -> - Decode.succeed Left - - "Non" -> - Decode.succeed Non - - "Right" -> - Decode.succeed Right - - _ -> - Decode.fail ("Unknown Associativity: " ++ str) - ) + Right -> + rightEncoder + ) + |> Serialize.variant0 Left + |> Serialize.variant0 Non + |> Serialize.variant0 Right + |> Serialize.finishCustomType diff --git a/src/Compiler/AST/Utils/Shader.elm b/src/Compiler/AST/Utils/Shader.elm index 3c0151dc8..5b10dc989 100644 --- a/src/Compiler/AST/Utils/Shader.elm +++ b/src/Compiler/AST/Utils/Shader.elm @@ -3,18 +3,15 @@ module Compiler.AST.Utils.Shader exposing , Type(..) , Types(..) , fromString - , sourceDecoder - , sourceEncoder + , sourceCodec , toJsStringBuilder - , typesDecoder - , typesEncoder + , typesCodec ) import Compiler.Data.Name exposing (Name) -import Compiler.Json.Encode as E -import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Compiler.Serialize as S +import Data.Map exposing (Dict) +import Serialize exposing (Codec) @@ -99,103 +96,56 @@ escape = -- ENCODERS and DECODERS -sourceEncoder : Source -> Encode.Value -sourceEncoder (Source src) = - Encode.string src +sourceCodec : Codec e Source +sourceCodec = + Serialize.string |> Serialize.map Source (\(Source src) -> src) -sourceDecoder : Decode.Decoder Source -sourceDecoder = - Decode.map Source Decode.string - - -typesEncoder : Types -> Encode.Value -typesEncoder (Types attribute uniform varying) = - Encode.object - [ ( "type", Encode.string "Types" ) - , ( "attribute", E.assocListDict compare Encode.string typeEncoder attribute ) - , ( "uniform", E.assocListDict compare Encode.string typeEncoder uniform ) - , ( "varying", E.assocListDict compare Encode.string typeEncoder varying ) - ] - - -typesDecoder : Decode.Decoder Types -typesDecoder = - Decode.map3 Types - (Decode.field "attribute" (assocListDict identity Decode.string typeDecoder)) - (Decode.field "uniform" (assocListDict identity Decode.string typeDecoder)) - (Decode.field "varying" (assocListDict identity Decode.string typeDecoder)) - - -typeEncoder : Type -> Encode.Value -typeEncoder type_ = - case type_ of - Int -> - Encode.string "Int" - - Float -> - Encode.string "Float" - - V2 -> - Encode.string "V2" - - V3 -> - Encode.string "V3" - - V4 -> - Encode.string "V4" - - M4 -> - Encode.string "M4" - - Texture -> - Encode.string "Texture" - - -typeDecoder : Decode.Decoder Type -typeDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "Int" -> - Decode.succeed Int - - "Float" -> - Decode.succeed Float - - "V2" -> - Decode.succeed V2 - - "V3" -> - Decode.succeed V3 - - "V4" -> - Decode.succeed V4 - - "M4" -> - Decode.succeed M4 - - "Texture" -> - Decode.succeed Texture +typesCodec : Codec e Types +typesCodec = + Serialize.customType + (\typesCodecEncoder (Types attribute uniform varying) -> + typesCodecEncoder attribute uniform varying + ) + |> Serialize.variant3 + Types + (S.assocListDict identity compare Serialize.string typeCodec) + (S.assocListDict identity compare Serialize.string typeCodec) + (S.assocListDict identity compare Serialize.string typeCodec) + |> Serialize.finishCustomType - _ -> - Decode.fail ("Unknown Type: " ++ str) - ) +typeCodec : Codec e Type +typeCodec = + Serialize.customType + (\intEncoder floatEncoder v2Encoder v3Encoder v4Encoder m4Encoder textureEncoder value -> + case value of + Int -> + intEncoder + Float -> + floatEncoder --- COPIED FROM JSON.DECODEX + V2 -> + v2Encoder + V3 -> + v3Encoder -assocListDict : (k -> comparable) -> Decode.Decoder k -> Decode.Decoder v -> Decode.Decoder (Dict comparable k v) -assocListDict toComparable keyDecoder valueDecoder = - Decode.list (jsonPair keyDecoder valueDecoder) - |> Decode.map (Dict.fromList toComparable) + V4 -> + v4Encoder + M4 -> + m4Encoder -jsonPair : Decode.Decoder a -> Decode.Decoder b -> Decode.Decoder ( a, b ) -jsonPair firstDecoder secondDecoder = - Decode.map2 Tuple.pair - (Decode.field "a" firstDecoder) - (Decode.field "b" secondDecoder) + Texture -> + textureEncoder + ) + |> Serialize.variant0 Int + |> Serialize.variant0 Float + |> Serialize.variant0 V2 + |> Serialize.variant0 V3 + |> Serialize.variant0 V4 + |> Serialize.variant0 M4 + |> Serialize.variant0 Texture + |> Serialize.finishCustomType diff --git a/src/Compiler/Data/Index.elm b/src/Compiler/Data/Index.elm index 6c769cf91..6b83e7012 100644 --- a/src/Compiler/Data/Index.elm +++ b/src/Compiler/Data/Index.elm @@ -9,12 +9,10 @@ module Compiler.Data.Index exposing , third , toHuman , toMachine - , zeroBasedDecoder - , zeroBasedEncoder + , zeroBasedCodec ) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -103,11 +101,6 @@ indexedZipWithHelp func index listX listY revListZ = -- ENCODERS and DECODERS -zeroBasedEncoder : ZeroBased -> Encode.Value -zeroBasedEncoder (ZeroBased zeroBased) = - Encode.int zeroBased - - -zeroBasedDecoder : Decode.Decoder ZeroBased -zeroBasedDecoder = - Decode.map ZeroBased Decode.int +zeroBasedCodec : Codec e ZeroBased +zeroBasedCodec = + Serialize.int |> Serialize.map ZeroBased (\(ZeroBased zeroBased) -> zeroBased) diff --git a/src/Compiler/Elm/Compiler/Type.elm b/src/Compiler/Elm/Compiler/Type.elm index a26cebd72..6f4cd625f 100644 --- a/src/Compiler/Elm/Compiler/Type.elm +++ b/src/Compiler/Elm/Compiler/Type.elm @@ -3,11 +3,10 @@ module Compiler.Elm.Compiler.Type exposing , DebugMetadata(..) , Type(..) , Union(..) + , codec , decoder , encode , encodeMetadata - , jsonDecoder - , jsonEncoder , toDoc ) @@ -22,8 +21,7 @@ import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Render.Type.Localizer as L -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import Utils.Crash exposing (crash) @@ -202,84 +200,40 @@ toVariantObject ( name, args ) = -- ENCODERS and DECODERS -jsonEncoder : Type -> Encode.Value -jsonEncoder type_ = - case type_ of - Lambda arg body -> - Encode.object - [ ( "type", Encode.string "Lambda" ) - , ( "arg", jsonEncoder arg ) - , ( "body", jsonEncoder body ) - ] +codec : Codec e Type +codec = + Serialize.customType + (\lambdaEncoder varEncoder typeEncoder recordEncoder unitEncoder tupleEncoder value -> + case value of + Lambda arg body -> + lambdaEncoder arg body - Var name -> - Encode.object - [ ( "type", Encode.string "Var" ) - , ( "name", Encode.string name ) - ] + Var name -> + varEncoder name - Type name args -> - Encode.object - [ ( "type", Encode.string "Type" ) - , ( "name", Encode.string name ) - , ( "args", Encode.list jsonEncoder args ) - ] + Type name args -> + typeEncoder name args - Record fields ext -> - Encode.object - [ ( "type", Encode.string "Record" ) - , ( "fields", Encode.list (E.jsonPair Encode.string jsonEncoder) fields ) - , ( "ext", E.maybe Encode.string ext ) - ] + Record fields ext -> + recordEncoder fields ext - Unit -> - Encode.object - [ ( "type", Encode.string "Unit" ) - ] + Unit -> + unitEncoder - Tuple a b cs -> - Encode.object - [ ( "type", Encode.string "Tuple" ) - , ( "a", jsonEncoder a ) - , ( "b", jsonEncoder b ) - , ( "cs", Encode.list jsonEncoder cs ) - ] - - -jsonDecoder : Decode.Decoder Type -jsonDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Lambda" -> - Decode.map2 Lambda - (Decode.field "arg" jsonDecoder) - (Decode.field "body" jsonDecoder) - - "Var" -> - Decode.map Var - (Decode.field "name" Decode.string) - - "Type" -> - Decode.map2 Type - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list jsonDecoder)) - - "Record" -> - Decode.map2 Record - (Decode.field "fields" (Decode.list (D.jsonPair Decode.string jsonDecoder))) - (Decode.field "ext" (Decode.maybe Decode.string)) - - "Unit" -> - Decode.succeed Unit - - "Tuple" -> - Decode.map3 Tuple - (Decode.field "a" jsonDecoder) - (Decode.field "b" jsonDecoder) - (Decode.field "cs" (Decode.list jsonDecoder)) - - _ -> - Decode.fail ("Failed to decode Type's type: " ++ type_) - ) + Tuple a b cs -> + tupleEncoder a b cs + ) + |> Serialize.variant2 Lambda (Serialize.lazy (\() -> codec)) (Serialize.lazy (\() -> codec)) + |> Serialize.variant1 Var Serialize.string + |> Serialize.variant2 Type Serialize.string (Serialize.list (Serialize.lazy (\() -> codec))) + |> Serialize.variant2 + Record + (Serialize.list (Serialize.tuple Serialize.string (Serialize.lazy (\() -> codec)))) + (Serialize.maybe Serialize.string) + |> Serialize.variant0 Unit + |> Serialize.variant3 + Tuple + (Serialize.lazy (\() -> codec)) + (Serialize.lazy (\() -> codec)) + (Serialize.list (Serialize.lazy (\() -> codec))) + |> Serialize.finishCustomType diff --git a/src/Compiler/Elm/Compiler/Type/Extract.elm b/src/Compiler/Elm/Compiler/Type/Extract.elm index e1377e71b..35db4a9d7 100644 --- a/src/Compiler/Elm/Compiler/Type/Extract.elm +++ b/src/Compiler/Elm/Compiler/Type/Extract.elm @@ -7,8 +7,7 @@ module Compiler.Elm.Compiler.Type.Extract exposing , fromType , merge , mergeMany - , typesDecoder - , typesEncoder + , typesCodec ) import Compiler.AST.Canonical as Can @@ -18,13 +17,11 @@ import Compiler.Data.Name as Name import Compiler.Elm.Compiler.Type as T 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 Compiler.Serialize as S import Data.Map as Dict exposing (Dict) import Data.Set as EverySet exposing (EverySet) -import Json.Decode as Decode -import Json.Encode as Encode import Maybe.Extra as Maybe +import Serialize exposing (Codec) import System.TypeCheck.IO as IO import Utils.Main as Utils @@ -315,27 +312,24 @@ tupleTraverse f ( a, b ) = -- ENCODERS and DECODERS -typesEncoder : Types -> Encode.Value -typesEncoder (Types types) = - E.assocListDict ModuleName.compareCanonical ModuleName.canonicalEncoder types_Encoder types - - -typesDecoder : Decode.Decoder Types -typesDecoder = - Decode.map Types (D.assocListDict ModuleName.toComparableCanonical ModuleName.canonicalDecoder types_Decoder) - - -types_Encoder : Types_ -> Encode.Value -types_Encoder (Types_ unionInfo aliasInfo) = - Encode.object - [ ( "type", Encode.string "Types_" ) - , ( "unionInfo", E.assocListDict compare Encode.string Can.unionEncoder unionInfo ) - , ( "aliasInfo", E.assocListDict compare Encode.string Can.aliasEncoder aliasInfo ) - ] +typesCodec : Codec e Types +typesCodec = + Serialize.customType + (\typesCodecEncoder (Types types) -> + typesCodecEncoder types + ) + |> Serialize.variant1 Types (S.assocListDict ModuleName.toComparableCanonical ModuleName.compareCanonical ModuleName.canonicalCodec types_Codec) + |> Serialize.finishCustomType -types_Decoder : Decode.Decoder Types_ -types_Decoder = - Decode.map2 Types_ - (Decode.field "unionInfo" (D.assocListDict identity Decode.string Can.unionDecoder)) - (Decode.field "aliasInfo" (D.assocListDict identity Decode.string Can.aliasDecoder)) +types_Codec : Codec e Types_ +types_Codec = + Serialize.customType + (\types_CodecEncoder (Types_ unionInfo aliasInfo) -> + types_CodecEncoder unionInfo aliasInfo + ) + |> Serialize.variant2 + Types_ + (S.assocListDict identity compare Serialize.string Can.unionCodec) + (S.assocListDict identity compare Serialize.string Can.aliasCodec) + |> Serialize.finishCustomType diff --git a/src/Compiler/Elm/Docs.elm b/src/Compiler/Elm/Docs.elm index 0df6831e4..df5fd769d 100644 --- a/src/Compiler/Elm/Docs.elm +++ b/src/Compiler/Elm/Docs.elm @@ -10,10 +10,8 @@ module Compiler.Elm.Docs exposing , decoder , encode , fromModule - , jsonDecoder - , jsonEncoder - , jsonModuleDecoder - , jsonModuleEncoder + , jsonCodec + , moduleCodec ) import Basics.Extra exposing (flip) @@ -36,9 +34,9 @@ import Compiler.Parse.Variable as Var import Compiler.Reporting.Annotation as A import Compiler.Reporting.Error.Docs as E import Compiler.Reporting.Result as Result +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.TypeCheck.IO as IO import Utils.Main as Utils @@ -771,102 +769,67 @@ addDef types def = -- ENCODERS and DECODERS -jsonEncoder : Documentation -> Encode.Value -jsonEncoder = - E.toJsonValue << encode +jsonCodec : Codec e Documentation +jsonCodec = + S.assocListDict identity compare Serialize.string moduleCodec -jsonDecoder : Decode.Decoder Documentation -jsonDecoder = - Decode.map toDict (Decode.list jsonModuleDecoder) - - -jsonModuleEncoder : Module -> Encode.Value -jsonModuleEncoder (Module name comment unions aliases values binops) = - Encode.object - [ ( "name", Encode.string name ) - , ( "comment", Encode.string comment ) - , ( "unions", E.assocListDict compare Encode.string jsonUnionEncoder unions ) - , ( "aliases", E.assocListDict compare Encode.string jsonAliasEncoder aliases ) - , ( "values", E.assocListDict compare Encode.string jsonValueEncoder values ) - , ( "binops", E.assocListDict compare Encode.string jsonBinopEncoder binops ) - ] - - -jsonModuleDecoder : Decode.Decoder Module -jsonModuleDecoder = - Decode.map6 Module - (Decode.field "name" Decode.string) - (Decode.field "comment" Decode.string) - (Decode.field "unions" (D.assocListDict identity Decode.string jsonUnionDecoder)) - (Decode.field "aliases" (D.assocListDict identity Decode.string jsonAliasDecoder)) - (Decode.field "values" (D.assocListDict identity Decode.string jsonValueDecoder)) - (Decode.field "binops" (D.assocListDict identity Decode.string jsonBinopDecoder)) - - -jsonUnionEncoder : Union -> Encode.Value -jsonUnionEncoder (Union comment args cases) = - Encode.object - [ ( "comment", Encode.string comment ) - , ( "args", Encode.list Encode.string args ) - , ( "cases", Encode.list (E.jsonPair Encode.string (Encode.list Type.jsonEncoder)) cases ) - ] - - -jsonUnionDecoder : Decode.Decoder Union -jsonUnionDecoder = - Decode.map3 Union - (Decode.field "comment" Decode.string) - (Decode.field "args" (Decode.list Decode.string)) - (Decode.field "cases" (Decode.list (D.jsonPair Decode.string (Decode.list Type.jsonDecoder)))) - - -jsonAliasEncoder : Alias -> Encode.Value -jsonAliasEncoder (Alias comment args type_) = - Encode.object - [ ( "comment", Encode.string comment ) - , ( "args", Encode.list Encode.string args ) - , ( "type", Type.jsonEncoder type_ ) - ] - - -jsonAliasDecoder : Decode.Decoder Alias -jsonAliasDecoder = - Decode.map3 Alias - (Decode.field "comment" Decode.string) - (Decode.field "args" (Decode.list Decode.string)) - (Decode.field "type" Type.jsonDecoder) - - -jsonValueEncoder : Value -> Encode.Value -jsonValueEncoder (Value comment type_) = - Encode.object - [ ( "comment", Encode.string comment ) - , ( "type", Type.jsonEncoder type_ ) - ] - - -jsonValueDecoder : Decode.Decoder Value -jsonValueDecoder = - Decode.map2 Value - (Decode.field "comment" Decode.string) - (Decode.field "type" Type.jsonDecoder) +moduleCodec : Codec e Module +moduleCodec = + Serialize.customType + (\moduleEncoder (Module name comment unions aliases values binops) -> + moduleEncoder name comment unions aliases values binops + ) + |> Serialize.variant6 + Module + Serialize.string + Serialize.string + (S.assocListDict identity compare Serialize.string unionCodec) + (S.assocListDict identity compare Serialize.string aliasCodec) + (S.assocListDict identity compare Serialize.string valueCodec) + (S.assocListDict identity compare Serialize.string binopCodec) + |> Serialize.finishCustomType + + +unionCodec : Codec e Union +unionCodec = + Serialize.customType + (\unionEncoder (Union comment args cases) -> + unionEncoder comment args cases + ) + |> Serialize.variant3 + Union + Serialize.string + (Serialize.list Serialize.string) + (Serialize.list (Serialize.tuple Serialize.string (Serialize.list Type.codec))) + |> Serialize.finishCustomType + + +aliasCodec : Codec e Alias +aliasCodec = + Serialize.customType + (\aliasEncoder (Alias comment args type_) -> + aliasEncoder comment args type_ + ) + |> Serialize.variant3 Alias Serialize.string (Serialize.list Serialize.string) Type.codec + |> Serialize.finishCustomType -jsonBinopEncoder : Binop -> Encode.Value -jsonBinopEncoder (Binop comment type_ associativity precedence) = - Encode.object - [ ( "comment", Encode.string comment ) - , ( "type", Type.jsonEncoder type_ ) - , ( "associativity", Binop.associativityEncoder associativity ) - , ( "precedence", Binop.precedenceEncoder precedence ) - ] +valueCodec : Codec e Value +valueCodec = + Serialize.customType + (\valueEncoder (Value comment type_) -> + valueEncoder comment type_ + ) + |> Serialize.variant2 Value Serialize.string Type.codec + |> Serialize.finishCustomType -jsonBinopDecoder : Decode.Decoder Binop -jsonBinopDecoder = - Decode.map4 Binop - (Decode.field "comment" Decode.string) - (Decode.field "type" Type.jsonDecoder) - (Decode.field "associativity" Binop.associativityDecoder) - (Decode.field "precedence" Binop.precedenceDecoder) +binopCodec : Codec e Binop +binopCodec = + Serialize.customType + (\binopEncoder (Binop comment type_ associativity precedence) -> + binopEncoder comment type_ associativity precedence + ) + |> Serialize.variant4 Binop Serialize.string Type.codec Binop.associativityCodec Binop.precedenceCodec + |> Serialize.finishCustomType diff --git a/src/Compiler/Elm/Interface.elm b/src/Compiler/Elm/Interface.elm index f8d2c7ce0..ef0e03d1a 100644 --- a/src/Compiler/Elm/Interface.elm +++ b/src/Compiler/Elm/Interface.elm @@ -4,13 +4,11 @@ module Compiler.Elm.Interface exposing , DependencyInterface(..) , Interface(..) , Union(..) - , dependencyInterfaceDecoder - , dependencyInterfaceEncoder + , dependencyInterfaceCodec , extractAlias , extractUnion , fromModule - , interfaceDecoder - , interfaceEncoder + , interfaceCodec , private , privatize , public @@ -22,12 +20,10 @@ import Compiler.AST.Canonical as Can import Compiler.AST.Utils.Binop as Binop import Compiler.Data.Name as Name import Compiler.Elm.Package as Pkg -import Compiler.Json.Decode as D -import Compiler.Json.Encode as E import Compiler.Reporting.Annotation as A +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import Utils.Crash exposing (crash) import Utils.Main as Utils @@ -208,161 +204,78 @@ privatize di = -- ENCODERS and DECODERS -interfaceEncoder : Interface -> Encode.Value -interfaceEncoder (Interface home values unions aliases binops) = - Encode.object - [ ( "type", Encode.string "Interface" ) - , ( "home", Pkg.nameEncoder home ) - , ( "values", E.assocListDict compare Encode.string Can.annotationEncoder values ) - , ( "unions", E.assocListDict compare Encode.string unionEncoder unions ) - , ( "aliases", E.assocListDict compare Encode.string aliasEncoder aliases ) - , ( "binops", E.assocListDict compare Encode.string binopEncoder binops ) - ] - - -interfaceDecoder : Decode.Decoder Interface -interfaceDecoder = - Decode.map5 Interface - (Decode.field "home" Pkg.nameDecoder) - (Decode.field "values" (D.assocListDict identity Decode.string Can.annotationDecoder)) - (Decode.field "unions" (D.assocListDict identity Decode.string unionDecoder)) - (Decode.field "aliases" (D.assocListDict identity Decode.string aliasDecoder)) - (Decode.field "binops" (D.assocListDict identity Decode.string binopDecoder)) - - -unionEncoder : Union -> Encode.Value -unionEncoder union_ = - case union_ of - OpenUnion union -> - Encode.object - [ ( "type", Encode.string "OpenUnion" ) - , ( "union", Can.unionEncoder union ) - ] - - ClosedUnion union -> - Encode.object - [ ( "type", Encode.string "ClosedUnion" ) - , ( "union", Can.unionEncoder union ) - ] - - PrivateUnion union -> - Encode.object - [ ( "type", Encode.string "ClosedUnion" ) - , ( "union", Can.unionEncoder union ) - ] - - -unionDecoder : Decode.Decoder Union -unionDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "OpenUnion" -> - Decode.map OpenUnion - (Decode.field "union" Can.unionDecoder) - - "ClosedUnion" -> - Decode.map ClosedUnion - (Decode.field "union" Can.unionDecoder) - - "PrivateUnion" -> - Decode.map ClosedUnion - (Decode.field "union" Can.unionDecoder) - - _ -> - Decode.fail ("Unknown Union's type: " ++ type_) - ) - - -aliasEncoder : Alias -> Encode.Value -aliasEncoder aliasValue = - case aliasValue of - PublicAlias alias_ -> - Encode.object - [ ( "type", Encode.string "PublicAlias" ) - , ( "alias", Can.aliasEncoder alias_ ) - ] - - PrivateAlias alias_ -> - Encode.object - [ ( "type", Encode.string "PrivateAlias" ) - , ( "alias", Can.aliasEncoder alias_ ) - ] - - -aliasDecoder : Decode.Decoder Alias -aliasDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PublicAlias" -> - Decode.map PublicAlias - (Decode.field "alias" Can.aliasDecoder) - - "PrivateAlias" -> - Decode.map PrivateAlias - (Decode.field "alias" Can.aliasDecoder) - - _ -> - Decode.fail ("Unknown Alias' type: " ++ type_) - ) - - -binopEncoder : Binop -> Encode.Value -binopEncoder (Binop name annotation associativity precedence) = - Encode.object - [ ( "type", Encode.string "Binop" ) - , ( "name", Encode.string name ) - , ( "annotation", Can.annotationEncoder annotation ) - , ( "associativity", Binop.associativityEncoder associativity ) - , ( "precedence", Binop.precedenceEncoder precedence ) - ] - - -binopDecoder : Decode.Decoder Binop -binopDecoder = - Decode.map4 Binop - (Decode.field "name" Decode.string) - (Decode.field "annotation" Can.annotationDecoder) - (Decode.field "associativity" Binop.associativityDecoder) - (Decode.field "precedence" Binop.precedenceDecoder) - - -dependencyInterfaceEncoder : DependencyInterface -> Encode.Value -dependencyInterfaceEncoder dependencyInterface = - case dependencyInterface of - Public i -> - Encode.object - [ ( "type", Encode.string "Public" ) - , ( "i", interfaceEncoder i ) - ] - - Private pkg unions aliases -> - Encode.object - [ ( "type", Encode.string "Private" ) - , ( "pkg", Pkg.nameEncoder pkg ) - , ( "unions", E.assocListDict compare Encode.string Can.unionEncoder unions ) - , ( "aliases", E.assocListDict compare Encode.string Can.aliasEncoder aliases ) - ] - - -dependencyInterfaceDecoder : Decode.Decoder DependencyInterface -dependencyInterfaceDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Public" -> - Decode.map Public (Decode.field "i" interfaceDecoder) - - "Private" -> - Decode.map3 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)) - - _ -> - Decode.fail ("Failed to decode DependencyInterface's type: " ++ type_) - ) +interfaceCodec : Codec e Interface +interfaceCodec = + Serialize.customType + (\interfaceCodecEncoder (Interface home values unions aliases binops) -> + interfaceCodecEncoder home values unions aliases binops + ) + |> Serialize.variant5 Interface + Pkg.nameCodec + (S.assocListDict identity compare Serialize.string Can.annotationCodec) + (S.assocListDict identity compare Serialize.string unionCodec) + (S.assocListDict identity compare Serialize.string aliasCodec) + (S.assocListDict identity compare Serialize.string binopCodec) + |> Serialize.finishCustomType + + +unionCodec : Codec e Union +unionCodec = + Serialize.customType + (\openUnionEncoder closedUnionEncoder privateUnionEncoder value -> + case value of + OpenUnion union -> + openUnionEncoder union + + ClosedUnion union -> + closedUnionEncoder union + + PrivateUnion union -> + privateUnionEncoder union + ) + |> Serialize.variant1 OpenUnion Can.unionCodec + |> Serialize.variant1 ClosedUnion Can.unionCodec + |> Serialize.variant1 PrivateUnion Can.unionCodec + |> Serialize.finishCustomType + + +aliasCodec : Codec e Alias +aliasCodec = + Serialize.customType + (\publicAliasEncoder privateAliasEncoder value -> + case value of + PublicAlias alias_ -> + publicAliasEncoder alias_ + + PrivateAlias alias_ -> + privateAliasEncoder alias_ + ) + |> Serialize.variant1 PublicAlias Can.aliasCodec + |> Serialize.variant1 PrivateAlias Can.aliasCodec + |> Serialize.finishCustomType + + +binopCodec : Codec e Binop +binopCodec = + Serialize.customType + (\binopCodecEncoder (Binop name annotation associativity precedence) -> + binopCodecEncoder name annotation associativity precedence + ) + |> Serialize.variant4 Binop Serialize.string Can.annotationCodec Binop.associativityCodec Binop.precedenceCodec + |> Serialize.finishCustomType + + +dependencyInterfaceCodec : Codec e DependencyInterface +dependencyInterfaceCodec = + Serialize.customType + (\publicEncoder privateEncoder dependencyInterface -> + case dependencyInterface of + Public i -> + publicEncoder i + + Private pkg unions aliases -> + privateEncoder pkg unions aliases + ) + |> Serialize.variant1 Public interfaceCodec + |> Serialize.variant3 Private Pkg.nameCodec (S.assocListDict identity compare Serialize.string Can.unionCodec) (S.assocListDict identity compare Serialize.string Can.aliasCodec) + |> Serialize.finishCustomType diff --git a/src/Compiler/Elm/Kernel.elm b/src/Compiler/Elm/Kernel.elm index aa3218ff9..b2a681cb9 100644 --- a/src/Compiler/Elm/Kernel.elm +++ b/src/Compiler/Elm/Kernel.elm @@ -2,8 +2,7 @@ module Compiler.Elm.Kernel exposing ( Chunk(..) , Content(..) , Foreigns - , chunkDecoder - , chunkEncoder + , chunkCodec , countFields , fromByteString ) @@ -18,8 +17,7 @@ import Compiler.Parse.Space as Space import Compiler.Parse.Variable as Var import Compiler.Reporting.Annotation as A import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.TypeCheck.IO as IO import Utils.Crash exposing (crash) @@ -417,92 +415,41 @@ toName exposed = -- ENCODERS and DECODERS -chunkEncoder : Chunk -> Encode.Value -chunkEncoder chunk = - case chunk of - JS javascript -> - Encode.object - [ ( "type", Encode.string "JS" ) - , ( "javascript", Encode.string javascript ) - ] - - ElmVar home name -> - Encode.object - [ ( "type", Encode.string "ElmVar" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - ] - - JsVar home name -> - Encode.object - [ ( "type", Encode.string "JsVar" ) - , ( "home", Encode.string home ) - , ( "name", Encode.string name ) - ] - - ElmField name -> - Encode.object - [ ( "type", Encode.string "ElmField" ) - , ( "name", Encode.string name ) - ] - - JsField int -> - Encode.object - [ ( "type", Encode.string "JsField" ) - , ( "int", Encode.int int ) - ] - - JsEnum int -> - Encode.object - [ ( "type", Encode.string "JsEnum" ) - , ( "int", Encode.int int ) - ] - - Debug -> - Encode.object - [ ( "type", Encode.string "Debug" ) - ] - - Prod -> - Encode.object - [ ( "type", Encode.string "Prod" ) - ] +chunkCodec : Codec e Chunk +chunkCodec = + Serialize.customType + (\jsEncoder elmVarEncoder jsVarEncoder elmFieldEncoder jsFieldEncoder jsEnumEncoder debugEncoder prodEncoder chunk -> + case chunk of + JS javascript -> + jsEncoder javascript + ElmVar home name -> + elmVarEncoder home name -chunkDecoder : Decode.Decoder Chunk -chunkDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "JS" -> - Decode.map JS (Decode.field "javascript" Decode.string) + JsVar home name -> + jsVarEncoder home name - "ElmVar" -> - Decode.map2 ElmVar - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) + ElmField name -> + elmFieldEncoder name - "JsVar" -> - Decode.map2 JsVar - (Decode.field "home" Decode.string) - (Decode.field "name" Decode.string) + JsField int -> + jsFieldEncoder int - "ElmField" -> - Decode.map ElmField (Decode.field "name" Decode.string) + JsEnum int -> + jsEnumEncoder int - "JsField" -> - Decode.map JsField (Decode.field "int" Decode.int) + Debug -> + debugEncoder - "JsEnum" -> - Decode.map JsEnum (Decode.field "int" Decode.int) - - "Debug" -> - Decode.succeed Debug - - "Prod" -> - Decode.succeed Prod - - _ -> - Decode.fail ("Unknown Chunk's type: " ++ type_) - ) + Prod -> + prodEncoder + ) + |> Serialize.variant1 JS Serialize.string + |> Serialize.variant2 ElmVar ModuleName.canonicalCodec Serialize.string + |> Serialize.variant2 JsVar Serialize.string Serialize.string + |> Serialize.variant1 ElmField Serialize.string + |> Serialize.variant1 JsField Serialize.int + |> Serialize.variant1 JsEnum Serialize.int + |> Serialize.variant0 Debug + |> Serialize.variant0 Prod + |> Serialize.finishCustomType diff --git a/src/Compiler/Elm/ModuleName.elm b/src/Compiler/Elm/ModuleName.elm index 9c59c8d0a..e337454ec 100644 --- a/src/Compiler/Elm/ModuleName.elm +++ b/src/Compiler/Elm/ModuleName.elm @@ -2,8 +2,7 @@ module Compiler.Elm.ModuleName exposing ( Raw , array , basics - , canonicalDecoder - , canonicalEncoder + , canonicalCodec , char , cmd , compareCanonical @@ -17,8 +16,7 @@ module Compiler.Elm.ModuleName exposing , matrix4 , maybe , platform - , rawDecoder - , rawEncoder + , rawCodec , result , string , sub @@ -41,8 +39,7 @@ import Compiler.Json.Decode as D import Compiler.Json.Encode as E import Compiler.Parse.Primitives as P import Compiler.Parse.Variable as Var -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.TypeCheck.IO exposing (Canonical(..)) @@ -320,26 +317,16 @@ matrix4 = -- ENCODERS and DECODERS -canonicalEncoder : Canonical -> Encode.Value -canonicalEncoder (Canonical pkgName name) = - Encode.object - [ ( "pkgName", Pkg.nameEncoder pkgName ) - , ( "name", Encode.string name ) - ] - - -canonicalDecoder : Decode.Decoder Canonical -canonicalDecoder = - Decode.map2 Canonical - (Decode.field "pkgName" Pkg.nameDecoder) - (Decode.field "name" Decode.string) - - -rawEncoder : Raw -> Encode.Value -rawEncoder = - Encode.string +canonicalCodec : Codec e Canonical +canonicalCodec = + Serialize.customType + (\canonicalCodecEncoder (Canonical pkgName name) -> + canonicalCodecEncoder pkgName name + ) + |> Serialize.variant2 Canonical Pkg.nameCodec Serialize.string + |> Serialize.finishCustomType -rawDecoder : Decode.Decoder Raw -rawDecoder = - Decode.string +rawCodec : Codec e Raw +rawCodec = + Serialize.string diff --git a/src/Compiler/Elm/Package.elm b/src/Compiler/Elm/Package.elm index 4b168f8ab..2fb678da7 100644 --- a/src/Compiler/Elm/Package.elm +++ b/src/Compiler/Elm/Package.elm @@ -14,8 +14,7 @@ module Compiler.Elm.Package exposing , kernel , keyDecoder , linearAlgebra - , nameDecoder - , nameEncoder + , nameCodec , nearbyNames , parser , suggestions @@ -32,8 +31,7 @@ import Compiler.Json.Encode as E import Compiler.Parse.Primitives as P exposing (Col, Row) import Compiler.Reporting.Suggest as Suggest import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -369,16 +367,11 @@ chompName isGoodChar src pos end prevWasDash = -- ENCODERS and DECODERS -nameEncoder : Name -> Encode.Value -nameEncoder ( author, project ) = - Encode.object - [ ( "author", Encode.string author ) - , ( "project", Encode.string project ) - ] - - -nameDecoder : Decode.Decoder Name -nameDecoder = - Decode.map2 Tuple.pair - (Decode.field "author" Decode.string) - (Decode.field "project" Decode.string) +nameCodec : Codec e Name +nameCodec = + Serialize.customType + (\nameCodecEncoder ( author, project ) -> + nameCodecEncoder author project + ) + |> Serialize.variant2 Tuple.pair Serialize.string Serialize.string + |> Serialize.finishCustomType diff --git a/src/Compiler/Elm/Version.elm b/src/Compiler/Elm/Version.elm index 58d58e406..d3bae4643 100644 --- a/src/Compiler/Elm/Version.elm +++ b/src/Compiler/Elm/Version.elm @@ -7,8 +7,7 @@ module Compiler.Elm.Version exposing , compiler , decoder , encode - , jsonDecoder - , jsonEncoder + , jsonCodec , major , max , maxVersion @@ -17,15 +16,13 @@ module Compiler.Elm.Version exposing , parser , toChars , toComparable - , versionDecoder - , versionEncoder + , versionCodec ) import Compiler.Json.Decode as D import Compiler.Json.Encode as E import Compiler.Parse.Primitives as P exposing (Col, Row) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -233,38 +230,21 @@ isDigit word = -- ENCODERS and DECODERS -jsonDecoder : Decode.Decoder Version -jsonDecoder = - Decode.string - |> Decode.andThen - (\str -> - case P.fromByteString parser Tuple.pair str of - Ok version -> - Decode.succeed version - - Err _ -> - Decode.fail "failed to parse version" - ) - - -versionEncoder : Version -> Encode.Value -versionEncoder (Version major_ minor_ patch_) = - Encode.object - [ ( "type", Encode.string "Version" ) - , ( "major", Encode.int major_ ) - , ( "minor", Encode.int minor_ ) - , ( "patch", Encode.int patch_ ) - ] - - -versionDecoder : Decode.Decoder Version -versionDecoder = - Decode.map3 Version - (Decode.field "major" Decode.int) - (Decode.field "minor" Decode.int) - (Decode.field "patch" Decode.int) - - -jsonEncoder : Version -> Encode.Value -jsonEncoder version = - Encode.string (toChars version) +jsonCodec : Codec e Version +jsonCodec = + Serialize.customType + (\versionCodecEncoder (Version major_ minor patch) -> + versionCodecEncoder major_ minor patch + ) + |> Serialize.variant3 Version Serialize.int Serialize.int Serialize.int + |> Serialize.finishCustomType + + +versionCodec : Codec e Version +versionCodec = + Serialize.customType + (\versionCodecEncoder (Version major_ minor patch) -> + versionCodecEncoder major_ minor patch + ) + |> Serialize.variant3 Version Serialize.int Serialize.int Serialize.int + |> Serialize.finishCustomType diff --git a/src/Compiler/Json/Decode.elm b/src/Compiler/Json/Decode.elm index 431160056..60f7a6006 100644 --- a/src/Compiler/Json/Decode.elm +++ b/src/Compiler/Json/Decode.elm @@ -7,107 +7,34 @@ module Compiler.Json.Decode exposing , Problem(..) , StringProblem(..) , apply - , assocListDict , bind , customString , dict - , everySet , failure , field , fmap , fromByteString , int - , jsonPair , list , mapError , nonEmptyList - , nonempty , oneOf - , oneOrMore , pair , pairs , pure - , result , string ) import Compiler.Data.NonEmptyList as NE -import Compiler.Data.OneOrMore as OneOrMore exposing (OneOrMore) import Compiler.Json.String as Json import Compiler.Parse.Keyword as K import Compiler.Parse.Primitives as P exposing (Col, Row) import Compiler.Reporting.Annotation as A import Data.Map as Dict exposing (Dict) -import Data.Set as EverySet exposing (EverySet) -import Json.Decode as Decode import Utils.Crash exposing (crash) --- CORE HELPERS - - -assocListDict : (k -> comparable) -> Decode.Decoder k -> Decode.Decoder v -> Decode.Decoder (Dict comparable k v) -assocListDict toComparable keyDecoder valueDecoder = - Decode.list (jsonPair keyDecoder valueDecoder) - |> Decode.map (Dict.fromList toComparable) - - -jsonPair : Decode.Decoder a -> Decode.Decoder b -> Decode.Decoder ( a, b ) -jsonPair firstDecoder secondDecoder = - Decode.map2 Tuple.pair - (Decode.field "a" firstDecoder) - (Decode.field "b" secondDecoder) - - -everySet : (a -> comparable) -> Decode.Decoder a -> Decode.Decoder (EverySet comparable a) -everySet toComparable decoder = - Decode.list decoder - |> Decode.map (EverySet.fromList toComparable) - - -nonempty : Decode.Decoder a -> Decode.Decoder (NE.Nonempty a) -nonempty decoder = - Decode.list decoder - |> Decode.andThen - (\values -> - case values of - x :: xs -> - Decode.succeed (NE.Nonempty x xs) - - [] -> - Decode.fail "Empty list when it should have at least one element (non-empty list)!" - ) - - -oneOrMore : Decode.Decoder a -> Decode.Decoder (OneOrMore a) -oneOrMore decoder = - Decode.oneOf - [ Decode.map OneOrMore.one (Decode.field "one" decoder) - , Decode.map2 OneOrMore.more - (Decode.field "left" (Decode.lazy (\_ -> oneOrMore decoder))) - (Decode.field "right" (Decode.lazy (\_ -> oneOrMore decoder))) - ] - - -result : Decode.Decoder x -> Decode.Decoder a -> Decode.Decoder (Result x a) -result errDecoder successDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Err" -> - Decode.map Err (Decode.field "value" errDecoder) - - "Ok" -> - Decode.map Ok (Decode.field "value" successDecoder) - - _ -> - Decode.fail ("Failed to decode result's type: " ++ type_) - ) - - - -- RUNNERS diff --git a/src/Compiler/Json/Encode.elm b/src/Compiler/Json/Encode.elm index 890df1c51..892aad592 100644 --- a/src/Compiler/Json/Encode.elm +++ b/src/Compiler/Json/Encode.elm @@ -1,104 +1,25 @@ module Compiler.Json.Encode exposing ( Value(..) , array - , assocListDict , bool , chars , dict , encodeUgly - , everySet , int - , jsonPair , list - , maybe , name - , nonempty , null - , number , object - , oneOrMore - , result , string - , toJsonValue , write , writeUgly ) -import Compiler.Data.NonEmptyList as NE -import Compiler.Data.OneOrMore exposing (OneOrMore(..)) import Data.Map as Dict exposing (Dict) -import Data.Set as EverySet exposing (EverySet) -import Json.Encode as Encode import System.IO as IO exposing (IO(..)) --- CORE HELPERS - - -assocListDict : (k -> k -> Order) -> (k -> Encode.Value) -> (v -> Encode.Value) -> Dict c k v -> Encode.Value -assocListDict keyComparison keyEncoder valueEncoder = - Encode.list (jsonPair keyEncoder valueEncoder) << List.reverse << Dict.toList keyComparison - - -jsonPair : (a -> Encode.Value) -> (b -> Encode.Value) -> ( a, b ) -> Encode.Value -jsonPair firstEncoder secondEncoder ( a, b ) = - Encode.object - [ ( "a", firstEncoder a ) - , ( "b", secondEncoder b ) - ] - - -everySet : (a -> a -> Order) -> (a -> Encode.Value) -> EverySet c a -> Encode.Value -everySet keyComparison encoder = - Encode.list encoder << List.reverse << EverySet.toList keyComparison - - -result : (x -> Encode.Value) -> (a -> Encode.Value) -> Result x a -> Encode.Value -result errEncoder successEncoder resultValue = - case resultValue of - Ok value -> - Encode.object - [ ( "type", Encode.string "Ok" ) - , ( "value", successEncoder value ) - ] - - Err err -> - Encode.object - [ ( "type", Encode.string "Err" ) - , ( "value", errEncoder err ) - ] - - -maybe : (a -> Encode.Value) -> Maybe a -> Encode.Value -maybe encoder maybeValue = - case maybeValue of - Just value -> - encoder value - - Nothing -> - Encode.null - - -nonempty : (a -> Encode.Value) -> NE.Nonempty a -> Encode.Value -nonempty encoder (NE.Nonempty x xs) = - Encode.list encoder (x :: xs) - - -oneOrMore : (a -> Encode.Value) -> OneOrMore a -> Encode.Value -oneOrMore encoder oneOrMore_ = - case oneOrMore_ of - One value -> - Encode.object [ ( "one", encoder value ) ] - - More left right -> - Encode.object - [ ( "left", oneOrMore encoder left ) - , ( "right", oneOrMore encoder right ) - ] - - - -- VALUES @@ -142,11 +63,6 @@ int = Integer -number : Float -> Value -number = - Number - - null : Value null = Null @@ -359,32 +275,3 @@ encodeObject indent first rest = encodeField : String -> ( String, Value ) -> String encodeField indent ( key, value ) = "\"" ++ key ++ "\": " ++ encodeHelp indent value - - - --- JSON VALUE - - -toJsonValue : Value -> Encode.Value -toJsonValue value = - case value of - Array arr -> - Encode.list toJsonValue arr - - Object obj -> - Encode.object (List.map (Tuple.mapSecond toJsonValue) obj) - - StringVal builder -> - Encode.string builder - - Boolean boolean -> - Encode.bool boolean - - Integer n -> - Encode.int n - - Number scientific -> - Encode.float scientific - - Null -> - Encode.null diff --git a/src/Compiler/Nitpick/PatternMatches.elm b/src/Compiler/Nitpick/PatternMatches.elm index a2f95806f..900700c59 100644 --- a/src/Compiler/Nitpick/PatternMatches.elm +++ b/src/Compiler/Nitpick/PatternMatches.elm @@ -4,8 +4,7 @@ module Compiler.Nitpick.PatternMatches exposing , Literal(..) , Pattern(..) , check - , errorDecoder - , errorEncoder + , errorCodec ) {- The algorithm used here comes from "Warnings for Pattern Matching" @@ -22,10 +21,9 @@ import Compiler.Data.NonEmptyList as NE import Compiler.Elm.ModuleName as ModuleName import Compiler.Reporting.Annotation as A import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode import List.Extra as List import Prelude +import Serialize exposing (Codec) import Utils.Crash exposing (crash) import Utils.Main as Utils @@ -712,165 +710,81 @@ collectCtorsHelp ctors row = -- ENCODERS and DECODERS -errorEncoder : Error -> Encode.Value -errorEncoder error = - case error of - Incomplete region context unhandled -> - Encode.object - [ ( "type", Encode.string "Incomplete" ) - , ( "region", A.regionEncoder region ) - , ( "context", contextEncoder context ) - , ( "unhandled", Encode.list patternEncoder unhandled ) - ] - - Redundant caseRegion patternRegion index -> - Encode.object - [ ( "type", Encode.string "Redundant" ) - , ( "caseRegion", A.regionEncoder caseRegion ) - , ( "patternRegion", A.regionEncoder patternRegion ) - , ( "index", Encode.int index ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Incomplete" -> - Decode.map3 Incomplete - (Decode.field "region" A.regionDecoder) - (Decode.field "context" contextDecoder) - (Decode.field "unhandled" (Decode.list patternDecoder)) - - "Redundant" -> - Decode.map3 Redundant - (Decode.field "caseRegion" A.regionDecoder) - (Decode.field "patternRegion" A.regionDecoder) - (Decode.field "index" Decode.int) - - _ -> - Decode.fail ("Unknown Error's type: " ++ type_) - ) - - -contextEncoder : Context -> Encode.Value -contextEncoder context = - case context of - BadArg -> - Encode.string "BadArg" - - BadDestruct -> - Encode.string "BadDestruct" - - BadCase -> - Encode.string "BadCase" - - -contextDecoder : Decode.Decoder Context -contextDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "BadArg" -> - Decode.succeed BadArg - - "BadDestruct" -> - Decode.succeed BadDestruct - - "BadCase" -> - Decode.succeed BadCase - - _ -> - Decode.fail ("Unknown Context: " ++ str) - ) - - -patternEncoder : Pattern -> Encode.Value -patternEncoder pattern = - case pattern of - Anything -> - Encode.object - [ ( "type", Encode.string "Anything" ) - ] - - Literal index -> - Encode.object - [ ( "type", Encode.string "Literal" ) - , ( "index", literalEncoder index ) - ] - - Ctor union name args -> - Encode.object - [ ( "type", Encode.string "Ctor" ) - , ( "union", Can.unionEncoder union ) - , ( "name", Encode.string name ) - , ( "args", Encode.list patternEncoder args ) - ] - - -patternDecoder : Decode.Decoder Pattern -patternDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Anything" -> - Decode.succeed Anything - - "Literal" -> - Decode.map Literal (Decode.field "index" literalDecoder) - - "Ctor" -> - Decode.map3 Ctor - (Decode.field "union" Can.unionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list patternDecoder)) - - _ -> - Decode.fail ("Unknown Pattern's type: " ++ type_) - ) - - -literalEncoder : Literal -> Encode.Value -literalEncoder literal = - case literal of - Chr value -> - Encode.object - [ ( "type", Encode.string "Chr" ) - , ( "value", Encode.string value ) - ] - - Str value -> - Encode.object - [ ( "type", Encode.string "Str" ) - , ( "value", Encode.string value ) - ] - - Int value -> - Encode.object - [ ( "type", Encode.string "Int" ) - , ( "value", Encode.int value ) - ] - - -literalDecoder : Decode.Decoder Literal -literalDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Chr" -> - Decode.map Chr (Decode.field "value" Decode.string) - - "Str" -> - Decode.map Str (Decode.field "value" Decode.string) - - "Int" -> - Decode.map Int (Decode.field "value" Decode.int) - - _ -> - Decode.fail ("Unknown Literal's type: " ++ type_) - ) +errorCodec : Codec e Error +errorCodec = + Serialize.customType + (\incompleteEncoder redundantEncoder value -> + case value of + Incomplete region context unhandled -> + incompleteEncoder region context unhandled + + Redundant caseRegion patternRegion index -> + redundantEncoder caseRegion patternRegion index + ) + |> Serialize.variant3 Incomplete A.regionCodec contextCodec (Serialize.list patternCodec) + |> Serialize.variant3 Redundant A.regionCodec A.regionCodec Serialize.int + |> Serialize.finishCustomType + + +contextCodec : Codec e Context +contextCodec = + Serialize.customType + (\badArgEncoder badDestructEncoder badCaseEncoder value -> + case value of + BadArg -> + badArgEncoder + + BadDestruct -> + badDestructEncoder + + BadCase -> + badCaseEncoder + ) + |> Serialize.variant0 BadArg + |> Serialize.variant0 BadDestruct + |> Serialize.variant0 BadCase + |> Serialize.finishCustomType + + +patternCodec : Codec e Pattern +patternCodec = + Serialize.customType + (\anythingEncoder literalCodecEncoder ctorEncoder value -> + case value of + Anything -> + anythingEncoder + + Literal index -> + literalCodecEncoder index + + Ctor union name args -> + ctorEncoder union name args + ) + |> Serialize.variant0 Anything + |> Serialize.variant1 Literal literalCodec + |> Serialize.variant3 + Ctor + Can.unionCodec + Serialize.string + (Serialize.list (Serialize.lazy (\() -> patternCodec))) + |> Serialize.finishCustomType + + +literalCodec : Codec e Literal +literalCodec = + Serialize.customType + (\chrEncoder strEncoder intEncoder literal -> + case literal of + Chr value -> + chrEncoder value + + Str value -> + strEncoder value + + Int value -> + intEncoder value + ) + |> Serialize.variant1 Chr Serialize.string + |> Serialize.variant1 Str Serialize.string + |> Serialize.variant1 Int Serialize.int + |> Serialize.finishCustomType diff --git a/src/Compiler/Optimize/DecisionTree.elm b/src/Compiler/Optimize/DecisionTree.elm index 50f6d4612..0bbe81b14 100644 --- a/src/Compiler/Optimize/DecisionTree.elm +++ b/src/Compiler/Optimize/DecisionTree.elm @@ -3,10 +3,8 @@ module Compiler.Optimize.DecisionTree exposing , Path(..) , Test(..) , compile - , pathDecoder - , pathEncoder - , testDecoder - , testEncoder + , pathCodec + , testCodec ) {- To learn more about how this works, definitely read through: @@ -26,9 +24,8 @@ import Compiler.Data.Name as Name import Compiler.Elm.ModuleName as ModuleName import Compiler.Reporting.Annotation as A import Data.Set as EverySet -import Json.Decode as Decode -import Json.Encode as Encode import Prelude +import Serialize exposing (Codec) import System.TypeCheck.IO as IO import Utils.Crash exposing (crash) import Utils.Main as Utils @@ -307,12 +304,12 @@ testsAtPath selectedPath branches = skipVisited : Test -> ( List Test, EverySet.EverySet String Test ) -> ( List Test, EverySet.EverySet String Test ) skipVisited test (( uniqueTests, visitedTests ) as curr) = - if EverySet.member (Encode.encode 0 << testEncoder) test visitedTests then + if EverySet.member (Serialize.encodeToString testCodec) test visitedTests then curr else ( test :: uniqueTests - , EverySet.insert (Encode.encode 0 << testEncoder) test visitedTests + , EverySet.insert (Serialize.encodeToString testCodec) test visitedTests ) in Tuple.first (List.foldr skipVisited ( [], EverySet.empty ) allTests) @@ -695,138 +692,61 @@ smallBranchingFactor branches path = -- ENCODERS and DECODERS -pathEncoder : Path -> Encode.Value -pathEncoder path_ = - case path_ of - Index index path -> - Encode.object - [ ( "type", Encode.string "Index" ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "path", pathEncoder path ) - ] - - Unbox path -> - Encode.object - [ ( "type", Encode.string "Unbox" ) - , ( "path", pathEncoder path ) - ] - - Empty -> - Encode.object - [ ( "type", Encode.string "Empty" ) - ] - - -pathDecoder : Decode.Decoder Path -pathDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Index" -> - Decode.map2 Index - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "path" pathDecoder) - - "Unbox" -> - Decode.map Unbox (Decode.field "path" pathDecoder) - - "Empty" -> - Decode.succeed Empty - - _ -> - Decode.fail ("Unknown Path's type: " ++ type_) - ) - - -testEncoder : Test -> Encode.Value -testEncoder test = - case test of - IsCtor home name index numAlts opts -> - Encode.object - [ ( "type", Encode.string "IsCtor" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "numAlts", Encode.int numAlts ) - , ( "opts", Can.ctorOptsEncoder opts ) - ] - - IsCons -> - Encode.object - [ ( "type", Encode.string "IsCons" ) - ] - - IsNil -> - Encode.object - [ ( "type", Encode.string "IsNil" ) - ] - - IsTuple -> - Encode.object - [ ( "type", Encode.string "IsTuple" ) - ] - - IsInt value -> - Encode.object - [ ( "type", Encode.string "IsInt" ) - , ( "value", Encode.int value ) - ] - - IsChr value -> - Encode.object - [ ( "type", Encode.string "IsChr" ) - , ( "value", Encode.string value ) - ] - - IsStr value -> - Encode.object - [ ( "type", Encode.string "IsStr" ) - , ( "value", Encode.string value ) - ] - - IsBool value -> - Encode.object - [ ( "type", Encode.string "IsBool" ) - , ( "value", Encode.bool value ) - ] - - -testDecoder : Decode.Decoder Test -testDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "IsCtor" -> - Decode.map5 IsCtor - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "numAlts" Decode.int) - (Decode.field "opts" Can.ctorOptsDecoder) - - "IsCons" -> - Decode.succeed IsCons - - "IsNil" -> - Decode.succeed IsNil - - "IsTuple" -> - Decode.succeed IsTuple - - "IsInt" -> - Decode.map IsInt (Decode.field "value" Decode.int) - - "IsChr" -> - Decode.map IsChr (Decode.field "value" Decode.string) - - "IsStr" -> - Decode.map IsStr (Decode.field "value" Decode.string) - - "IsBool" -> - Decode.map IsBool (Decode.field "value" Decode.bool) - - _ -> - Decode.fail ("Unknown Test's type: " ++ type_) - ) +pathCodec : Codec e Path +pathCodec = + Serialize.customType + (\indexEncoder unboxEncoder emptyEncoder value -> + case value of + Index index path -> + indexEncoder index path + + Unbox path -> + unboxEncoder path + + Empty -> + emptyEncoder + ) + |> Serialize.variant2 Index Index.zeroBasedCodec (Serialize.lazy (\() -> pathCodec)) + |> Serialize.variant1 Unbox (Serialize.lazy (\() -> pathCodec)) + |> Serialize.variant0 Empty + |> Serialize.finishCustomType + + +testCodec : Codec e Test +testCodec = + Serialize.customType + (\isCtorEncoder isConsEncoder isNilEncoder isTupleEncoder isIntEncoder isChrEncoder isStrEncoder isBoolEncoder test -> + case test of + IsCtor home name index numAlts opts -> + isCtorEncoder home name index numAlts opts + + IsCons -> + isConsEncoder + + IsNil -> + isNilEncoder + + IsTuple -> + isTupleEncoder + + IsInt value -> + isIntEncoder value + + IsChr value -> + isChrEncoder value + + IsStr value -> + isStrEncoder value + + IsBool value -> + isBoolEncoder value + ) + |> Serialize.variant5 IsCtor ModuleName.canonicalCodec Serialize.string Index.zeroBasedCodec Serialize.int Can.ctorOptsCodec + |> Serialize.variant0 IsCons + |> Serialize.variant0 IsNil + |> Serialize.variant0 IsTuple + |> Serialize.variant1 IsInt Serialize.int + |> Serialize.variant1 IsChr Serialize.string + |> Serialize.variant1 IsStr Serialize.string + |> Serialize.variant1 IsBool Serialize.bool + |> Serialize.finishCustomType diff --git a/src/Compiler/Parse/Primitives.elm b/src/Compiler/Parse/Primitives.elm index eb679e8cf..ae674d535 100644 --- a/src/Compiler/Parse/Primitives.elm +++ b/src/Compiler/Parse/Primitives.elm @@ -22,8 +22,7 @@ module Compiler.Parse.Primitives exposing , oneOf , oneOfWithFallback , pure - , snippetDecoder - , snippetEncoder + , snippetCodec , specialize , unsafeIndex , withBacksetIndent @@ -33,8 +32,7 @@ module Compiler.Parse.Primitives exposing ) import Compiler.Reporting.Annotation as A -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import Utils.Crash exposing (crash) @@ -389,35 +387,26 @@ getCharWidth word = -- ENCODERS and DECODERS -snippetEncoder : Snippet -> Encode.Value -snippetEncoder (Snippet { fptr, offset, length, offRow, offCol }) = - Encode.object - [ ( "type", Encode.string "Snippet" ) - , ( "fptr", Encode.string fptr ) - , ( "offset", Encode.int offset ) - , ( "length", Encode.int length ) - , ( "offRow", Encode.int offRow ) - , ( "offCol", Encode.int offCol ) - ] - - -snippetDecoder : Decode.Decoder Snippet -snippetDecoder = - Decode.map5 - (\fptr offset length offRow offCol -> - Snippet - { fptr = fptr - , offset = offset - , length = length - , offRow = offRow - , offCol = offCol - } +snippetCodec : Codec e Snippet +snippetCodec = + Serialize.customType + (\snippetCodecEncoder (Snippet snippet) -> + snippetCodecEncoder snippet ) - (Decode.field "fptr" Decode.string) - (Decode.field "offset" Decode.int) - (Decode.field "length" Decode.int) - (Decode.field "offRow" Decode.int) - (Decode.field "offCol" Decode.int) + |> Serialize.variant1 + Snippet + (Serialize.record + (\fptr offset length offRow offCol -> + { fptr = fptr, offset = offset, length = length, offRow = offRow, offCol = offCol } + ) + |> Serialize.field .fptr Serialize.string + |> Serialize.field .offset Serialize.int + |> Serialize.field .length Serialize.int + |> Serialize.field .offRow Serialize.int + |> Serialize.field .offCol Serialize.int + |> Serialize.finishRecord + ) + |> Serialize.finishCustomType diff --git a/src/Compiler/Parse/Symbol.elm b/src/Compiler/Parse/Symbol.elm index 326b12b4e..1efcfccb9 100644 --- a/src/Compiler/Parse/Symbol.elm +++ b/src/Compiler/Parse/Symbol.elm @@ -1,7 +1,6 @@ module Compiler.Parse.Symbol exposing ( BadOperator(..) - , badOperatorDecoder - , badOperatorEncoder + , badOperatorCodec , binopCharSet , operator ) @@ -9,8 +8,7 @@ module Compiler.Parse.Symbol exposing import Compiler.Data.Name exposing (Name) import Compiler.Parse.Primitives as P exposing (Col, Parser, Row) import Data.Set as EverySet exposing (EverySet) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -95,46 +93,29 @@ binopCharSet = -- ENCODERS and DECODERS -badOperatorEncoder : BadOperator -> Encode.Value -badOperatorEncoder badOperator = - case badOperator of - BadDot -> - Encode.string "BadDot" - - BadPipe -> - Encode.string "BadPipe" - - BadArrow -> - Encode.string "BadArrow" - - BadEquals -> - Encode.string "BadEquals" - - BadHasType -> - Encode.string "BadHasType" - - -badOperatorDecoder : Decode.Decoder BadOperator -badOperatorDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "BadDot" -> - Decode.succeed BadDot - - "BadPipe" -> - Decode.succeed BadPipe - - "BadArrow" -> - Decode.succeed BadArrow - - "BadEquals" -> - Decode.succeed BadEquals - - "BadHasType" -> - Decode.succeed BadHasType - - _ -> - Decode.fail ("Unknown BadOperator: " ++ str) - ) +badOperatorCodec : Codec e BadOperator +badOperatorCodec = + Serialize.customType + (\badDotEncoder badPipeEncoder badArrowEncoder badEqualsEncoder badHasTypeEncoder badOperator -> + case badOperator of + BadDot -> + badDotEncoder + + BadPipe -> + badPipeEncoder + + BadArrow -> + badArrowEncoder + + BadEquals -> + badEqualsEncoder + + BadHasType -> + badHasTypeEncoder + ) + |> Serialize.variant0 BadDot + |> Serialize.variant0 BadPipe + |> Serialize.variant0 BadArrow + |> Serialize.variant0 BadEquals + |> Serialize.variant0 BadHasType + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Annotation.elm b/src/Compiler/Reporting/Annotation.elm index 2524c5464..43de36501 100644 --- a/src/Compiler/Reporting/Annotation.elm +++ b/src/Compiler/Reporting/Annotation.elm @@ -3,21 +3,18 @@ module Compiler.Reporting.Annotation exposing , Position(..) , Region(..) , at - , locatedDecoder - , locatedEncoder + , locatedCodec , merge , mergeRegions , one - , regionDecoder - , regionEncoder + , regionCodec , toRegion , toValue , traverse , zero ) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.TypeCheck.IO as IO exposing (IO) @@ -89,49 +86,31 @@ one = -- ENCODERS and DECODERS -regionEncoder : Region -> Encode.Value -regionEncoder (Region start end) = - Encode.object - [ ( "type", Encode.string "Region" ) - , ( "start", positionEncoder start ) - , ( "end", positionEncoder end ) - ] - - -regionDecoder : Decode.Decoder Region -regionDecoder = - Decode.map2 Region - (Decode.field "start" positionDecoder) - (Decode.field "end" positionDecoder) - - -positionEncoder : Position -> Encode.Value -positionEncoder (Position start end) = - Encode.object - [ ( "type", Encode.string "Position" ) - , ( "start", Encode.int start ) - , ( "end", Encode.int end ) - ] - - -positionDecoder : Decode.Decoder Position -positionDecoder = - Decode.map2 Position - (Decode.field "start" Decode.int) - (Decode.field "end" Decode.int) - - -locatedEncoder : (a -> Encode.Value) -> Located a -> Encode.Value -locatedEncoder encoder (At region value) = - Encode.object - [ ( "type", Encode.string "Located" ) - , ( "region", regionEncoder region ) - , ( "value", encoder value ) - ] - - -locatedDecoder : Decode.Decoder a -> Decode.Decoder (Located a) -locatedDecoder decoder = - Decode.map2 At - (Decode.field "region" regionDecoder) - (Decode.field "value" (Decode.lazy (\_ -> decoder))) +regionCodec : Codec e Region +regionCodec = + Serialize.customType + (\regionCodecEncoder (Region start end) -> + regionCodecEncoder start end + ) + |> Serialize.variant2 Region positionCodec positionCodec + |> Serialize.finishCustomType + + +positionCodec : Codec e Position +positionCodec = + Serialize.customType + (\positionCodecEncoder (Position start end) -> + positionCodecEncoder start end + ) + |> Serialize.variant2 Position Serialize.int Serialize.int + |> Serialize.finishCustomType + + +locatedCodec : Codec e a -> Codec e (Located a) +locatedCodec a = + Serialize.customType + (\atEncoder (At region value) -> + atEncoder region value + ) + |> Serialize.variant2 At regionCodec a + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Doc.elm b/src/Compiler/Reporting/Doc.elm index 911fca56e..f8c5e8d34 100644 --- a/src/Compiler/Reporting/Doc.elm +++ b/src/Compiler/Reporting/Doc.elm @@ -12,7 +12,7 @@ module Compiler.Reporting.Doc exposing , stack, reflow, commaSep , toSimpleNote, toFancyNote, toSimpleHint, toFancyHint , link, fancyLink, reflowLink, makeLink, makeNakedLink - , args, moreArgs, ordinal, intToOrdinal, cycle + , args, ordinal, intToOrdinal, cycle ) {-| @@ -30,7 +30,7 @@ module Compiler.Reporting.Doc exposing @docs stack, reflow, commaSep @docs toSimpleNote, toFancyNote, toSimpleHint, toFancyHint @docs link, fancyLink, reflowLink, makeLink, makeNakedLink -@docs args, moreArgs, ordinal, intToOrdinal, cycle +@docs args, ordinal, intToOrdinal, cycle -} @@ -212,18 +212,6 @@ args n = ) -moreArgs : Int -> String -moreArgs n = - String.fromInt n - ++ " more" - ++ (if n == 1 then - " argument" - - else - " arguments" - ) - - ordinal : Index.ZeroBased -> String ordinal index = intToOrdinal (Index.toHuman index) diff --git a/src/Compiler/Reporting/Error.elm b/src/Compiler/Reporting/Error.elm index 837e18ece..cf19d89b3 100644 --- a/src/Compiler/Reporting/Error.elm +++ b/src/Compiler/Reporting/Error.elm @@ -1,9 +1,7 @@ module Compiler.Reporting.Error exposing ( Error(..) , Module - , jsonToJson - , moduleDecoder - , moduleEncoder + , moduleCodec , toDoc , toJson ) @@ -12,7 +10,6 @@ import Builder.File as File import Compiler.Data.NonEmptyList as NE import Compiler.Data.OneOrMore as OneOrMore exposing (OneOrMore) import Compiler.Elm.ModuleName as ModuleName -import Compiler.Json.Decode as DecodeX import Compiler.Json.Encode as E import Compiler.Nitpick.PatternMatches as P import Compiler.Reporting.Annotation as A @@ -27,8 +24,8 @@ import Compiler.Reporting.Error.Type as Type import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Render.Type.Localizer as L import Compiler.Reporting.Report as Report -import Json.Decode as Decode -import Json.Encode as Encode +import Compiler.Serialize as S +import Serialize exposing (Codec) import Time import Utils.Main as Utils @@ -239,111 +236,48 @@ encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) = -- ENCODERS and DECODERS -jsonToJson : Module -> Encode.Value -jsonToJson = - E.toJsonValue << toJson - - -moduleEncoder : Module -> Encode.Value -moduleEncoder modul = - Encode.object - [ ( "name", ModuleName.rawEncoder modul.name ) - , ( "absolutePath", Encode.string modul.absolutePath ) - , ( "modificationTime", File.timeEncoder modul.modificationTime ) - , ( "source", Encode.string modul.source ) - , ( "error", errorEncoder modul.error ) - ] - - -moduleDecoder : Decode.Decoder Module -moduleDecoder = - Decode.map5 Module - (Decode.field "name" ModuleName.rawDecoder) - (Decode.field "absolutePath" Decode.string) - (Decode.field "modificationTime" File.timeDecoder) - (Decode.field "source" Decode.string) - (Decode.field "error" errorDecoder) - - -errorEncoder : Error -> Encode.Value -errorEncoder error = - case error of - BadSyntax syntaxError -> - Encode.object - [ ( "type", Encode.string "BadSyntax" ) - , ( "syntaxError", Syntax.errorEncoder syntaxError ) - ] - - BadImports errs -> - Encode.object - [ ( "type", Encode.string "BadImports" ) - , ( "errs", E.nonempty Import.errorEncoder errs ) - ] - - BadNames errs -> - Encode.object - [ ( "type", Encode.string "BadNames" ) - , ( "errs", E.oneOrMore Canonicalize.errorEncoder errs ) - ] - - BadTypes localizer errs -> - Encode.object - [ ( "type", Encode.string "BadTypes" ) - , ( "localizer", L.localizerEncoder localizer ) - , ( "errs", E.nonempty Type.errorEncoder errs ) - ] - - BadMains localizer errs -> - Encode.object - [ ( "type", Encode.string "BadMains" ) - , ( "localizer", L.localizerEncoder localizer ) - , ( "errs", E.oneOrMore Main.errorEncoder errs ) - ] - - BadPatterns errs -> - Encode.object - [ ( "type", Encode.string "BadPatterns" ) - , ( "errs", E.nonempty P.errorEncoder errs ) - ] - - BadDocs docsErr -> - Encode.object - [ ( "type", Encode.string "BadDocs" ) - , ( "docsErr", Docs.errorEncoder docsErr ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "BadSyntax" -> - Decode.map BadSyntax (Decode.field "syntaxError" Syntax.errorDecoder) - - "BadImports" -> - Decode.map BadImports (Decode.field "errs" (DecodeX.nonempty Import.errorDecoder)) - - "BadNames" -> - Decode.map BadNames (Decode.field "errs" (DecodeX.oneOrMore Canonicalize.errorDecoder)) - - "BadTypes" -> - Decode.map2 BadTypes - (Decode.field "localizer" L.localizerDecoder) - (Decode.field "errs" (DecodeX.nonempty Type.errorDecoder)) - - "BadMains" -> - Decode.map2 BadMains - (Decode.field "localizer" L.localizerDecoder) - (Decode.field "errs" (DecodeX.oneOrMore Main.errorDecoder)) - - "BadPatterns" -> - Decode.map BadPatterns (Decode.field "errs" (DecodeX.nonempty P.errorDecoder)) - - "BadDocs" -> - Decode.map BadDocs (Decode.field "docsErr" Docs.errorDecoder) - - _ -> - Decode.fail ("Unknown Path's type: " ++ type_) - ) +moduleCodec : Codec (Serialize.Error e) Module +moduleCodec = + Serialize.record Module + |> Serialize.field .name ModuleName.rawCodec + |> Serialize.field .absolutePath Serialize.string + |> Serialize.field .modificationTime File.timeCodec + |> Serialize.field .source Serialize.string + |> Serialize.field .error errorCodec + |> Serialize.finishRecord + + +errorCodec : Codec (Serialize.Error e) Error +errorCodec = + Serialize.customType + (\badSyntaxEncoder badImportsEncoder badNamesEncoder badTypesEncoder badMainsEncoder badPatternsEncoder badDocsEncoder value -> + case value of + BadSyntax syntaxError -> + badSyntaxEncoder syntaxError + + BadImports errs -> + badImportsEncoder errs + + BadNames errs -> + badNamesEncoder errs + + BadTypes localizer errs -> + badTypesEncoder localizer errs + + BadMains localizer errs -> + badMainsEncoder localizer errs + + BadPatterns errs -> + badPatternsEncoder errs + + BadDocs docsErr -> + badDocsEncoder docsErr + ) + |> Serialize.variant1 BadSyntax Syntax.errorCodec + |> Serialize.variant1 BadImports (S.nonempty Import.errorCodec) + |> Serialize.variant1 BadNames (S.oneOrMore Canonicalize.errorCodec) + |> Serialize.variant2 BadTypes L.localizerCodec (S.nonempty Type.errorCodec) + |> Serialize.variant2 BadMains L.localizerCodec (S.oneOrMore Main.errorCodec) + |> Serialize.variant1 BadPatterns (S.nonempty P.errorCodec) + |> Serialize.variant1 BadDocs Docs.errorCodec + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Error/Canonicalize.elm b/src/Compiler/Reporting/Error/Canonicalize.elm index b07ba8bd1..9a71639db 100644 --- a/src/Compiler/Reporting/Error/Canonicalize.elm +++ b/src/Compiler/Reporting/Error/Canonicalize.elm @@ -6,10 +6,8 @@ module Compiler.Reporting.Error.Canonicalize exposing , PortProblem(..) , PossibleNames , VarKind(..) - , errorDecoder - , errorEncoder - , invalidPayloadDecoder - , invalidPayloadEncoder + , errorCodec + , invalidPayloadCodec , toReport ) @@ -19,18 +17,16 @@ import Compiler.Data.Index as Index import Compiler.Data.Name as Name exposing (Name) import Compiler.Data.OneOrMore as OneOrMore exposing (OneOrMore) import Compiler.Elm.ModuleName as ModuleName -import Compiler.Json.Decode as DecodeX -import Compiler.Json.Encode as EncodeX import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Report as Report import Compiler.Reporting.Suggest as Suggest +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) import Data.Set as EverySet exposing (EverySet) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.TypeCheck.IO as IO @@ -1298,824 +1294,355 @@ aliasToUnionDoc name args tipe = -- ENCODERS and DECODERS -errorEncoder : Error -> Encode.Value -errorEncoder error = - case error of - AnnotationTooShort region name index leftovers -> - Encode.object - [ ( "type", Encode.string "AnnotationTooShort" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "index", Index.zeroBasedEncoder index ) - , ( "leftovers", Encode.int leftovers ) - ] - - AmbiguousVar region maybePrefix name h hs -> - Encode.object - [ ( "type", Encode.string "AmbiguousVar" ) - , ( "region", A.regionEncoder region ) - , ( "maybePrefix", EncodeX.maybe Encode.string maybePrefix ) - , ( "name", Encode.string name ) - , ( "h", ModuleName.canonicalEncoder h ) - , ( "hs", EncodeX.oneOrMore ModuleName.canonicalEncoder hs ) - ] - - AmbiguousType region maybePrefix name h hs -> - Encode.object - [ ( "type", Encode.string "AmbiguousType" ) - , ( "region", A.regionEncoder region ) - , ( "maybePrefix", EncodeX.maybe Encode.string maybePrefix ) - , ( "name", Encode.string name ) - , ( "h", ModuleName.canonicalEncoder h ) - , ( "hs", EncodeX.oneOrMore ModuleName.canonicalEncoder hs ) - ] - - AmbiguousVariant region maybePrefix name h hs -> - Encode.object - [ ( "type", Encode.string "AmbiguousVariant" ) - , ( "region", A.regionEncoder region ) - , ( "maybePrefix", EncodeX.maybe Encode.string maybePrefix ) - , ( "name", Encode.string name ) - , ( "h", ModuleName.canonicalEncoder h ) - , ( "hs", EncodeX.oneOrMore ModuleName.canonicalEncoder hs ) - ] - - AmbiguousBinop region name h hs -> - Encode.object - [ ( "type", Encode.string "AmbiguousBinop" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "h", ModuleName.canonicalEncoder h ) - , ( "hs", EncodeX.oneOrMore ModuleName.canonicalEncoder hs ) - ] - - BadArity region badArityContext name expected actual -> - Encode.object - [ ( "type", Encode.string "BadArity" ) - , ( "region", A.regionEncoder region ) - , ( "badArityContext", badArityContextEncoder badArityContext ) - , ( "name", Encode.string name ) - , ( "expected", Encode.int expected ) - , ( "actual", Encode.int actual ) - ] - - Binop region op1 op2 -> - Encode.object - [ ( "type", Encode.string "Binop" ) - , ( "region", A.regionEncoder region ) - , ( "op1", Encode.string op1 ) - , ( "op2", Encode.string op2 ) - ] - - DuplicateDecl name r1 r2 -> - Encode.object - [ ( "type", Encode.string "DuplicateDecl" ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - DuplicateType name r1 r2 -> - Encode.object - [ ( "type", Encode.string "DuplicateType" ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - DuplicateCtor name r1 r2 -> - Encode.object - [ ( "type", Encode.string "DuplicateCtor" ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - DuplicateBinop name r1 r2 -> - Encode.object - [ ( "type", Encode.string "DuplicateBinop" ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - DuplicateField name r1 r2 -> - Encode.object - [ ( "type", Encode.string "DuplicateField" ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - DuplicateAliasArg typeName name r1 r2 -> - Encode.object - [ ( "type", Encode.string "DuplicateAliasArg" ) - , ( "typeName", Encode.string typeName ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - DuplicateUnionArg typeName name r1 r2 -> - Encode.object - [ ( "type", Encode.string "DuplicateUnionArg" ) - , ( "typeName", Encode.string typeName ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - DuplicatePattern context name r1 r2 -> - Encode.object - [ ( "type", Encode.string "DuplicatePattern" ) - , ( "context", duplicatePatternContextEncoder context ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - EffectNotFound region name -> - Encode.object - [ ( "type", Encode.string "EffectNotFound" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - ] - - EffectFunctionNotFound region name -> - Encode.object - [ ( "type", Encode.string "EffectFunctionNotFound" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - ] - - ExportDuplicate name r1 r2 -> - Encode.object - [ ( "type", Encode.string "ExportDuplicate" ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - ExportNotFound region kind rawName possibleNames -> - Encode.object - [ ( "type", Encode.string "ExportNotFound" ) - , ( "region", A.regionEncoder region ) - , ( "kind", varKindEncoder kind ) - , ( "rawName", Encode.string rawName ) - , ( "possibleNames", Encode.list Encode.string possibleNames ) - ] - - ExportOpenAlias region name -> - Encode.object - [ ( "type", Encode.string "ExportOpenAlias" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - ] - - ImportCtorByName region ctor tipe -> - Encode.object - [ ( "type", Encode.string "ImportCtorByName" ) - , ( "region", A.regionEncoder region ) - , ( "ctor", Encode.string ctor ) - , ( "tipe", Encode.string tipe ) - ] - - ImportNotFound region name suggestions -> - Encode.object - [ ( "type", Encode.string "ImportNotFound" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "suggestions", Encode.list ModuleName.canonicalEncoder suggestions ) - ] - - ImportOpenAlias region name -> - Encode.object - [ ( "type", Encode.string "ImportOpenAlias" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - ] - - ImportExposingNotFound region home value possibleNames -> - Encode.object - [ ( "type", Encode.string "ImportExposingNotFound" ) - , ( "region", A.regionEncoder region ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "value", Encode.string value ) - , ( "possibleNames", Encode.list Encode.string possibleNames ) - ] - - NotFoundVar region prefix name possibleNames -> - Encode.object - [ ( "type", Encode.string "NotFoundVar" ) - , ( "region", A.regionEncoder region ) - , ( "prefix", EncodeX.maybe Encode.string prefix ) - , ( "name", Encode.string name ) - , ( "possibleNames", possibleNamesEncoder possibleNames ) - ] - - NotFoundType region prefix name possibleNames -> - Encode.object - [ ( "type", Encode.string "NotFoundType" ) - , ( "region", A.regionEncoder region ) - , ( "prefix", EncodeX.maybe Encode.string prefix ) - , ( "name", Encode.string name ) - , ( "possibleNames", possibleNamesEncoder possibleNames ) - ] - - NotFoundVariant region prefix name possibleNames -> - Encode.object - [ ( "type", Encode.string "NotFoundVariant" ) - , ( "region", A.regionEncoder region ) - , ( "prefix", EncodeX.maybe Encode.string prefix ) - , ( "name", Encode.string name ) - , ( "possibleNames", possibleNamesEncoder possibleNames ) - ] - - NotFoundBinop region op locals -> - Encode.object - [ ( "type", Encode.string "NotFoundBinop" ) - , ( "region", A.regionEncoder region ) - , ( "op", Encode.string op ) - , ( "locals", EncodeX.everySet compare Encode.string locals ) - ] - - PatternHasRecordCtor region name -> - Encode.object - [ ( "type", Encode.string "PatternHasRecordCtor" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - ] - - PortPayloadInvalid region portName badType invalidPayload -> - Encode.object - [ ( "type", Encode.string "PortPayloadInvalid" ) - , ( "region", A.regionEncoder region ) - , ( "portName", Encode.string portName ) - , ( "badType", Can.typeEncoder badType ) - , ( "invalidPayload", invalidPayloadEncoder invalidPayload ) - ] - - PortTypeInvalid region name portProblem -> - Encode.object - [ ( "type", Encode.string "PortTypeInvalid" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "portProblem", portProblemEncoder portProblem ) - ] +errorCodec : Codec e Error +errorCodec = + Serialize.customType + (\annotationTooShortEncoder ambiguousVarEncoder ambiguousTypeEncoder ambiguousVariantEncoder ambiguousBinopEncoder badArityEncoder binopEncoder duplicateDeclEncoder duplicateTypeEncoder duplicateCtorEncoder duplicateBinopEncoder duplicateFieldEncoder duplicateAliasArgEncoder duplicateUnionArgEncoder duplicatePatternEncoder effectNotFoundEncoder effectFunctionNotFoundEncoder exportDuplicateEncoder exportNotFoundEncoder exportOpenAliasEncoder importCtorByNameEncoder importNotFoundEncoder importOpenAliasEncoder importExposingNotFoundEncoder notFoundVarEncoder notFoundTypeEncoder notFoundVariantEncoder notFoundBinopEncoder patternHasRecordCtorEncoder portPayloadInvalidEncoder portTypeInvalidEncoder recursiveAliasEncoder recursiveDeclEncoder recursiveLetEncoder shadowingEncoder tupleLargerThanThreeEncoder typeVarsUnboundInUnionEncoder typeVarsMessedUpInAliasEncoder error -> + case error of + AnnotationTooShort region name index leftovers -> + annotationTooShortEncoder region name index leftovers - RecursiveAlias region name args tipe others -> - Encode.object - [ ( "type", Encode.string "RecursiveAlias" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "args", Encode.list Encode.string args ) - , ( "tipe", Src.typeEncoder tipe ) - , ( "others", Encode.list Encode.string others ) - ] + AmbiguousVar region maybePrefix name h hs -> + ambiguousVarEncoder region maybePrefix name h hs - RecursiveDecl region name names -> - Encode.object - [ ( "type", Encode.string "RecursiveDecl" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "names", Encode.list Encode.string names ) - ] + AmbiguousType region maybePrefix name h hs -> + ambiguousTypeEncoder region maybePrefix name h hs - RecursiveLet name names -> - Encode.object - [ ( "type", Encode.string "RecursiveLet" ) - , ( "name", A.locatedEncoder Encode.string name ) - , ( "names", Encode.list Encode.string names ) - ] + AmbiguousVariant region maybePrefix name h hs -> + ambiguousVariantEncoder region maybePrefix name h hs - Shadowing name r1 r2 -> - Encode.object - [ ( "type", Encode.string "Shadowing" ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] + AmbiguousBinop region name h hs -> + ambiguousBinopEncoder region name h hs - TupleLargerThanThree region -> - Encode.object - [ ( "type", Encode.string "TupleLargerThanThree" ) - , ( "region", A.regionEncoder region ) - ] + BadArity region badArityContext name expected actual -> + badArityEncoder region badArityContext name expected actual - TypeVarsUnboundInUnion unionRegion typeName allVars unbound unbounds -> - Encode.object - [ ( "type", Encode.string "TypeVarsUnboundInUnion" ) - , ( "unionRegion", A.regionEncoder unionRegion ) - , ( "typeName", Encode.string typeName ) - , ( "allVars", Encode.list Encode.string allVars ) - , ( "unbound", EncodeX.jsonPair Encode.string A.regionEncoder unbound ) - , ( "unbounds", Encode.list (EncodeX.jsonPair Encode.string A.regionEncoder) unbounds ) - ] - - TypeVarsMessedUpInAlias aliasRegion typeName allVars unusedVars unboundVars -> - Encode.object - [ ( "type", Encode.string "TypeVarsMessedUpInAlias" ) - , ( "aliasRegion", A.regionEncoder aliasRegion ) - , ( "typeName", Encode.string typeName ) - , ( "allVars", Encode.list Encode.string allVars ) - , ( "unusedVars", Encode.list (EncodeX.jsonPair Encode.string A.regionEncoder) unusedVars ) - , ( "unboundVars", Encode.list (EncodeX.jsonPair Encode.string A.regionEncoder) unboundVars ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "AnnotationTooShort" -> - Decode.map4 AnnotationTooShort - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "index" Index.zeroBasedDecoder) - (Decode.field "leftovers" Decode.int) - - "AmbiguousVar" -> - Decode.map5 AmbiguousVar - (Decode.field "region" A.regionDecoder) - (Decode.field "maybePrefix" (Decode.maybe Decode.string)) - (Decode.field "name" Decode.string) - (Decode.field "h" ModuleName.canonicalDecoder) - (Decode.field "hs" (DecodeX.oneOrMore ModuleName.canonicalDecoder)) - - "AmbiguousType" -> - Decode.map5 AmbiguousType - (Decode.field "region" A.regionDecoder) - (Decode.field "maybePrefix" (Decode.maybe Decode.string)) - (Decode.field "name" Decode.string) - (Decode.field "h" ModuleName.canonicalDecoder) - (Decode.field "hs" (DecodeX.oneOrMore ModuleName.canonicalDecoder)) - - "AmbiguousVariant" -> - Decode.map5 AmbiguousVariant - (Decode.field "region" A.regionDecoder) - (Decode.field "maybePrefix" (Decode.maybe Decode.string)) - (Decode.field "name" Decode.string) - (Decode.field "h" ModuleName.canonicalDecoder) - (Decode.field "hs" (DecodeX.oneOrMore ModuleName.canonicalDecoder)) - - "AmbiguousBinop" -> - Decode.map4 AmbiguousBinop - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "h" ModuleName.canonicalDecoder) - (Decode.field "hs" (DecodeX.oneOrMore ModuleName.canonicalDecoder)) - - "BadArity" -> - Decode.map5 BadArity - (Decode.field "region" A.regionDecoder) - (Decode.field "badArityContext" badArityContextDecoder) - (Decode.field "name" Decode.string) - (Decode.field "expected" Decode.int) - (Decode.field "actual" Decode.int) - - "Binop" -> - Decode.map3 Binop - (Decode.field "region" A.regionDecoder) - (Decode.field "op1" Decode.string) - (Decode.field "op2" Decode.string) - - "DuplicateDecl" -> - Decode.map3 DuplicateDecl - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "DuplicateType" -> - Decode.map3 DuplicateType - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "DuplicateCtor" -> - Decode.map3 DuplicateCtor - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "DuplicateBinop" -> - Decode.map3 DuplicateBinop - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "DuplicateField" -> - Decode.map3 DuplicateField - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "DuplicateAliasArg" -> - Decode.map4 DuplicateAliasArg - (Decode.field "typeName" Decode.string) - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "DuplicateUnionArg" -> - Decode.map4 DuplicateUnionArg - (Decode.field "typeName" Decode.string) - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "DuplicatePattern" -> - Decode.map4 DuplicatePattern - (Decode.field "context" duplicatePatternContextDecoder) - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "EffectNotFound" -> - Decode.map2 EffectNotFound - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - - "EffectFunctionNotFound" -> - Decode.map2 EffectFunctionNotFound - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - - "ExportDuplicate" -> - Decode.map3 ExportDuplicate - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "ExportNotFound" -> - Decode.map4 ExportNotFound - (Decode.field "region" A.regionDecoder) - (Decode.field "kind" varKindDecoder) - (Decode.field "rawName" Decode.string) - (Decode.field "possibleNames" (Decode.list Decode.string)) - - "ExportOpenAlias" -> - Decode.map2 ExportOpenAlias - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - - "ImportCtorByName" -> - Decode.map3 ImportCtorByName - (Decode.field "region" A.regionDecoder) - (Decode.field "ctor" Decode.string) - (Decode.field "tipe" Decode.string) - - "ImportNotFound" -> - Decode.map3 ImportNotFound - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "suggestions" (Decode.list ModuleName.canonicalDecoder)) - - "ImportOpenAlias" -> - Decode.map2 ImportOpenAlias - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - - "ImportExposingNotFound" -> - Decode.map4 ImportExposingNotFound - (Decode.field "region" A.regionDecoder) - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "value" Decode.string) - (Decode.field "possibleNames" (Decode.list Decode.string)) - - "NotFoundVar" -> - Decode.map4 NotFoundVar - (Decode.field "region" A.regionDecoder) - (Decode.field "prefix" (Decode.maybe Decode.string)) - (Decode.field "name" Decode.string) - (Decode.field "possibleNames" possibleNamesDecoder) - - "NotFoundType" -> - Decode.map4 NotFoundType - (Decode.field "region" A.regionDecoder) - (Decode.field "prefix" (Decode.maybe Decode.string)) - (Decode.field "name" Decode.string) - (Decode.field "possibleNames" possibleNamesDecoder) - - "NotFoundVariant" -> - Decode.map4 NotFoundVariant - (Decode.field "region" A.regionDecoder) - (Decode.field "prefix" (Decode.maybe Decode.string)) - (Decode.field "name" Decode.string) - (Decode.field "possibleNames" possibleNamesDecoder) - - "NotFoundBinop" -> - Decode.map3 NotFoundBinop - (Decode.field "region" A.regionDecoder) - (Decode.field "op" Decode.string) - (Decode.field "locals" (DecodeX.everySet identity Decode.string)) - - "PatternHasRecordCtor" -> - Decode.map2 PatternHasRecordCtor - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - - "PortPayloadInvalid" -> - Decode.map4 PortPayloadInvalid - (Decode.field "region" A.regionDecoder) - (Decode.field "portName" Decode.string) - (Decode.field "badType" Can.typeDecoder) - (Decode.field "invalidPayload" invalidPayloadDecoder) - - "PortTypeInvalid" -> - Decode.map3 PortTypeInvalid - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "portProblem" portProblemDecoder) - - "RecursiveAlias" -> - Decode.map5 RecursiveAlias - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list Decode.string)) - (Decode.field "tipe" Src.typeDecoder) - (Decode.field "others" (Decode.list Decode.string)) - - "RecursiveDecl" -> - Decode.map3 RecursiveDecl - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "names" (Decode.list Decode.string)) - - "RecursiveLet" -> - Decode.map2 RecursiveLet - (Decode.field "name" (A.locatedDecoder Decode.string)) - (Decode.field "names" (Decode.list Decode.string)) - - "Shadowing" -> - Decode.map3 Shadowing - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "TupleLargerThanThree" -> - Decode.map TupleLargerThanThree (Decode.field "region" A.regionDecoder) - - "TypeVarsUnboundInUnion" -> - Decode.map5 TypeVarsUnboundInUnion - (Decode.field "unionRegion" A.regionDecoder) - (Decode.field "typeName" Decode.string) - (Decode.field "allVars" (Decode.list Decode.string)) - (Decode.field "unbound" (DecodeX.jsonPair Decode.string A.regionDecoder)) - (Decode.field "unbounds" (Decode.list (DecodeX.jsonPair Decode.string A.regionDecoder))) - - "TypeVarsMessedUpInAlias" -> - Decode.map5 TypeVarsMessedUpInAlias - (Decode.field "aliasRegion" A.regionDecoder) - (Decode.field "typeName" Decode.string) - (Decode.field "allVars" (Decode.list Decode.string)) - (Decode.field "unusedVars" (Decode.list (DecodeX.jsonPair Decode.string A.regionDecoder))) - (Decode.field "unboundVars" (Decode.list (DecodeX.jsonPair Decode.string A.regionDecoder))) - - _ -> - Decode.fail ("Failed to decode Error's type: " ++ type_) - ) + Binop region op1 op2 -> + binopEncoder region op1 op2 + DuplicateDecl name r1 r2 -> + duplicateDeclEncoder name r1 r2 -badArityContextEncoder : BadArityContext -> Encode.Value -badArityContextEncoder badArityContext = - case badArityContext of - TypeArity -> - Encode.string "TypeArity" + DuplicateType name r1 r2 -> + duplicateTypeEncoder name r1 r2 - PatternArity -> - Encode.string "PatternArity" + DuplicateCtor name r1 r2 -> + duplicateCtorEncoder name r1 r2 + DuplicateBinop name r1 r2 -> + duplicateBinopEncoder name r1 r2 -badArityContextDecoder : Decode.Decoder BadArityContext -badArityContextDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "TypeArity" -> - Decode.succeed TypeArity + DuplicateField name r1 r2 -> + duplicateFieldEncoder name r1 r2 - "PatternArity" -> - Decode.succeed PatternArity + DuplicateAliasArg typeName name r1 r2 -> + duplicateAliasArgEncoder typeName name r1 r2 - _ -> - Decode.fail ("Unknown BadArityContext: " ++ str) - ) - - -duplicatePatternContextEncoder : DuplicatePatternContext -> Encode.Value -duplicatePatternContextEncoder duplicatePatternContext = - case duplicatePatternContext of - DPLambdaArgs -> - Encode.object - [ ( "type", Encode.string "DPLambdaArgs" ) - ] - - DPFuncArgs funcName -> - Encode.object - [ ( "type", Encode.string "DPFuncArgs" ) - , ( "funcName", Encode.string funcName ) - ] + DuplicateUnionArg typeName name r1 r2 -> + duplicateUnionArgEncoder typeName name r1 r2 - DPCaseBranch -> - Encode.object - [ ( "type", Encode.string "DPCaseBranch" ) - ] - - DPLetBinding -> - Encode.object - [ ( "type", Encode.string "DPLetBinding" ) - ] - - DPDestruct -> - Encode.object - [ ( "type", Encode.string "DPDestruct" ) - ] - - -duplicatePatternContextDecoder : Decode.Decoder DuplicatePatternContext -duplicatePatternContextDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "DPLambdaArgs" -> - Decode.succeed DPLambdaArgs - - "DPFuncArgs" -> - Decode.map DPFuncArgs (Decode.field "funcName" Decode.string) - - "DPCaseBranch" -> - Decode.succeed DPCaseBranch - - "DPLetBinding" -> - Decode.succeed DPLetBinding - - "DPDestruct" -> - Decode.succeed DPDestruct - - _ -> - Decode.fail ("Failed to decode DuplicatePatternContext's type: " ++ type_) - ) - - -varKindEncoder : VarKind -> Encode.Value -varKindEncoder varKind = - case varKind of - BadOp -> - Encode.string "BadOp" - - BadVar -> - Encode.string "BadVar" - - BadPattern -> - Encode.string "BadPattern" - - BadType -> - Encode.string "BadType" + DuplicatePattern context name r1 r2 -> + duplicatePatternEncoder context name r1 r2 + EffectNotFound region name -> + effectNotFoundEncoder region name -varKindDecoder : Decode.Decoder VarKind -varKindDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "BadOp" -> - Decode.succeed BadOp + EffectFunctionNotFound region name -> + effectFunctionNotFoundEncoder region name - "BadVar" -> - Decode.succeed BadVar - - "BadPattern" -> - Decode.succeed BadPattern - - "BadType" -> - Decode.succeed BadType - - _ -> - Decode.fail ("Unknown VarKind: " ++ str) - ) - - -possibleNamesEncoder : PossibleNames -> Encode.Value -possibleNamesEncoder possibleNames = - Encode.object - [ ( "type", Encode.string "PossibleNames" ) - , ( "locals", EncodeX.everySet compare Encode.string possibleNames.locals ) - , ( "quals", EncodeX.assocListDict compare Encode.string (EncodeX.everySet compare Encode.string) possibleNames.quals ) - ] - - -possibleNamesDecoder : Decode.Decoder PossibleNames -possibleNamesDecoder = - Decode.map2 PossibleNames - (Decode.field "locals" (DecodeX.everySet identity Decode.string)) - (Decode.field "quals" (DecodeX.assocListDict identity Decode.string (DecodeX.everySet identity Decode.string))) - - -invalidPayloadEncoder : InvalidPayload -> Encode.Value -invalidPayloadEncoder invalidPayload = - case invalidPayload of - ExtendedRecord -> - Encode.object - [ ( "type", Encode.string "ExtendedRecord" ) - ] - - Function -> - Encode.object - [ ( "type", Encode.string "Function" ) - ] - - TypeVariable name -> - Encode.object - [ ( "type", Encode.string "TypeVariable" ) - , ( "name", Encode.string name ) - ] - - UnsupportedType name -> - Encode.object - [ ( "type", Encode.string "UnsupportedType" ) - , ( "name", Encode.string name ) - ] - - -invalidPayloadDecoder : Decode.Decoder InvalidPayload -invalidPayloadDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "ExtendedRecord" -> - Decode.succeed ExtendedRecord - - "Function" -> - Decode.succeed Function - - "TypeVariable" -> - Decode.map TypeVariable (Decode.field "name" Decode.string) - - "UnsupportedType" -> - Decode.map UnsupportedType (Decode.field "name" Decode.string) - - _ -> - Decode.fail ("Failed to decode InvalidPayload's type: " ++ type_) - ) - - -portProblemEncoder : PortProblem -> Encode.Value -portProblemEncoder portProblem = - case portProblem of - CmdNoArg -> - Encode.object - [ ( "type", Encode.string "CmdNoArg" ) - ] - - CmdExtraArgs n -> - Encode.object - [ ( "type", Encode.string "CmdExtraArgs" ) - , ( "n", Encode.int n ) - ] - - CmdBadMsg -> - Encode.object - [ ( "type", Encode.string "CmdBadMsg" ) - ] - - SubBad -> - Encode.object - [ ( "type", Encode.string "SubBad" ) - ] - - NotCmdOrSub -> - Encode.object - [ ( "type", Encode.string "NotCmdOrSub" ) - ] - - -portProblemDecoder : Decode.Decoder PortProblem -portProblemDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "CmdNoArg" -> - Decode.succeed CmdNoArg - - "CmdExtraArgs" -> - Decode.map CmdExtraArgs (Decode.field "n" Decode.int) - - "CmdBadMsg" -> - Decode.succeed CmdBadMsg - - "SubBad" -> - Decode.succeed SubBad - - "NotCmdOrSub" -> - Decode.succeed NotCmdOrSub - - _ -> - Decode.fail ("Failed to decode PortProblem's type: " ++ type_) - ) + ExportDuplicate name r1 r2 -> + exportDuplicateEncoder name r1 r2 + + ExportNotFound region kind rawName possibleNames -> + exportNotFoundEncoder region kind rawName possibleNames + + ExportOpenAlias region name -> + exportOpenAliasEncoder region name + + ImportCtorByName region ctor tipe -> + importCtorByNameEncoder region ctor tipe + + ImportNotFound region name suggestions -> + importNotFoundEncoder region name suggestions + + ImportOpenAlias region name -> + importOpenAliasEncoder region name + + ImportExposingNotFound region home value possibleNames -> + importExposingNotFoundEncoder region home value possibleNames + + NotFoundVar region prefix name possibleNames -> + notFoundVarEncoder region prefix name possibleNames + + NotFoundType region prefix name possibleNames -> + notFoundTypeEncoder region prefix name possibleNames + + NotFoundVariant region prefix name possibleNames -> + notFoundVariantEncoder region prefix name possibleNames + + NotFoundBinop region op locals -> + notFoundBinopEncoder region op locals + + PatternHasRecordCtor region name -> + patternHasRecordCtorEncoder region name + + PortPayloadInvalid region portName badType invalidPayload -> + portPayloadInvalidEncoder region portName badType invalidPayload + + PortTypeInvalid region name portProblem -> + portTypeInvalidEncoder region name portProblem + + RecursiveAlias region name args tipe others -> + recursiveAliasEncoder region name args tipe others + + RecursiveDecl region name names -> + recursiveDeclEncoder region name names + + RecursiveLet name names -> + recursiveLetEncoder name names + + Shadowing name r1 r2 -> + shadowingEncoder name r1 r2 + + TupleLargerThanThree region -> + tupleLargerThanThreeEncoder region + + TypeVarsUnboundInUnion unionRegion typeName allVars unbound unbounds -> + typeVarsUnboundInUnionEncoder unionRegion typeName allVars unbound unbounds + + TypeVarsMessedUpInAlias aliasRegion typeName allVars unusedVars unboundVars -> + typeVarsMessedUpInAliasEncoder aliasRegion typeName allVars unusedVars unboundVars + ) + |> Serialize.variant4 AnnotationTooShort A.regionCodec Serialize.string Index.zeroBasedCodec Serialize.int + |> Serialize.variant5 + AmbiguousVar + A.regionCodec + (Serialize.maybe Serialize.string) + Serialize.string + ModuleName.canonicalCodec + (S.oneOrMore ModuleName.canonicalCodec) + |> Serialize.variant5 + AmbiguousType + A.regionCodec + (Serialize.maybe Serialize.string) + Serialize.string + ModuleName.canonicalCodec + (S.oneOrMore ModuleName.canonicalCodec) + |> Serialize.variant5 + AmbiguousVariant + A.regionCodec + (Serialize.maybe Serialize.string) + Serialize.string + ModuleName.canonicalCodec + (S.oneOrMore ModuleName.canonicalCodec) + |> Serialize.variant4 + AmbiguousBinop + A.regionCodec + Serialize.string + ModuleName.canonicalCodec + (S.oneOrMore ModuleName.canonicalCodec) + |> Serialize.variant5 BadArity A.regionCodec badArityContextCodec Serialize.string Serialize.int Serialize.int + |> Serialize.variant3 Binop A.regionCodec Serialize.string Serialize.string + |> Serialize.variant3 DuplicateDecl Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant3 DuplicateType Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant3 DuplicateCtor Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant3 DuplicateBinop Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant3 DuplicateField Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant4 DuplicateAliasArg Serialize.string Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant4 DuplicateUnionArg Serialize.string Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant4 DuplicatePattern duplicatePatternContextCodec Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant2 EffectNotFound A.regionCodec Serialize.string + |> Serialize.variant2 EffectFunctionNotFound A.regionCodec Serialize.string + |> Serialize.variant3 ExportDuplicate Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant4 + ExportNotFound + A.regionCodec + varKindCodec + Serialize.string + (Serialize.list Serialize.string) + |> Serialize.variant2 ExportOpenAlias A.regionCodec Serialize.string + |> Serialize.variant3 ImportCtorByName A.regionCodec Serialize.string Serialize.string + |> Serialize.variant3 ImportNotFound A.regionCodec Serialize.string (Serialize.list ModuleName.canonicalCodec) + |> Serialize.variant2 ImportOpenAlias A.regionCodec Serialize.string + |> Serialize.variant4 + ImportExposingNotFound + A.regionCodec + ModuleName.canonicalCodec + Serialize.string + (Serialize.list Serialize.string) + |> Serialize.variant4 + NotFoundVar + A.regionCodec + (Serialize.maybe Serialize.string) + Serialize.string + possibleNamesCodec + |> Serialize.variant4 + NotFoundType + A.regionCodec + (Serialize.maybe Serialize.string) + Serialize.string + possibleNamesCodec + |> Serialize.variant4 + NotFoundVariant + A.regionCodec + (Serialize.maybe Serialize.string) + Serialize.string + possibleNamesCodec + |> Serialize.variant3 NotFoundBinop A.regionCodec Serialize.string (S.everySet identity compare Serialize.string) + |> Serialize.variant2 PatternHasRecordCtor A.regionCodec Serialize.string + |> Serialize.variant4 PortPayloadInvalid A.regionCodec Serialize.string Can.typeCodec invalidPayloadCodec + |> Serialize.variant3 PortTypeInvalid A.regionCodec Serialize.string portProblemCodec + |> Serialize.variant5 + RecursiveAlias + A.regionCodec + Serialize.string + (Serialize.list Serialize.string) + Src.typeCodec + (Serialize.list Serialize.string) + |> Serialize.variant3 RecursiveDecl A.regionCodec Serialize.string (Serialize.list Serialize.string) + |> Serialize.variant2 RecursiveLet (A.locatedCodec Serialize.string) (Serialize.list Serialize.string) + |> Serialize.variant3 Shadowing Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant1 TupleLargerThanThree A.regionCodec + |> Serialize.variant5 + TypeVarsUnboundInUnion + A.regionCodec + Serialize.string + (Serialize.list Serialize.string) + (Serialize.tuple Serialize.string A.regionCodec) + (Serialize.list (Serialize.tuple Serialize.string A.regionCodec)) + |> Serialize.variant5 + TypeVarsMessedUpInAlias + A.regionCodec + Serialize.string + (Serialize.list Serialize.string) + (Serialize.list (Serialize.tuple Serialize.string A.regionCodec)) + (Serialize.list (Serialize.tuple Serialize.string A.regionCodec)) + |> Serialize.finishCustomType + + +badArityContextCodec : Codec e BadArityContext +badArityContextCodec = + Serialize.customType + (\typeArityEncoder patternArityEncoder value -> + case value of + TypeArity -> + typeArityEncoder + + PatternArity -> + patternArityEncoder + ) + |> Serialize.variant0 TypeArity + |> Serialize.variant0 PatternArity + |> Serialize.finishCustomType + + +duplicatePatternContextCodec : Codec e DuplicatePatternContext +duplicatePatternContextCodec = + Serialize.customType + (\dPLambdaArgsEncoder dPFuncArgsEncoder dPCaseBranchEncoder dPLetBindingEncoder dPDestructEncoder value -> + case value of + DPLambdaArgs -> + dPLambdaArgsEncoder + + DPFuncArgs funcName -> + dPFuncArgsEncoder funcName + + DPCaseBranch -> + dPCaseBranchEncoder + + DPLetBinding -> + dPLetBindingEncoder + + DPDestruct -> + dPDestructEncoder + ) + |> Serialize.variant0 DPLambdaArgs + |> Serialize.variant1 DPFuncArgs Serialize.string + |> Serialize.variant0 DPCaseBranch + |> Serialize.variant0 DPLetBinding + |> Serialize.variant0 DPDestruct + |> Serialize.finishCustomType + + +varKindCodec : Codec e VarKind +varKindCodec = + Serialize.customType + (\badOpEncoder badVarEncoder badPatternEncoder badTypeEncoder value -> + case value of + BadOp -> + badOpEncoder + + BadVar -> + badVarEncoder + + BadPattern -> + badPatternEncoder + + BadType -> + badTypeEncoder + ) + |> Serialize.variant0 BadOp + |> Serialize.variant0 BadVar + |> Serialize.variant0 BadPattern + |> Serialize.variant0 BadType + |> Serialize.finishCustomType + + +possibleNamesCodec : Codec e PossibleNames +possibleNamesCodec = + Serialize.record PossibleNames + |> Serialize.field .locals (S.everySet identity compare Serialize.string) + |> Serialize.field .quals (S.assocListDict identity compare Serialize.string (S.everySet identity compare Serialize.string)) + |> Serialize.finishRecord + + +invalidPayloadCodec : Codec e InvalidPayload +invalidPayloadCodec = + Serialize.customType + (\extendedRecordEncoder functionEncoder typeVariableEncoder unsupportedTypeEncoder value -> + case value of + ExtendedRecord -> + extendedRecordEncoder + + Function -> + functionEncoder + + TypeVariable name -> + typeVariableEncoder name + + UnsupportedType name -> + unsupportedTypeEncoder name + ) + |> Serialize.variant0 ExtendedRecord + |> Serialize.variant0 Function + |> Serialize.variant1 TypeVariable Serialize.string + |> Serialize.variant1 UnsupportedType Serialize.string + |> Serialize.finishCustomType + + +portProblemCodec : Codec e PortProblem +portProblemCodec = + Serialize.customType + (\cmdNoArgEncoder cmdExtraArgsEncoder cmdBadMsgEncoder subBadEncoder notCmdOrSubEncoder value -> + case value of + CmdNoArg -> + cmdNoArgEncoder + + CmdExtraArgs n -> + cmdExtraArgsEncoder n + + CmdBadMsg -> + cmdBadMsgEncoder + + SubBad -> + subBadEncoder + + NotCmdOrSub -> + notCmdOrSubEncoder + ) + |> Serialize.variant0 CmdNoArg + |> Serialize.variant1 CmdExtraArgs Serialize.int + |> Serialize.variant0 CmdBadMsg + |> Serialize.variant0 SubBad + |> Serialize.variant0 NotCmdOrSub + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Error/Docs.elm b/src/Compiler/Reporting/Error/Docs.elm index cd6cda15d..4edfc5fb3 100644 --- a/src/Compiler/Reporting/Error/Docs.elm +++ b/src/Compiler/Reporting/Error/Docs.elm @@ -3,15 +3,12 @@ module Compiler.Reporting.Error.Docs exposing , Error(..) , NameProblem(..) , SyntaxProblem(..) - , errorDecoder - , errorEncoder + , errorCodec , toReports ) import Compiler.Data.Name as Name import Compiler.Data.NonEmptyList as NE -import Compiler.Json.Decode as DecodeX -import Compiler.Json.Encode as EncodeX import Compiler.Parse.Primitives exposing (Col, Row) import Compiler.Parse.Symbol exposing (BadOperator) import Compiler.Reporting.Annotation as A @@ -19,8 +16,8 @@ import Compiler.Reporting.Doc as D import Compiler.Reporting.Error.Syntax as E import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Report as Report -import Json.Decode as Decode -import Json.Encode as Encode +import Compiler.Serialize as S +import Serialize exposing (Codec) type Error @@ -206,244 +203,113 @@ toDefProblemReport source problem = -- ENCODERS and DECODERS -errorEncoder : Error -> Encode.Value -errorEncoder error = - case error of - NoDocs region -> - Encode.object - [ ( "type", Encode.string "NoDocs" ) - , ( "region", A.regionEncoder region ) - ] - - ImplicitExposing region -> - Encode.object - [ ( "type", Encode.string "ImplicitExposing" ) - , ( "region", A.regionEncoder region ) - ] - - SyntaxProblem problem -> - Encode.object - [ ( "type", Encode.string "SyntaxProblem" ) - , ( "problem", syntaxProblemEncoder problem ) - ] - - NameProblems problems -> - Encode.object - [ ( "type", Encode.string "NameProblems" ) - , ( "problems", EncodeX.nonempty nameProblemEncoder problems ) - ] - - DefProblems problems -> - Encode.object - [ ( "type", Encode.string "DefProblems" ) - , ( "problems", EncodeX.nonempty defProblemEncoder problems ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "NoDocs" -> - Decode.map NoDocs (Decode.field "region" A.regionDecoder) - - "ImplicitExposing" -> - Decode.map ImplicitExposing (Decode.field "region" A.regionDecoder) - - "SyntaxProblem" -> - Decode.map SyntaxProblem (Decode.field "problem" syntaxProblemDecoder) - - "NameProblems" -> - Decode.map NameProblems (Decode.field "problems" (DecodeX.nonempty nameProblemDecoder)) - - "DefProblems" -> - Decode.map DefProblems (Decode.field "problems" (DecodeX.nonempty defProblemDecoder)) - - _ -> - Decode.fail ("Failed to decode Error's type: " ++ type_) - ) - - -syntaxProblemEncoder : SyntaxProblem -> Encode.Value -syntaxProblemEncoder syntaxProblem = - case syntaxProblem of - Op row col -> - Encode.object - [ ( "type", Encode.string "Op" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - OpBad badOperator row col -> - Encode.object - [ ( "type", Encode.string "OpBad" ) - , ( "badOperator", Compiler.Parse.Symbol.badOperatorEncoder badOperator ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Name row col -> - Encode.object - [ ( "type", Encode.string "Name" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Space name row col -> - Encode.object - [ ( "type", Encode.string "Space" ) - , ( "name", E.spaceEncoder name ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Comma row col -> - Encode.object - [ ( "type", Encode.string "Comma" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - BadEnd row col -> - Encode.object - [ ( "type", Encode.string "BadEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -syntaxProblemDecoder : Decode.Decoder SyntaxProblem -syntaxProblemDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Op" -> - Decode.map2 Op - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "OpBad" -> - Decode.map3 OpBad - (Decode.field "badOperator" Compiler.Parse.Symbol.badOperatorDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Name" -> - Decode.map2 Name - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Space" -> - Decode.map3 Space - (Decode.field "name" E.spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Comma" -> - Decode.map2 Comma - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "BadEnd" -> - Decode.map2 BadEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode SyntaxProblem's type: " ++ type_) - ) - - -nameProblemEncoder : NameProblem -> Encode.Value -nameProblemEncoder nameProblem = - case nameProblem of - NameDuplicate name r1 r2 -> - Encode.object - [ ( "type", Encode.string "NameDuplicate" ) - , ( "name", Encode.string name ) - , ( "r1", A.regionEncoder r1 ) - , ( "r2", A.regionEncoder r2 ) - ] - - NameOnlyInDocs name region -> - Encode.object - [ ( "type", Encode.string "NameOnlyInDocs" ) - , ( "name", Encode.string name ) - , ( "region", A.regionEncoder region ) - ] - - NameOnlyInExports name region -> - Encode.object - [ ( "type", Encode.string "NameOnlyInExports" ) - , ( "name", Encode.string name ) - , ( "region", A.regionEncoder region ) - ] - - -nameProblemDecoder : Decode.Decoder NameProblem -nameProblemDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "NameDuplicate" -> - Decode.map3 NameDuplicate - (Decode.field "name" Decode.string) - (Decode.field "r1" A.regionDecoder) - (Decode.field "r2" A.regionDecoder) - - "NameOnlyInDocs" -> - Decode.map2 NameOnlyInDocs - (Decode.field "name" Decode.string) - (Decode.field "region" A.regionDecoder) - - "NameOnlyInExports" -> - Decode.map2 NameOnlyInExports - (Decode.field "name" Decode.string) - (Decode.field "region" A.regionDecoder) - - _ -> - Decode.fail ("Failed to decode NameProblem's type: " ++ type_) - ) - - -defProblemEncoder : DefProblem -> Encode.Value -defProblemEncoder defProblem = - case defProblem of - NoComment name region -> - Encode.object - [ ( "type", Encode.string "NoComment" ) - , ( "name", Encode.string name ) - , ( "region", A.regionEncoder region ) - ] - - NoAnnotation name region -> - Encode.object - [ ( "type", Encode.string "NoAnnotation" ) - , ( "name", Encode.string name ) - , ( "region", A.regionEncoder region ) - ] - - -defProblemDecoder : Decode.Decoder DefProblem -defProblemDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "NoComment" -> - Decode.map2 NoComment - (Decode.field "name" Decode.string) - (Decode.field "region" A.regionDecoder) - - "NoAnnotation" -> - Decode.map2 NoAnnotation - (Decode.field "name" Decode.string) - (Decode.field "region" A.regionDecoder) - - _ -> - Decode.fail ("Failed to decode DefProblem's type: " ++ type_) - ) +errorCodec : Codec (Serialize.Error e) Error +errorCodec = + Serialize.customType + (\noDocsEncoder implicitExposingEncoder syntaxProblemCodecEncoder nameProblemsEncoder defProblemsEncoder value -> + case value of + NoDocs region -> + noDocsEncoder region + + ImplicitExposing region -> + implicitExposingEncoder region + + SyntaxProblem problem -> + syntaxProblemCodecEncoder problem + + NameProblems problems -> + nameProblemsEncoder problems + + DefProblems problems -> + defProblemsEncoder problems + ) + |> Serialize.variant1 NoDocs A.regionCodec + |> Serialize.variant1 ImplicitExposing A.regionCodec + |> Serialize.variant1 SyntaxProblem syntaxProblemCodec + |> Serialize.variant1 NameProblems (S.nonempty nameProblemCodec) + |> Serialize.variant1 DefProblems (S.nonempty defProblemCodec) + |> Serialize.finishCustomType + + +spaceCodec : Codec e E.Space +spaceCodec = + Serialize.customType + (\hasTabEncoder endlessMultiCommentEncoder value -> + case value of + E.HasTab -> + hasTabEncoder + + E.EndlessMultiComment -> + endlessMultiCommentEncoder + ) + |> Serialize.variant0 E.HasTab + |> Serialize.variant0 E.EndlessMultiComment + |> Serialize.finishCustomType + + +syntaxProblemCodec : Codec e SyntaxProblem +syntaxProblemCodec = + Serialize.customType + (\opEncoder opBadEncoder nameEncoder spaceEncoder commaEncoder badEndEncoder value -> + case value of + Op row col -> + opEncoder row col + + OpBad badOperator row col -> + opBadEncoder badOperator row col + + Name row col -> + nameEncoder row col + + Space name row col -> + spaceEncoder name row col + + Comma row col -> + commaEncoder row col + + BadEnd row col -> + badEndEncoder row col + ) + |> Serialize.variant2 Op Serialize.int Serialize.int + |> Serialize.variant3 OpBad Compiler.Parse.Symbol.badOperatorCodec Serialize.int Serialize.int + |> Serialize.variant2 Name Serialize.int Serialize.int + |> Serialize.variant3 Space spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 Comma Serialize.int Serialize.int + |> Serialize.variant2 BadEnd Serialize.int Serialize.int + |> Serialize.finishCustomType + + +nameProblemCodec : Codec e NameProblem +nameProblemCodec = + Serialize.customType + (\nameDuplicateEncoder nameOnlyInDocsEncoder nameOnlyInExportsEncoder value -> + case value of + NameDuplicate name r1 r2 -> + nameDuplicateEncoder name r1 r2 + + NameOnlyInDocs name region -> + nameOnlyInDocsEncoder name region + + NameOnlyInExports name region -> + nameOnlyInExportsEncoder name region + ) + |> Serialize.variant3 NameDuplicate Serialize.string A.regionCodec A.regionCodec + |> Serialize.variant2 NameOnlyInDocs Serialize.string A.regionCodec + |> Serialize.variant2 NameOnlyInExports Serialize.string A.regionCodec + |> Serialize.finishCustomType + + +defProblemCodec : Codec e DefProblem +defProblemCodec = + Serialize.customType + (\noCommentEncoder noAnnotationEncoder value -> + case value of + NoComment name region -> + noCommentEncoder name region + + NoAnnotation name region -> + noAnnotationEncoder name region + ) + |> Serialize.variant2 NoComment Serialize.string A.regionCodec + |> Serialize.variant2 NoAnnotation Serialize.string A.regionCodec + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Error/Import.elm b/src/Compiler/Reporting/Error/Import.elm index 4c0cc0770..1888437a6 100644 --- a/src/Compiler/Reporting/Error/Import.elm +++ b/src/Compiler/Reporting/Error/Import.elm @@ -1,26 +1,22 @@ module Compiler.Reporting.Error.Import exposing ( Error(..) , Problem(..) - , errorDecoder - , errorEncoder - , problemDecoder - , problemEncoder + , errorCodec + , problemCodec , toReport ) import Compiler.Elm.ModuleName as ModuleName import Compiler.Elm.Package as Pkg -import Compiler.Json.Decode as DecodeX -import Compiler.Json.Encode as EncodeX import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Report as Report import Compiler.Reporting.Suggest as Suggest +import Compiler.Serialize as S import Data.Map as Dict import Data.Set as EverySet exposing (EverySet) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -186,88 +182,35 @@ toSuggestions name unimportedModules = -- ENCODERS and DECODERS -problemEncoder : Problem -> Encode.Value -problemEncoder problem = - case problem of - NotFound -> - Encode.object - [ ( "type", Encode.string "NotFound" ) - ] - - Ambiguous path paths pkg pkgs -> - Encode.object - [ ( "type", Encode.string "Ambiguous" ) - , ( "path", Encode.string path ) - , ( "paths", Encode.list Encode.string paths ) - , ( "pkg", Pkg.nameEncoder pkg ) - , ( "pkgs", Encode.list Pkg.nameEncoder pkgs ) - ] - - AmbiguousLocal path1 path2 paths -> - Encode.object - [ ( "type", Encode.string "AmbiguousLocal" ) - , ( "path1", Encode.string path1 ) - , ( "path2", Encode.string path2 ) - , ( "paths", Encode.list Encode.string paths ) - ] - - AmbiguousForeign pkg1 pkg2 pkgs -> - Encode.object - [ ( "type", Encode.string "AmbiguousForeign" ) - , ( "pkg1", Pkg.nameEncoder pkg1 ) - , ( "pkg2", Pkg.nameEncoder pkg2 ) - , ( "pkgs", Encode.list Pkg.nameEncoder pkgs ) - ] - - -problemDecoder : Decode.Decoder Problem -problemDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "NotFound" -> - Decode.succeed NotFound - - "Ambiguous" -> - Decode.map4 Ambiguous - (Decode.field "path" Decode.string) - (Decode.field "paths" (Decode.list Decode.string)) - (Decode.field "pkg" Pkg.nameDecoder) - (Decode.field "pkgs" (Decode.list Pkg.nameDecoder)) - - "AmbiguousLocal" -> - Decode.map3 AmbiguousLocal - (Decode.field "path1" Decode.string) - (Decode.field "path2" Decode.string) - (Decode.field "paths" (Decode.list Decode.string)) - - "AmbiguousForeign" -> - Decode.map3 AmbiguousForeign - (Decode.field "pkg1" Pkg.nameDecoder) - (Decode.field "pkg2" Pkg.nameDecoder) - (Decode.field "pkgs" (Decode.list Pkg.nameDecoder)) - - _ -> - Decode.fail ("Failed to decode Problem's type: " ++ type_) - ) - - -errorEncoder : Error -> Encode.Value -errorEncoder (Error region name unimportedModules problem) = - Encode.object - [ ( "type", Encode.string "Error" ) - , ( "region", A.regionEncoder region ) - , ( "name", ModuleName.rawEncoder name ) - , ( "unimportedModules", EncodeX.everySet compare ModuleName.rawEncoder unimportedModules ) - , ( "problem", problemEncoder problem ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.map4 Error - (Decode.field "region" A.regionDecoder) - (Decode.field "name" ModuleName.rawDecoder) - (Decode.field "unimportedModules" (DecodeX.everySet identity ModuleName.rawDecoder)) - (Decode.field "problem" problemDecoder) +problemCodec : Codec e Problem +problemCodec = + Serialize.customType + (\notFoundEncoder ambiguousEncoder ambiguousLocalEncoder ambiguousForeignEncoder value -> + case value of + NotFound -> + notFoundEncoder + + Ambiguous path paths pkg pkgs -> + ambiguousEncoder path paths pkg pkgs + + AmbiguousLocal path1 path2 paths -> + ambiguousLocalEncoder path1 path2 paths + + AmbiguousForeign pkg1 pkg2 pkgs -> + ambiguousForeignEncoder pkg1 pkg2 pkgs + ) + |> Serialize.variant0 NotFound + |> Serialize.variant4 Ambiguous Serialize.string (Serialize.list Serialize.string) Pkg.nameCodec (Serialize.list Pkg.nameCodec) + |> Serialize.variant3 AmbiguousLocal Serialize.string Serialize.string (Serialize.list Serialize.string) + |> Serialize.variant3 AmbiguousForeign Pkg.nameCodec Pkg.nameCodec (Serialize.list Pkg.nameCodec) + |> Serialize.finishCustomType + + +errorCodec : Codec e Error +errorCodec = + Serialize.customType + (\errorCodecEncoder (Error region name unimportedModules problem) -> + errorCodecEncoder region name unimportedModules problem + ) + |> Serialize.variant4 Error A.regionCodec ModuleName.rawCodec (S.everySet identity compare ModuleName.rawCodec) problemCodec + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Error/Main.elm b/src/Compiler/Reporting/Error/Main.elm index bdc6d4f10..88a810c32 100644 --- a/src/Compiler/Reporting/Error/Main.elm +++ b/src/Compiler/Reporting/Error/Main.elm @@ -1,7 +1,6 @@ module Compiler.Reporting.Error.Main exposing ( Error(..) - , errorDecoder - , errorEncoder + , errorCodec , toReport ) @@ -14,8 +13,7 @@ import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Render.Type.Localizer as L import Compiler.Reporting.Report as Report -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -98,56 +96,21 @@ toReport localizer source err = -- ENCODERS and DECODERS -errorEncoder : Error -> Encode.Value -errorEncoder error = - case error of - BadType region tipe -> - Encode.object - [ ( "type", Encode.string "BadType" ) - , ( "region", A.regionEncoder region ) - , ( "tipe", Can.typeEncoder tipe ) - ] - - BadCycle region name names -> - Encode.object - [ ( "type", Encode.string "BadCycle" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "names", Encode.list Encode.string names ) - ] - - BadFlags region subType invalidPayload -> - Encode.object - [ ( "type", Encode.string "BadFlags" ) - , ( "region", A.regionEncoder region ) - , ( "subType", Can.typeEncoder subType ) - , ( "invalidPayload", E.invalidPayloadEncoder invalidPayload ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "BadType" -> - Decode.map2 BadType - (Decode.field "region" A.regionDecoder) - (Decode.field "tipe" Can.typeDecoder) - - "BadCycle" -> - Decode.map3 BadCycle - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "names" (Decode.list Decode.string)) - - "BadFlags" -> - Decode.map3 BadFlags - (Decode.field "region" A.regionDecoder) - (Decode.field "subType" Can.typeDecoder) - (Decode.field "invalidPayload" E.invalidPayloadDecoder) - - _ -> - Decode.fail ("Failed to decode Error's type: " ++ type_) - ) +errorCodec : Codec e Error +errorCodec = + Serialize.customType + (\badTypeEncoder badCycleEncoder badFlagsEncoder error -> + case error of + BadType region tipe -> + badTypeEncoder region tipe + + BadCycle region name names -> + badCycleEncoder region name names + + BadFlags region subType invalidPayload -> + badFlagsEncoder region subType invalidPayload + ) + |> Serialize.variant2 BadType A.regionCodec Can.typeCodec + |> Serialize.variant3 BadCycle A.regionCodec Serialize.string (Serialize.list Serialize.string) + |> Serialize.variant3 BadFlags A.regionCodec Can.typeCodec E.invalidPayloadCodec + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Error/Syntax.elm b/src/Compiler/Reporting/Error/Syntax.elm index 261997cc2..4f2a96d4b 100644 --- a/src/Compiler/Reporting/Error/Syntax.elm +++ b/src/Compiler/Reporting/Error/Syntax.elm @@ -30,10 +30,7 @@ module Compiler.Reporting.Error.Syntax exposing , Tuple(..) , Type(..) , TypeAlias(..) - , errorDecoder - , errorEncoder - , spaceDecoder - , spaceEncoder + , errorCodec , toReport , toSpaceReport ) @@ -47,8 +44,7 @@ import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Report as Report import Hex -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -7862,3701 +7858,1289 @@ toTTupleReport source context tuple startRow startCol = -- ENCODERS and DECODERS -errorEncoder : Error -> Encode.Value -errorEncoder error = - case error of - ModuleNameUnspecified name -> - Encode.object - [ ( "type", Encode.string "ModuleNameUnspecified" ) - , ( "name", ModuleName.rawEncoder name ) - ] - - ModuleNameMismatch expectedName actualName -> - Encode.object - [ ( "type", Encode.string "ModuleNameMismatch" ) - , ( "expectedName", ModuleName.rawEncoder expectedName ) - , ( "actualName", A.locatedEncoder ModuleName.rawEncoder actualName ) - ] - - UnexpectedPort region -> - Encode.object - [ ( "type", Encode.string "UnexpectedPort" ) - , ( "region", A.regionEncoder region ) - ] - - NoPorts region -> - Encode.object - [ ( "type", Encode.string "NoPorts" ) - , ( "region", A.regionEncoder region ) - ] - - NoPortsInPackage name -> - Encode.object - [ ( "type", Encode.string "NoPortsInPackage" ) - , ( "name", A.locatedEncoder Encode.string name ) - ] - - NoPortModulesInPackage region -> - Encode.object - [ ( "type", Encode.string "NoPortModulesInPackage" ) - , ( "region", A.regionEncoder region ) - ] - - NoEffectsOutsideKernel region -> - Encode.object - [ ( "type", Encode.string "NoEffectsOutsideKernel" ) - , ( "region", A.regionEncoder region ) - ] - - ParseError modul -> - Encode.object - [ ( "type", Encode.string "ParseError" ) - , ( "modul", moduleEncoder modul ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "ModuleNameUnspecified" -> - Decode.map ModuleNameUnspecified (Decode.field "name" ModuleName.rawDecoder) - - "ModuleNameMismatch" -> - Decode.map2 ModuleNameMismatch - (Decode.field "expectedName" ModuleName.rawDecoder) - (Decode.field "actualName" (A.locatedDecoder ModuleName.rawDecoder)) - - "UnexpectedPort" -> - Decode.map UnexpectedPort (Decode.field "region" A.regionDecoder) - - "NoPorts" -> - Decode.map NoPorts (Decode.field "region" A.regionDecoder) - - "NoPortsInPackage" -> - Decode.map NoPortsInPackage (Decode.field "name" (A.locatedDecoder Decode.string)) - - "NoPortModulesInPackage" -> - Decode.map NoPortModulesInPackage (Decode.field "region" A.regionDecoder) - - "NoEffectsOutsideKernel" -> - Decode.map NoEffectsOutsideKernel (Decode.field "region" A.regionDecoder) - - "ParseError" -> - Decode.map ParseError (Decode.field "modul" moduleDecoder) - - _ -> - Decode.fail ("Failed to decode Error's type: " ++ type_) - ) - - -spaceEncoder : Space -> Encode.Value -spaceEncoder space = - case space of - HasTab -> - Encode.string "HasTab" - - EndlessMultiComment -> - Encode.string "EndlessMultiComment" - - -spaceDecoder : Decode.Decoder Space -spaceDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "HasTab" -> - Decode.succeed HasTab - - "EndlessMultiComment" -> - Decode.succeed EndlessMultiComment - - _ -> - Decode.fail ("Unknown Space: " ++ str) - ) - - -moduleEncoder : Module -> Encode.Value -moduleEncoder modul = - case modul of - ModuleSpace space row col -> - Encode.object - [ ( "type", Encode.string "ModuleSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ModuleBadEnd row col -> - Encode.object - [ ( "type", Encode.string "ModuleBadEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ModuleProblem row col -> - Encode.object - [ ( "type", Encode.string "ModuleProblem" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ModuleName row col -> - Encode.object - [ ( "type", Encode.string "ModuleName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ModuleExposing exposing_ row col -> - Encode.object - [ ( "type", Encode.string "ModuleExposing" ) - , ( "exposing", exposingEncoder exposing_ ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortModuleProblem row col -> - Encode.object - [ ( "type", Encode.string "PortModuleProblem" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortModuleName row col -> - Encode.object - [ ( "type", Encode.string "PortModuleName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortModuleExposing exposing_ row col -> - Encode.object - [ ( "type", Encode.string "PortModuleExposing" ) - , ( "exposing", exposingEncoder exposing_ ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Effect row col -> - Encode.object - [ ( "type", Encode.string "Effect" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - FreshLine row col -> - Encode.object - [ ( "type", Encode.string "FreshLine" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportStart row col -> - Encode.object - [ ( "type", Encode.string "ImportStart" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportName row col -> - Encode.object - [ ( "type", Encode.string "ImportName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportAs row col -> - Encode.object - [ ( "type", Encode.string "ImportAs" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportAlias row col -> - Encode.object - [ ( "type", Encode.string "ImportAlias" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportExposing row col -> - Encode.object - [ ( "type", Encode.string "ImportExposing" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportExposingList exposing_ row col -> - Encode.object - [ ( "type", Encode.string "ImportExposingList" ) - , ( "exposing", exposingEncoder exposing_ ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportEnd row col -> - Encode.object - [ ( "type", Encode.string "ImportEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportIndentName row col -> - Encode.object - [ ( "type", Encode.string "ImportIndentName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportIndentAlias row col -> - Encode.object - [ ( "type", Encode.string "ImportIndentAlias" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ImportIndentExposingList row col -> - Encode.object - [ ( "type", Encode.string "ImportIndentExposingList" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Infix row col -> - Encode.object - [ ( "type", Encode.string "Infix" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Declarations decl row col -> - Encode.object - [ ( "type", Encode.string "Declarations" ) - , ( "decl", declEncoder decl ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -moduleDecoder : Decode.Decoder Module -moduleDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "ModuleSpace" -> - Decode.map3 ModuleSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ModuleBadEnd" -> - Decode.map2 ModuleBadEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ModuleProblem" -> - Decode.map2 ModuleProblem - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ModuleName" -> - Decode.map2 ModuleName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ModuleExposing" -> - Decode.map3 ModuleExposing - (Decode.field "exposing" exposingDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortModuleProblem" -> - Decode.map2 PortModuleProblem - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortModuleName" -> - Decode.map2 PortModuleName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortModuleExposing" -> - Decode.map3 PortModuleExposing - (Decode.field "exposing" exposingDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Effect" -> - Decode.map2 Effect - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "FreshLine" -> - Decode.map2 FreshLine - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportStart" -> - Decode.map2 ImportStart - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportName" -> - Decode.map2 ImportName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportAs" -> - Decode.map2 ImportAs - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportAlias" -> - Decode.map2 ImportAlias - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportExposing" -> - Decode.map2 ImportExposing - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportExposingList" -> - Decode.map3 ImportExposingList - (Decode.field "exposing" exposingDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportEnd" -> - Decode.map2 ImportEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportIndentName" -> - Decode.map2 ImportIndentName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportIndentAlias" -> - Decode.map2 ImportIndentAlias - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ImportIndentExposingList" -> - Decode.map2 ImportIndentExposingList - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Infix" -> - Decode.map2 Infix - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Declarations" -> - Decode.map3 Declarations - (Decode.field "decl" declDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Module's type: " ++ type_) - ) - - -exposingEncoder : Exposing -> Encode.Value -exposingEncoder exposing_ = - case exposing_ of - ExposingSpace space row col -> - Encode.object - [ ( "type", Encode.string "ExposingSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingStart row col -> - Encode.object - [ ( "type", Encode.string "ExposingStart" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingValue row col -> - Encode.object - [ ( "type", Encode.string "ExposingValue" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingOperator row col -> - Encode.object - [ ( "type", Encode.string "ExposingOperator" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingOperatorReserved op row col -> - Encode.object - [ ( "type", Encode.string "ExposingOperatorReserved" ) - , ( "op", Compiler.Parse.Symbol.badOperatorEncoder op ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingOperatorRightParen row col -> - Encode.object - [ ( "type", Encode.string "ExposingOperatorRightParen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingTypePrivacy row col -> - Encode.object - [ ( "type", Encode.string "ExposingTypePrivacy" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingEnd row col -> - Encode.object - [ ( "type", Encode.string "ExposingEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "ExposingIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ExposingIndentValue row col -> - Encode.object - [ ( "type", Encode.string "ExposingIndentValue" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -exposingDecoder : Decode.Decoder Exposing -exposingDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "ExposingSpace" -> - Decode.map3 ExposingSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingStart" -> - Decode.map2 ExposingStart - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingValue" -> - Decode.map2 ExposingValue - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingOperator" -> - Decode.map2 ExposingOperator - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingOperatorReserved" -> - Decode.map3 ExposingOperatorReserved - (Decode.field "op" Compiler.Parse.Symbol.badOperatorDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingOperatorRightParen" -> - Decode.map2 ExposingOperatorRightParen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingTypePrivacy" -> - Decode.map2 ExposingTypePrivacy - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingEnd" -> - Decode.map2 ExposingEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingIndentEnd" -> - Decode.map2 ExposingIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ExposingIndentValue" -> - Decode.map2 ExposingIndentValue - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Exposing's type: " ++ type_) - ) - - -declEncoder : Decl -> Encode.Value -declEncoder decl = - case decl of - DeclStart row col -> - Encode.object - [ ( "type", Encode.string "DeclStart" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclSpace space row col -> - Encode.object - [ ( "type", Encode.string "DeclSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Port port_ row col -> - Encode.object - [ ( "type", Encode.string "Port" ) - , ( "port", portEncoder port_ ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclType declType row col -> - Encode.object - [ ( "type", Encode.string "DeclType" ) - , ( "declType", declTypeEncoder declType ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDef name declDef row col -> - Encode.object - [ ( "type", Encode.string "DeclDef" ) - , ( "name", Encode.string name ) - , ( "declDef", declDefEncoder declDef ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclFreshLineAfterDocComment row col -> - Encode.object - [ ( "type", Encode.string "DeclFreshLineAfterDocComment" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -declDecoder : Decode.Decoder Decl -declDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "DeclStart" -> - Decode.map2 DeclStart - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclSpace" -> - Decode.map3 DeclSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Port" -> - Decode.map3 Port - (Decode.field "port" portDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclType" -> - Decode.map3 DeclType - (Decode.field "declType" declTypeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDef" -> - Decode.map4 DeclDef - (Decode.field "name" Decode.string) - (Decode.field "declDef" declDefDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclFreshLineAfterDocComment" -> - Decode.map2 DeclFreshLineAfterDocComment - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Decl's type: " ++ type_) - ) - - -portEncoder : Port -> Encode.Value -portEncoder port_ = - case port_ of - PortSpace space row col -> - Encode.object - [ ( "type", Encode.string "PortSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortName row col -> - Encode.object - [ ( "type", Encode.string "PortName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortColon row col -> - Encode.object - [ ( "type", Encode.string "PortColon" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortType tipe row col -> - Encode.object - [ ( "type", Encode.string "PortType" ) - , ( "tipe", typeEncoder tipe ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortIndentName row col -> - Encode.object - [ ( "type", Encode.string "PortIndentName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortIndentColon row col -> - Encode.object - [ ( "type", Encode.string "PortIndentColon" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PortIndentType row col -> - Encode.object - [ ( "type", Encode.string "PortIndentType" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -portDecoder : Decode.Decoder Port -portDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PortSpace" -> - Decode.map3 PortSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortName" -> - Decode.map2 PortName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortColon" -> - Decode.map2 PortColon - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortType" -> - Decode.map3 PortType - (Decode.field "tipe" typeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortIndentName" -> - Decode.map2 PortIndentName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortIndentColon" -> - Decode.map2 PortIndentColon - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PortIndentType" -> - Decode.map2 PortIndentType - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Port's type: " ++ type_) - ) - - -declTypeEncoder : DeclType -> Encode.Value -declTypeEncoder declType = - case declType of - DT_Space space row col -> - Encode.object - [ ( "type", Encode.string "DT_Space" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DT_Name row col -> - Encode.object - [ ( "type", Encode.string "DT_Name" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DT_Alias typeAlias row col -> - Encode.object - [ ( "type", Encode.string "DT_Alias" ) - , ( "typeAlias", typeAliasEncoder typeAlias ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DT_Union customType row col -> - Encode.object - [ ( "type", Encode.string "DT_Union" ) - , ( "customType", customTypeEncoder customType ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DT_IndentName row col -> - Encode.object - [ ( "type", Encode.string "DT_IndentName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -declTypeDecoder : Decode.Decoder DeclType -declTypeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "DT_Space" -> - Decode.map3 DT_Space - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DT_Name" -> - Decode.map2 DT_Name - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DT_Alias" -> - Decode.map3 DT_Alias - (Decode.field "typeAlias" typeAliasDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DT_Union" -> - Decode.map3 DT_Union - (Decode.field "customType" customTypeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DT_IndentName" -> - Decode.map2 DT_IndentName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode DeclType's type: " ++ type_) - ) - - -declDefEncoder : DeclDef -> Encode.Value -declDefEncoder declDef = - case declDef of - DeclDefSpace space row col -> - Encode.object - [ ( "type", Encode.string "DeclDefSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefEquals row col -> - Encode.object - [ ( "type", Encode.string "DeclDefEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefType tipe row col -> - Encode.object - [ ( "type", Encode.string "DeclDefType" ) - , ( "tipe", typeEncoder tipe ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefArg pattern row col -> - Encode.object - [ ( "type", Encode.string "DeclDefArg" ) - , ( "pattern", patternEncoder pattern ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefBody expr row col -> - Encode.object - [ ( "type", Encode.string "DeclDefBody" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefNameRepeat row col -> - Encode.object - [ ( "type", Encode.string "DeclDefNameRepeat" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefNameMatch name row col -> - Encode.object - [ ( "type", Encode.string "DeclDefNameMatch" ) - , ( "name", Encode.string name ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefIndentType row col -> - Encode.object - [ ( "type", Encode.string "DeclDefIndentType" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefIndentEquals row col -> - Encode.object - [ ( "type", Encode.string "DeclDefIndentEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DeclDefIndentBody row col -> - Encode.object - [ ( "type", Encode.string "DeclDefIndentBody" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -declDefDecoder : Decode.Decoder DeclDef -declDefDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "DeclDefSpace" -> - Decode.map3 DeclDefSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefEquals" -> - Decode.map2 DeclDefEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefType" -> - Decode.map3 DeclDefType - (Decode.field "tipe" typeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefArg" -> - Decode.map3 DeclDefArg - (Decode.field "pattern" patternDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefBody" -> - Decode.map3 DeclDefBody - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefNameRepeat" -> - Decode.map2 DeclDefNameRepeat - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefNameMatch" -> - Decode.map3 DeclDefNameMatch - (Decode.field "name" Decode.string) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefIndentType" -> - Decode.map2 DeclDefIndentType - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefIndentEquals" -> - Decode.map2 DeclDefIndentEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DeclDefIndentBody" -> - Decode.map2 DeclDefIndentBody - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode DeclDef's type: " ++ type_) - ) - - -typeEncoder : Type -> Encode.Value -typeEncoder type_ = - case type_ of - TRecord record row col -> - Encode.object - [ ( "type", Encode.string "TRecord" ) - , ( "record", tRecordEncoder record ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TTuple tuple row col -> - Encode.object - [ ( "type", Encode.string "TTuple" ) - , ( "tuple", tTupleEncoder tuple ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TStart row col -> - Encode.object - [ ( "type", Encode.string "TStart" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TSpace space row col -> - Encode.object - [ ( "type", Encode.string "TSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TIndentStart row col -> - Encode.object - [ ( "type", Encode.string "TIndentStart" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -typeDecoder : Decode.Decoder Type -typeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "TRecord" -> - Decode.map3 TRecord - (Decode.field "record" tRecordDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TTuple" -> - Decode.map3 TTuple - (Decode.field "tuple" tTupleDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TStart" -> - Decode.map2 TStart - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TSpace" -> - Decode.map3 TSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TIndentStart" -> - Decode.map2 TIndentStart - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Type's type: " ++ type_) - ) - - -patternEncoder : Pattern -> Encode.Value -patternEncoder pattern = - case pattern of - PRecord record row col -> - Encode.object - [ ( "type", Encode.string "PRecord" ) - , ( "record", pRecordEncoder record ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PTuple tuple row col -> - Encode.object - [ ( "type", Encode.string "PTuple" ) - , ( "tuple", pTupleEncoder tuple ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PList list row col -> - Encode.object - [ ( "type", Encode.string "PList" ) - , ( "list", pListEncoder list ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PStart row col -> - Encode.object - [ ( "type", Encode.string "PStart" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PChar char row col -> - Encode.object - [ ( "type", Encode.string "PChar" ) - , ( "char", charEncoder char ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PString string row col -> - Encode.object - [ ( "type", Encode.string "PString" ) - , ( "string", stringEncoder string ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PNumber number row col -> - Encode.object - [ ( "type", Encode.string "PNumber" ) - , ( "number", numberEncoder number ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PFloat width row col -> - Encode.object - [ ( "type", Encode.string "PFloat" ) - , ( "width", Encode.int width ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PAlias row col -> - Encode.object - [ ( "type", Encode.string "PAlias" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PWildcardNotVar name width row col -> - Encode.object - [ ( "type", Encode.string "PWildcardNotVar" ) - , ( "name", Encode.string name ) - , ( "width", Encode.int width ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PSpace space row col -> - Encode.object - [ ( "type", Encode.string "PSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PIndentStart row col -> - Encode.object - [ ( "type", Encode.string "PIndentStart" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PIndentAlias row col -> - Encode.object - [ ( "type", Encode.string "PIndentAlias" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -patternDecoder : Decode.Decoder Pattern -patternDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PRecord" -> - Decode.map3 PRecord - (Decode.field "record" pRecordDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PTuple" -> - Decode.map3 PTuple - (Decode.field "tuple" pTupleDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PList" -> - Decode.map3 PList - (Decode.field "list" pListDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PStart" -> - Decode.map2 PStart - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PChar" -> - Decode.map3 PChar - (Decode.field "char" charDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PString" -> - Decode.map3 PString - (Decode.field "string" stringDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PNumber" -> - Decode.map3 PNumber - (Decode.field "number" numberDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PFloat" -> - Decode.map3 PFloat - (Decode.field "width" Decode.int) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PAlias" -> - Decode.map2 PAlias - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PWildcardNotVar" -> - Decode.map4 PWildcardNotVar - (Decode.field "name" Decode.string) - (Decode.field "width" Decode.int) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PSpace" -> - Decode.map3 PSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PIndentStart" -> - Decode.map2 PIndentStart - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PIndentAlias" -> - Decode.map2 PIndentAlias - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Pattern's type: " ++ type_) - ) - - -exprEncoder : Expr -> Encode.Value -exprEncoder expr = - case expr of - Let let_ row col -> - Encode.object - [ ( "type", Encode.string "Let" ) - , ( "let", letEncoder let_ ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Case case_ row col -> - Encode.object - [ ( "type", Encode.string "Case" ) - , ( "case", caseEncoder case_ ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - If if_ row col -> - Encode.object - [ ( "type", Encode.string "If" ) - , ( "if", ifEncoder if_ ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - List list row col -> - Encode.object - [ ( "type", Encode.string "List" ) - , ( "list", listEncoder list ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Record record row col -> - Encode.object - [ ( "type", Encode.string "Record" ) - , ( "record", recordEncoder record ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Tuple tuple row col -> - Encode.object - [ ( "type", Encode.string "Tuple" ) - , ( "tuple", tupleEncoder tuple ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Func func row col -> - Encode.object - [ ( "type", Encode.string "Func" ) - , ( "func", funcEncoder func ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Dot row col -> - Encode.object - [ ( "type", Encode.string "Dot" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Access row col -> - Encode.object - [ ( "type", Encode.string "Access" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - OperatorRight op row col -> - Encode.object - [ ( "type", Encode.string "OperatorRight" ) - , ( "op", Encode.string op ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - OperatorReserved operator row col -> - Encode.object - [ ( "type", Encode.string "OperatorReserved" ) - , ( "operator", Compiler.Parse.Symbol.badOperatorEncoder operator ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Start row col -> - Encode.object - [ ( "type", Encode.string "Start" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Char char row col -> - Encode.object - [ ( "type", Encode.string "Char" ) - , ( "char", charEncoder char ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - String_ string row col -> - Encode.object - [ ( "type", Encode.string "String" ) - , ( "string", stringEncoder string ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Number number row col -> - Encode.object - [ ( "type", Encode.string "Number" ) - , ( "number", numberEncoder number ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - Space space row col -> - Encode.object - [ ( "type", Encode.string "Space" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - EndlessShader row col -> - Encode.object - [ ( "type", Encode.string "EndlessShader" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ShaderProblem problem row col -> - Encode.object - [ ( "type", Encode.string "ShaderProblem" ) - , ( "problem", Encode.string problem ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IndentOperatorRight op row col -> - Encode.object - [ ( "type", Encode.string "IndentOperatorRight" ) - , ( "op", Encode.string op ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -exprDecoder : Decode.Decoder Expr -exprDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Let" -> - Decode.map3 Let - (Decode.field "let" letDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Case" -> - Decode.map3 Case - (Decode.field "case" caseDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "If" -> - Decode.map3 If - (Decode.field "if" ifDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "List" -> - Decode.map3 List - (Decode.field "list" listDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Record" -> - Decode.map3 Record - (Decode.field "record" recordDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Tuple" -> - Decode.map3 Tuple - (Decode.field "tuple" tupleDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Func" -> - Decode.map3 Func - (Decode.field "func" funcDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Dot" -> - Decode.map2 Dot - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Access" -> - Decode.map2 Access - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "OperatorRight" -> - Decode.map3 OperatorRight - (Decode.field "op" Decode.string) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "OperatorReserved" -> - Decode.map3 OperatorReserved - (Decode.field "operator" Compiler.Parse.Symbol.badOperatorDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Start" -> - Decode.map2 Start - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Char" -> - Decode.map3 Char - (Decode.field "char" charDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "String" -> - Decode.map3 String_ - (Decode.field "string" stringDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Number" -> - Decode.map3 Number - (Decode.field "number" numberDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "Space" -> - Decode.map3 Space - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "EndlessShader" -> - Decode.map2 EndlessShader - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ShaderProblem" -> - Decode.map3 ShaderProblem - (Decode.field "problem" Decode.string) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IndentOperatorRight" -> - Decode.map3 IndentOperatorRight - (Decode.field "op" Decode.string) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Expr's type: " ++ type_) - ) - - -letEncoder : Let -> Encode.Value -letEncoder let_ = - case let_ of - LetSpace space row col -> - Encode.object - [ ( "type", Encode.string "LetSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetIn row col -> - Encode.object - [ ( "type", Encode.string "LetIn" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetDefAlignment int row col -> - Encode.object - [ ( "type", Encode.string "LetDefAlignment" ) - , ( "int", Encode.int int ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetDefName row col -> - Encode.object - [ ( "type", Encode.string "LetDefName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetDef name def row col -> - Encode.object - [ ( "type", Encode.string "LetDef" ) - , ( "name", Encode.string name ) - , ( "def", defEncoder def ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetDestruct destruct row col -> - Encode.object - [ ( "type", Encode.string "LetDestruct" ) - , ( "destruct", destructEncoder destruct ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetBody expr row col -> - Encode.object - [ ( "type", Encode.string "LetBody" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetIndentDef row col -> - Encode.object - [ ( "type", Encode.string "LetIndentDef" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetIndentIn row col -> - Encode.object - [ ( "type", Encode.string "LetIndentIn" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - LetIndentBody row col -> - Encode.object - [ ( "type", Encode.string "LetIndentBody" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -letDecoder : Decode.Decoder Let -letDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "LetSpace" -> - Decode.map3 LetSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetIn" -> - Decode.map2 LetIn - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetDefAlignment" -> - Decode.map3 LetDefAlignment - (Decode.field "int" Decode.int) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetDefName" -> - Decode.map2 LetDefName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetDef" -> - Decode.map4 LetDef - (Decode.field "name" Decode.string) - (Decode.field "def" defDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetDestruct" -> - Decode.map3 LetDestruct - (Decode.field "destruct" destructDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetBody" -> - Decode.map3 LetBody - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetIndentDef" -> - Decode.map2 LetIndentDef - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetIndentIn" -> - Decode.map2 LetIndentIn - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "LetIndentBody" -> - Decode.map2 LetIndentBody - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Let's type: " ++ type_) - ) - - -caseEncoder : Case -> Encode.Value -caseEncoder case_ = - case case_ of - CaseSpace space row col -> - Encode.object - [ ( "type", Encode.string "CaseSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseOf row col -> - Encode.object - [ ( "type", Encode.string "CaseOf" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CasePattern pattern row col -> - Encode.object - [ ( "type", Encode.string "CasePattern" ) - , ( "pattern", patternEncoder pattern ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseArrow row col -> - Encode.object - [ ( "type", Encode.string "CaseArrow" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseExpr expr row col -> - Encode.object - [ ( "type", Encode.string "CaseExpr" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseBranch expr row col -> - Encode.object - [ ( "type", Encode.string "CaseBranch" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseIndentOf row col -> - Encode.object - [ ( "type", Encode.string "CaseIndentOf" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseIndentExpr row col -> - Encode.object - [ ( "type", Encode.string "CaseIndentExpr" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseIndentPattern row col -> - Encode.object - [ ( "type", Encode.string "CaseIndentPattern" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseIndentArrow row col -> - Encode.object - [ ( "type", Encode.string "CaseIndentArrow" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CaseIndentBranch row col -> - Encode.object - [ ( "type", Encode.string "CaseIndentBranch" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CasePatternAlignment indent row col -> - Encode.object - [ ( "type", Encode.string "CasePatternAlignment" ) - , ( "indent", Encode.int indent ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -caseDecoder : Decode.Decoder Case -caseDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "CaseSpace" -> - Decode.map3 CaseSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseOf" -> - Decode.map2 CaseOf - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CasePattern" -> - Decode.map3 CasePattern - (Decode.field "pattern" patternDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseArrow" -> - Decode.map2 CaseArrow - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseExpr" -> - Decode.map3 CaseExpr - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseBranch" -> - Decode.map3 CaseBranch - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseIndentOf" -> - Decode.map2 CaseIndentOf - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseIndentExpr" -> - Decode.map2 CaseIndentExpr - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseIndentPattern" -> - Decode.map2 CaseIndentPattern - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseIndentArrow" -> - Decode.map2 CaseIndentArrow - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CaseIndentBranch" -> - Decode.map2 CaseIndentBranch - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CasePatternAlignment" -> - Decode.map3 CasePatternAlignment - (Decode.field "indent" Decode.int) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Case's type: " ++ type_) - ) - - -ifEncoder : If -> Encode.Value -ifEncoder if_ = - case if_ of - IfSpace space row col -> - Encode.object - [ ( "type", Encode.string "IfSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfThen row col -> - Encode.object - [ ( "type", Encode.string "IfThen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfElse row col -> - Encode.object - [ ( "type", Encode.string "IfElse" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfElseBranchStart row col -> - Encode.object - [ ( "type", Encode.string "IfElseBranchStart" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfCondition expr row col -> - Encode.object - [ ( "type", Encode.string "IfCondition" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfThenBranch expr row col -> - Encode.object - [ ( "type", Encode.string "IfThenBranch" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfElseBranch expr row col -> - Encode.object - [ ( "type", Encode.string "IfElseBranch" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfIndentCondition row col -> - Encode.object - [ ( "type", Encode.string "IfIndentCondition" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfIndentThen row col -> - Encode.object - [ ( "type", Encode.string "IfIndentThen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfIndentThenBranch row col -> - Encode.object - [ ( "type", Encode.string "IfIndentThenBranch" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfIndentElseBranch row col -> - Encode.object - [ ( "type", Encode.string "IfIndentElseBranch" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - IfIndentElse row col -> - Encode.object - [ ( "type", Encode.string "IfIndentElse" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -ifDecoder : Decode.Decoder If -ifDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "IfSpace" -> - Decode.map3 IfSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfThen" -> - Decode.map2 IfThen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfElse" -> - Decode.map2 IfElse - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfElseBranchStart" -> - Decode.map2 IfElseBranchStart - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfCondition" -> - Decode.map3 IfCondition - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfThenBranch" -> - Decode.map3 IfThenBranch - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfElseBranch" -> - Decode.map3 IfElseBranch - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfIndentCondition" -> - Decode.map2 IfIndentCondition - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfIndentThen" -> - Decode.map2 IfIndentThen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfIndentThenBranch" -> - Decode.map2 IfIndentThenBranch - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfIndentElseBranch" -> - Decode.map2 IfIndentElseBranch - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "IfIndentElse" -> - Decode.map2 IfIndentElse - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode If's type: " ++ type_) - ) - - -listEncoder : List_ -> Encode.Value -listEncoder list_ = - case list_ of - ListSpace space row col -> - Encode.object - [ ( "type", Encode.string "ListSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ListOpen row col -> - Encode.object - [ ( "type", Encode.string "ListOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ListExpr expr row col -> - Encode.object - [ ( "type", Encode.string "ListExpr" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ListEnd row col -> - Encode.object - [ ( "type", Encode.string "ListEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ListIndentOpen row col -> - Encode.object - [ ( "type", Encode.string "ListIndentOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ListIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "ListIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - ListIndentExpr row col -> - Encode.object - [ ( "type", Encode.string "ListIndentExpr" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -listDecoder : Decode.Decoder List_ -listDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "ListSpace" -> - Decode.map3 ListSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ListOpen" -> - Decode.map2 ListOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ListExpr" -> - Decode.map3 ListExpr - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ListEnd" -> - Decode.map2 ListEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ListIndentOpen" -> - Decode.map2 ListIndentOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ListIndentEnd" -> - Decode.map2 ListIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "ListIndentExpr" -> - Decode.map2 ListIndentExpr - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode List's type: " ++ type_) - ) - - -recordEncoder : Record -> Encode.Value -recordEncoder record = - case record of - RecordOpen row col -> - Encode.object - [ ( "type", Encode.string "RecordOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordEnd row col -> - Encode.object - [ ( "type", Encode.string "RecordEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordField row col -> - Encode.object - [ ( "type", Encode.string "RecordField" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordEquals row col -> - Encode.object - [ ( "type", Encode.string "RecordEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordExpr expr row col -> - Encode.object - [ ( "type", Encode.string "RecordExpr" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordSpace space row col -> - Encode.object - [ ( "type", Encode.string "RecordSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordIndentOpen row col -> - Encode.object - [ ( "type", Encode.string "RecordIndentOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "RecordIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordIndentField row col -> - Encode.object - [ ( "type", Encode.string "RecordIndentField" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordIndentEquals row col -> - Encode.object - [ ( "type", Encode.string "RecordIndentEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - RecordIndentExpr row col -> - Encode.object - [ ( "type", Encode.string "RecordIndentExpr" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -recordDecoder : Decode.Decoder Record -recordDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "RecordOpen" -> - Decode.map2 RecordOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordEnd" -> - Decode.map2 RecordEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordField" -> - Decode.map2 RecordField - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordEquals" -> - Decode.map2 RecordEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordExpr" -> - Decode.map3 RecordExpr - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordSpace" -> - Decode.map3 RecordSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordIndentOpen" -> - Decode.map2 RecordIndentOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordIndentEnd" -> - Decode.map2 RecordIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordIndentField" -> - Decode.map2 RecordIndentField - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordIndentEquals" -> - Decode.map2 RecordIndentEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "RecordIndentExpr" -> - Decode.map2 RecordIndentExpr - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Record's type: " ++ type_) - ) - - -tupleEncoder : Tuple -> Encode.Value -tupleEncoder tuple = - case tuple of - TupleExpr expr row col -> - Encode.object - [ ( "type", Encode.string "TupleExpr" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TupleSpace space row col -> - Encode.object - [ ( "type", Encode.string "TupleSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TupleEnd row col -> - Encode.object - [ ( "type", Encode.string "TupleEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TupleOperatorClose row col -> - Encode.object - [ ( "type", Encode.string "TupleOperatorClose" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TupleOperatorReserved operator row col -> - Encode.object - [ ( "type", Encode.string "TupleOperatorReserved" ) - , ( "operator", Compiler.Parse.Symbol.badOperatorEncoder operator ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TupleIndentExpr1 row col -> - Encode.object - [ ( "type", Encode.string "TupleIndentExpr1" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TupleIndentExprN row col -> - Encode.object - [ ( "type", Encode.string "TupleIndentExprN" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TupleIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "TupleIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -tupleDecoder : Decode.Decoder Tuple -tupleDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "TupleExpr" -> - Decode.map3 TupleExpr - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TupleSpace" -> - Decode.map3 TupleSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TupleEnd" -> - Decode.map2 TupleEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TupleOperatorClose" -> - Decode.map2 TupleOperatorClose - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TupleOperatorReserved" -> - Decode.map3 TupleOperatorReserved - (Decode.field "operator" Compiler.Parse.Symbol.badOperatorDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TupleIndentExpr1" -> - Decode.map2 TupleIndentExpr1 - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TupleIndentExprN" -> - Decode.map2 TupleIndentExprN - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TupleIndentEnd" -> - Decode.map2 TupleIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Tuple's type: " ++ type_) - ) - - -funcEncoder : Func -> Encode.Value -funcEncoder func = - case func of - FuncSpace space row col -> - Encode.object - [ ( "type", Encode.string "FuncSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - FuncArg pattern row col -> - Encode.object - [ ( "type", Encode.string "FuncArg" ) - , ( "pattern", patternEncoder pattern ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - FuncBody expr row col -> - Encode.object - [ ( "type", Encode.string "FuncBody" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - FuncArrow row col -> - Encode.object - [ ( "type", Encode.string "FuncArrow" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - FuncIndentArg row col -> - Encode.object - [ ( "type", Encode.string "FuncIndentArg" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - FuncIndentArrow row col -> - Encode.object - [ ( "type", Encode.string "FuncIndentArrow" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - FuncIndentBody row col -> - Encode.object - [ ( "type", Encode.string "FuncIndentBody" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -funcDecoder : Decode.Decoder Func -funcDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "FuncSpace" -> - Decode.map3 FuncSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "FuncArg" -> - Decode.map3 FuncArg - (Decode.field "pattern" patternDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "FuncBody" -> - Decode.map3 FuncBody - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "FuncArrow" -> - Decode.map2 FuncArrow - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "FuncIndentArg" -> - Decode.map2 FuncIndentArg - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "FuncIndentArrow" -> - Decode.map2 FuncIndentArrow - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "FuncIndentBody" -> - Decode.map2 FuncIndentBody - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Func's type: " ++ type_) - ) - - -charEncoder : Char -> Encode.Value -charEncoder char = - case char of - CharEndless -> - Encode.object - [ ( "type", Encode.string "CharEndless" ) - ] - - CharEscape escape -> - Encode.object - [ ( "type", Encode.string "CharEscape" ) - , ( "escape", escapeEncoder escape ) - ] - - CharNotString width -> - Encode.object - [ ( "type", Encode.string "CharNotString" ) - , ( "width", Encode.int width ) - ] - - -charDecoder : Decode.Decoder Char -charDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "CharEndless" -> - Decode.succeed CharEndless - - "CharEscape" -> - Decode.map CharEscape (Decode.field "escape" escapeDecoder) - - "CharNotString" -> - Decode.map CharNotString (Decode.field "width" Decode.int) - - _ -> - Decode.fail ("Failed to decode Char's type: " ++ type_) - ) - - -stringEncoder : String_ -> Encode.Value -stringEncoder string_ = - case string_ of - StringEndless_Single -> - Encode.object - [ ( "type", Encode.string "StringEndless_Single" ) ] - - StringEndless_Multi -> - Encode.object - [ ( "type", Encode.string "StringEndless_Multi" ) ] - - StringEscape escape -> - Encode.object - [ ( "type", Encode.string "StringEscape" ) - , ( "escape", escapeEncoder escape ) - ] - - -stringDecoder : Decode.Decoder String_ -stringDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "StringEndless_Single" -> - Decode.succeed StringEndless_Single - - "StringEndless_Multi" -> - Decode.succeed StringEndless_Multi - - "StringEscape" -> - Decode.map StringEscape (Decode.field "escape" escapeDecoder) - - _ -> - Decode.fail ("Failed to decode String's type: " ++ type_) - ) - - -numberEncoder : Number -> Encode.Value -numberEncoder number = - case number of - NumberEnd -> - Encode.object - [ ( "type", Encode.string "NumberEnd" ) - ] - - NumberDot n -> - Encode.object - [ ( "type", Encode.string "NumberDot" ) - , ( "n", Encode.int n ) - ] - - NumberHexDigit -> - Encode.object - [ ( "type", Encode.string "NumberHexDigit" ) - ] - - NumberNoLeadingZero -> - Encode.object - [ ( "type", Encode.string "NumberNoLeadingZero" ) - ] - - -numberDecoder : Decode.Decoder Number -numberDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "NumberEnd" -> - Decode.succeed NumberEnd - - "NumberDot" -> - Decode.map NumberDot (Decode.field "n" Decode.int) - - "NumberHexDigit" -> - Decode.succeed NumberHexDigit - - "NumberNoLeadingZero" -> - Decode.succeed NumberNoLeadingZero - - _ -> - Decode.fail ("Failed to decode Number's type: " ++ type_) - ) - - -escapeEncoder : Escape -> Encode.Value -escapeEncoder escape = - case escape of - EscapeUnknown -> - Encode.object - [ ( "type", Encode.string "EscapeUnknown" ) - ] - - BadUnicodeFormat width -> - Encode.object - [ ( "type", Encode.string "BadUnicodeFormat" ) - , ( "width", Encode.int width ) - ] - - BadUnicodeCode width -> - Encode.object - [ ( "type", Encode.string "BadUnicodeCode" ) - , ( "width", Encode.int width ) - ] - - BadUnicodeLength width numDigits badCode -> - Encode.object - [ ( "type", Encode.string "BadUnicodeLength" ) - , ( "width", Encode.int width ) - , ( "numDigits", Encode.int numDigits ) - , ( "badCode", Encode.int badCode ) - ] - - -escapeDecoder : Decode.Decoder Escape -escapeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "EscapeUnknown" -> - Decode.succeed EscapeUnknown - - "BadUnicodeFormat" -> - Decode.map BadUnicodeFormat (Decode.field "width" Decode.int) - - "BadUnicodeCode" -> - Decode.map BadUnicodeCode (Decode.field "width" Decode.int) - - "BadUnicodeLength" -> - Decode.map3 BadUnicodeLength - (Decode.field "width" Decode.int) - (Decode.field "numDigits" Decode.int) - (Decode.field "badCode" Decode.int) - - _ -> - Decode.fail ("Failed to decode Escape's type: " ++ type_) - ) - - -defEncoder : Def -> Encode.Value -defEncoder def = - case def of - DefSpace space row col -> - Encode.object - [ ( "type", Encode.string "DefSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefType tipe row col -> - Encode.object - [ ( "type", Encode.string "DefType" ) - , ( "tipe", typeEncoder tipe ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefNameRepeat row col -> - Encode.object - [ ( "type", Encode.string "DefNameRepeat" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefNameMatch name row col -> - Encode.object - [ ( "type", Encode.string "DefNameMatch" ) - , ( "name", Encode.string name ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefArg pattern row col -> - Encode.object - [ ( "type", Encode.string "DefArg" ) - , ( "pattern", patternEncoder pattern ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefEquals row col -> - Encode.object - [ ( "type", Encode.string "DefEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefBody expr row col -> - Encode.object - [ ( "type", Encode.string "DefBody" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefIndentEquals row col -> - Encode.object - [ ( "type", Encode.string "DefIndentEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefIndentType row col -> - Encode.object - [ ( "type", Encode.string "DefIndentType" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefIndentBody row col -> - Encode.object - [ ( "type", Encode.string "DefIndentBody" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DefAlignment indent row col -> - Encode.object - [ ( "type", Encode.string "DefAlignment" ) - , ( "indent", Encode.int indent ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -defDecoder : Decode.Decoder Def -defDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "DefSpace" -> - Decode.map3 DefSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefType" -> - Decode.map3 DefType - (Decode.field "tipe" typeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefNameRepeat" -> - Decode.map2 DefNameRepeat - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefNameMatch" -> - Decode.map3 DefNameMatch - (Decode.field "name" Decode.string) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefArg" -> - Decode.map3 DefArg - (Decode.field "pattern" patternDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefEquals" -> - Decode.map2 DefEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefBody" -> - Decode.map3 DefBody - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefIndentEquals" -> - Decode.map2 DefIndentEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefIndentType" -> - Decode.map2 DefIndentType - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefIndentBody" -> - Decode.map2 DefIndentBody - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DefAlignment" -> - Decode.map3 DefAlignment - (Decode.field "indent" Decode.int) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Def's type: " ++ type_) - ) - - -destructEncoder : Destruct -> Encode.Value -destructEncoder destruct = - case destruct of - DestructSpace space row col -> - Encode.object - [ ( "type", Encode.string "DestructSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DestructPattern pattern row col -> - Encode.object - [ ( "type", Encode.string "DestructPattern" ) - , ( "pattern", patternEncoder pattern ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DestructEquals row col -> - Encode.object - [ ( "type", Encode.string "DestructEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DestructBody expr row col -> - Encode.object - [ ( "type", Encode.string "DestructBody" ) - , ( "expr", exprEncoder expr ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DestructIndentEquals row col -> - Encode.object - [ ( "type", Encode.string "DestructIndentEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - DestructIndentBody row col -> - Encode.object - [ ( "type", Encode.string "DestructIndentBody" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -destructDecoder : Decode.Decoder Destruct -destructDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "DestructSpace" -> - Decode.map3 DestructSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DestructPattern" -> - Decode.map3 DestructPattern - (Decode.field "pattern" patternDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DestructEquals" -> - Decode.map2 DestructEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DestructBody" -> - Decode.map3 DestructBody - (Decode.field "expr" exprDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DestructIndentEquals" -> - Decode.map2 DestructIndentEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "DestructIndentBody" -> - Decode.map2 DestructIndentBody - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode Destruct's type: " ++ type_) - ) - - -pRecordEncoder : PRecord -> Encode.Value -pRecordEncoder pRecord = - case pRecord of - PRecordOpen row col -> - Encode.object - [ ( "type", Encode.string "PRecordOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PRecordEnd row col -> - Encode.object - [ ( "type", Encode.string "PRecordEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PRecordField row col -> - Encode.object - [ ( "type", Encode.string "PRecordField" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PRecordSpace space row col -> - Encode.object - [ ( "type", Encode.string "PRecordSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PRecordIndentOpen row col -> - Encode.object - [ ( "type", Encode.string "PRecordIndentOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PRecordIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "PRecordIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PRecordIndentField row col -> - Encode.object - [ ( "type", Encode.string "PRecordIndentField" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -pRecordDecoder : Decode.Decoder PRecord -pRecordDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PRecordOpen" -> - Decode.map2 PRecordOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PRecordEnd" -> - Decode.map2 PRecordEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PRecordField" -> - Decode.map2 PRecordField - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PRecordSpace" -> - Decode.map3 PRecordSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PRecordIndentOpen" -> - Decode.map2 PRecordIndentOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PRecordIndentEnd" -> - Decode.map2 PRecordIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PRecordIndentField" -> - Decode.map2 PRecordIndentField - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode PRecord's type: " ++ type_) - ) - - -pTupleEncoder : PTuple -> Encode.Value -pTupleEncoder pTuple = - case pTuple of - PTupleOpen row col -> - Encode.object - [ ( "type", Encode.string "PTupleOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PTupleEnd row col -> - Encode.object - [ ( "type", Encode.string "PTupleEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PTupleExpr pattern row col -> - Encode.object - [ ( "type", Encode.string "PTupleExpr" ) - , ( "pattern", patternEncoder pattern ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PTupleSpace space row col -> - Encode.object - [ ( "type", Encode.string "PTupleSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PTupleIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "PTupleIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PTupleIndentExpr1 row col -> - Encode.object - [ ( "type", Encode.string "PTupleIndentExpr1" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PTupleIndentExprN row col -> - Encode.object - [ ( "type", Encode.string "PTupleIndentExprN" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -pTupleDecoder : Decode.Decoder PTuple -pTupleDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PTupleOpen" -> - Decode.map2 PTupleOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PTupleEnd" -> - Decode.map2 PTupleEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PTupleExpr" -> - Decode.map3 PTupleExpr - (Decode.field "pattern" patternDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PTupleSpace" -> - Decode.map3 PTupleSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PTupleIndentEnd" -> - Decode.map2 PTupleIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PTupleIndentExpr1" -> - Decode.map2 PTupleIndentExpr1 - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PTupleIndentExprN" -> - Decode.map2 PTupleIndentExprN - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode PTuple's type: " ++ type_) - ) - - -pListEncoder : PList -> Encode.Value -pListEncoder pList = - case pList of - PListOpen row col -> - Encode.object - [ ( "type", Encode.string "PListOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] +errorCodec : Codec e Error +errorCodec = + Serialize.customType + (\moduleNameUnspecifiedEncoder moduleNameMismatchEncoder unexpectedPortEncoder noPortsEncoder noPortsInPackageEncoder noPortModulesInPackageEncoder noEffectsOutsideKernelEncoder parseErrorEncoder value -> + case value of + ModuleNameUnspecified name -> + moduleNameUnspecifiedEncoder name - PListEnd row col -> - Encode.object - [ ( "type", Encode.string "PListEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PListExpr pattern row col -> - Encode.object - [ ( "type", Encode.string "PListExpr" ) - , ( "pattern", patternEncoder pattern ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PListSpace space row col -> - Encode.object - [ ( "type", Encode.string "PListSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PListIndentOpen row col -> - Encode.object - [ ( "type", Encode.string "PListIndentOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PListIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "PListIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - PListIndentExpr row col -> - Encode.object - [ ( "type", Encode.string "PListIndentExpr" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -pListDecoder : Decode.Decoder PList -pListDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PListOpen" -> - Decode.map2 PListOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PListEnd" -> - Decode.map2 PListEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PListExpr" -> - Decode.map3 PListExpr - (Decode.field "pattern" patternDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PListSpace" -> - Decode.map3 PListSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PListIndentOpen" -> - Decode.map2 PListIndentOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PListIndentEnd" -> - Decode.map2 PListIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "PListIndentExpr" -> - Decode.map2 PListIndentExpr - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode PList's type: " ++ type_) - ) - - -tRecordEncoder : TRecord -> Encode.Value -tRecordEncoder tRecord = - case tRecord of - TRecordOpen row col -> - Encode.object - [ ( "type", Encode.string "TRecordOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordEnd row col -> - Encode.object - [ ( "type", Encode.string "TRecordEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordField row col -> - Encode.object - [ ( "type", Encode.string "TRecordField" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordColon row col -> - Encode.object - [ ( "type", Encode.string "TRecordColon" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordType tipe row col -> - Encode.object - [ ( "type", Encode.string "TRecordType" ) - , ( "tipe", typeEncoder tipe ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordSpace space row col -> - Encode.object - [ ( "type", Encode.string "TRecordSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordIndentOpen row col -> - Encode.object - [ ( "type", Encode.string "TRecordIndentOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordIndentField row col -> - Encode.object - [ ( "type", Encode.string "TRecordIndentField" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordIndentColon row col -> - Encode.object - [ ( "type", Encode.string "TRecordIndentColon" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordIndentType row col -> - Encode.object - [ ( "type", Encode.string "TRecordIndentType" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TRecordIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "TRecordIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -tRecordDecoder : Decode.Decoder TRecord -tRecordDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "TRecordOpen" -> - Decode.map2 TRecordOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordEnd" -> - Decode.map2 TRecordEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordField" -> - Decode.map2 TRecordField - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordColon" -> - Decode.map2 TRecordColon - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordType" -> - Decode.map3 TRecordType - (Decode.field "tipe" typeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordSpace" -> - Decode.map3 TRecordSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordIndentOpen" -> - Decode.map2 TRecordIndentOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordIndentField" -> - Decode.map2 TRecordIndentField - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordIndentColon" -> - Decode.map2 TRecordIndentColon - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordIndentType" -> - Decode.map2 TRecordIndentType - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TRecordIndentEnd" -> - Decode.map2 TRecordIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode TRecord's type: " ++ type_) - ) - - -tTupleEncoder : TTuple -> Encode.Value -tTupleEncoder tTuple = - case tTuple of - TTupleOpen row col -> - Encode.object - [ ( "type", Encode.string "TTupleOpen" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TTupleEnd row col -> - Encode.object - [ ( "type", Encode.string "TTupleEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] + ModuleNameMismatch expectedName actualName -> + moduleNameMismatchEncoder expectedName actualName - TTupleType tipe row col -> - Encode.object - [ ( "type", Encode.string "TTupleType" ) - , ( "tipe", typeEncoder tipe ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TTupleSpace space row col -> - Encode.object - [ ( "type", Encode.string "TTupleSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TTupleIndentType1 row col -> - Encode.object - [ ( "type", Encode.string "TTupleIndentType1" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TTupleIndentTypeN row col -> - Encode.object - [ ( "type", Encode.string "TTupleIndentTypeN" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - TTupleIndentEnd row col -> - Encode.object - [ ( "type", Encode.string "TTupleIndentEnd" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - -tTupleDecoder : Decode.Decoder TTuple -tTupleDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "TTupleOpen" -> - Decode.map2 TTupleOpen - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TTupleEnd" -> - Decode.map2 TTupleEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TTupleType" -> - Decode.map3 TTupleType - (Decode.field "tipe" typeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TTupleSpace" -> - Decode.map3 TTupleSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TTupleIndentType1" -> - Decode.map2 TTupleIndentType1 - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TTupleIndentTypeN" -> - Decode.map2 TTupleIndentTypeN - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "TTupleIndentEnd" -> - Decode.map2 TTupleIndentEnd - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode TTuple's type: " ++ type_) - ) - - -customTypeEncoder : CustomType -> Encode.Value -customTypeEncoder customType = - case customType of - CT_Space space row col -> - Encode.object - [ ( "type", Encode.string "CT_Space" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_Name row col -> - Encode.object - [ ( "type", Encode.string "CT_Name" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_Equals row col -> - Encode.object - [ ( "type", Encode.string "CT_Equals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_Bar row col -> - Encode.object - [ ( "type", Encode.string "CT_Bar" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_Variant row col -> - Encode.object - [ ( "type", Encode.string "CT_Variant" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_VariantArg tipe row col -> - Encode.object - [ ( "type", Encode.string "CT_VariantArg" ) - , ( "tipe", typeEncoder tipe ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_IndentEquals row col -> - Encode.object - [ ( "type", Encode.string "CT_IndentEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_IndentBar row col -> - Encode.object - [ ( "type", Encode.string "CT_IndentBar" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_IndentAfterBar row col -> - Encode.object - [ ( "type", Encode.string "CT_IndentAfterBar" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - - CT_IndentAfterEquals row col -> - Encode.object - [ ( "type", Encode.string "CT_IndentAfterEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] + UnexpectedPort region -> + unexpectedPortEncoder region + NoPorts region -> + noPortsEncoder region -customTypeDecoder : Decode.Decoder CustomType -customTypeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "CT_Space" -> - Decode.map3 CT_Space - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_Name" -> - Decode.map2 CT_Name - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_Equals" -> - Decode.map2 CT_Equals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_Bar" -> - Decode.map2 CT_Bar - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_Variant" -> - Decode.map2 CT_Variant - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_VariantArg" -> - Decode.map3 CT_VariantArg - (Decode.field "tipe" typeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_IndentEquals" -> - Decode.map2 CT_IndentEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_IndentBar" -> - Decode.map2 CT_IndentBar - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_IndentAfterBar" -> - Decode.map2 CT_IndentAfterBar - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "CT_IndentAfterEquals" -> - Decode.map2 CT_IndentAfterEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode CustomType's type: " ++ type_) - ) + NoPortsInPackage name -> + noPortsInPackageEncoder name + NoPortModulesInPackage region -> + noPortModulesInPackageEncoder region -typeAliasEncoder : TypeAlias -> Encode.Value -typeAliasEncoder typeAlias = - case typeAlias of - AliasSpace space row col -> - Encode.object - [ ( "type", Encode.string "AliasSpace" ) - , ( "space", spaceEncoder space ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] + NoEffectsOutsideKernel region -> + noEffectsOutsideKernelEncoder region - AliasName row col -> - Encode.object - [ ( "type", Encode.string "AliasName" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] + ParseError modul -> + parseErrorEncoder modul + ) + |> Serialize.variant1 ModuleNameUnspecified ModuleName.rawCodec + |> Serialize.variant2 ModuleNameMismatch ModuleName.rawCodec (A.locatedCodec ModuleName.rawCodec) + |> Serialize.variant1 UnexpectedPort A.regionCodec + |> Serialize.variant1 NoPorts A.regionCodec + |> Serialize.variant1 NoPortsInPackage (A.locatedCodec Serialize.string) + |> Serialize.variant1 NoPortModulesInPackage A.regionCodec + |> Serialize.variant1 NoEffectsOutsideKernel A.regionCodec + |> Serialize.variant1 ParseError moduleCodec + |> Serialize.finishCustomType - AliasEquals row col -> - Encode.object - [ ( "type", Encode.string "AliasEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] - AliasBody tipe row col -> - Encode.object - [ ( "type", Encode.string "AliasBody" ) - , ( "tipe", typeEncoder tipe ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] +spaceCodec : Codec e Space +spaceCodec = + Serialize.customType + (\hasTabEncoder endlessMultiCommentEncoder value -> + case value of + HasTab -> + hasTabEncoder + + EndlessMultiComment -> + endlessMultiCommentEncoder + ) + |> Serialize.variant0 HasTab + |> Serialize.variant0 EndlessMultiComment + |> Serialize.finishCustomType + + +moduleCodec : Codec e Module +moduleCodec = + Serialize.customType + (\moduleSpaceEncoder moduleBadEndEncoder moduleProblemEncoder moduleNameEncoder moduleExposingEncoder portModuleProblemEncoder portModuleNameEncoder portModuleExposingEncoder effectEncoder freshLineEncoder importStartEncoder importNameEncoder importAsEncoder importAliasEncoder importExposingEncoder importExposingListEncoder importEndEncoder importIndentNameEncoder importIndentAliasEncoder importIndentExposingListEncoder infixEncoder declarationsEncoder value -> + case value of + ModuleSpace space row col -> + moduleSpaceEncoder space row col + + ModuleBadEnd row col -> + moduleBadEndEncoder row col + + ModuleProblem row col -> + moduleProblemEncoder row col + + ModuleName row col -> + moduleNameEncoder row col + + ModuleExposing exposing_ row col -> + moduleExposingEncoder exposing_ row col + + PortModuleProblem row col -> + portModuleProblemEncoder row col + + PortModuleName row col -> + portModuleNameEncoder row col + + PortModuleExposing exposing_ row col -> + portModuleExposingEncoder exposing_ row col - AliasIndentEquals row col -> - Encode.object - [ ( "type", Encode.string "AliasIndentEquals" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] + Effect row col -> + effectEncoder row col + + FreshLine row col -> + freshLineEncoder row col + + ImportStart row col -> + importStartEncoder row col + + ImportName row col -> + importNameEncoder row col + + ImportAs row col -> + importAsEncoder row col + + ImportAlias row col -> + importAliasEncoder row col + + ImportExposing row col -> + importExposingEncoder row col + + ImportExposingList exposing_ row col -> + importExposingListEncoder exposing_ row col + + ImportEnd row col -> + importEndEncoder row col + + ImportIndentName row col -> + importIndentNameEncoder row col + + ImportIndentAlias row col -> + importIndentAliasEncoder row col + + ImportIndentExposingList row col -> + importIndentExposingListEncoder row col + + Infix row col -> + infixEncoder row col + + Declarations decl row col -> + declarationsEncoder decl row col + ) + |> Serialize.variant3 ModuleSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 ModuleBadEnd Serialize.int Serialize.int + |> Serialize.variant2 ModuleProblem Serialize.int Serialize.int + |> Serialize.variant2 ModuleName Serialize.int Serialize.int + |> Serialize.variant3 ModuleExposing exposingCodec Serialize.int Serialize.int + |> Serialize.variant2 PortModuleProblem Serialize.int Serialize.int + |> Serialize.variant2 PortModuleName Serialize.int Serialize.int + |> Serialize.variant3 PortModuleExposing exposingCodec Serialize.int Serialize.int + |> Serialize.variant2 Effect Serialize.int Serialize.int + |> Serialize.variant2 FreshLine Serialize.int Serialize.int + |> Serialize.variant2 ImportStart Serialize.int Serialize.int + |> Serialize.variant2 ImportName Serialize.int Serialize.int + |> Serialize.variant2 ImportAs Serialize.int Serialize.int + |> Serialize.variant2 ImportAlias Serialize.int Serialize.int + |> Serialize.variant2 ImportExposing Serialize.int Serialize.int + |> Serialize.variant3 ImportExposingList exposingCodec Serialize.int Serialize.int + |> Serialize.variant2 ImportEnd Serialize.int Serialize.int + |> Serialize.variant2 ImportIndentName Serialize.int Serialize.int + |> Serialize.variant2 ImportIndentAlias Serialize.int Serialize.int + |> Serialize.variant2 ImportIndentExposingList Serialize.int Serialize.int + |> Serialize.variant2 Infix Serialize.int Serialize.int + |> Serialize.variant3 Declarations declCodec Serialize.int Serialize.int + |> Serialize.finishCustomType + + +exposingCodec : Codec e Exposing +exposingCodec = + Serialize.customType + (\exposingSpaceEncoder exposingStartEncoder exposingValueEncoder exposingOperatorEncoder exposingOperatorReservedEncoder exposingOperatorRightParenEncoder exposingTypePrivacyEncoder exposingEndEncoder exposingIndentEndEncoder exposingIndentValueEncoder value -> + case value of + ExposingSpace space row col -> + exposingSpaceEncoder space row col + + ExposingStart row col -> + exposingStartEncoder row col + + ExposingValue row col -> + exposingValueEncoder row col + + ExposingOperator row col -> + exposingOperatorEncoder row col + + ExposingOperatorReserved op row col -> + exposingOperatorReservedEncoder op row col + + ExposingOperatorRightParen row col -> + exposingOperatorRightParenEncoder row col + + ExposingTypePrivacy row col -> + exposingTypePrivacyEncoder row col + + ExposingEnd row col -> + exposingEndEncoder row col + + ExposingIndentEnd row col -> + exposingIndentEndEncoder row col + + ExposingIndentValue row col -> + exposingIndentValueEncoder row col + ) + |> Serialize.variant3 ExposingSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 ExposingStart Serialize.int Serialize.int + |> Serialize.variant2 ExposingValue Serialize.int Serialize.int + |> Serialize.variant2 ExposingOperator Serialize.int Serialize.int + |> Serialize.variant3 ExposingOperatorReserved Compiler.Parse.Symbol.badOperatorCodec Serialize.int Serialize.int + |> Serialize.variant2 ExposingOperatorRightParen Serialize.int Serialize.int + |> Serialize.variant2 ExposingTypePrivacy Serialize.int Serialize.int + |> Serialize.variant2 ExposingEnd Serialize.int Serialize.int + |> Serialize.variant2 ExposingIndentEnd Serialize.int Serialize.int + |> Serialize.variant2 ExposingIndentValue Serialize.int Serialize.int + |> Serialize.finishCustomType + + +declCodec : Codec e Decl +declCodec = + Serialize.customType + (\declStartEncoder declSpaceEncoder portCodecEncoder declTypeCodecEncoder declDefCodecEncoder declFreshLineAfterDocCommentEncoder value -> + case value of + DeclStart row col -> + declStartEncoder row col + + DeclSpace space row col -> + declSpaceEncoder space row col + + Port port_ row col -> + portCodecEncoder port_ row col + + DeclType declType row col -> + declTypeCodecEncoder declType row col + + DeclDef name declDef row col -> + declDefCodecEncoder name declDef row col + + DeclFreshLineAfterDocComment row col -> + declFreshLineAfterDocCommentEncoder row col + ) + |> Serialize.variant2 DeclStart Serialize.int Serialize.int + |> Serialize.variant3 DeclSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant3 Port portCodec Serialize.int Serialize.int + |> Serialize.variant3 DeclType declTypeCodec Serialize.int Serialize.int + |> Serialize.variant4 DeclDef Serialize.string declDefCodec Serialize.int Serialize.int + |> Serialize.variant2 DeclFreshLineAfterDocComment Serialize.int Serialize.int + |> Serialize.finishCustomType + + +portCodec : Codec e Port +portCodec = + Serialize.customType + (\portSpaceEncoder portNameEncoder portColonEncoder portTypeEncoder portIndentNameEncoder portIndentColonEncoder portIndentTypeEncoder value -> + case value of + PortSpace space row col -> + portSpaceEncoder space row col + + PortName row col -> + portNameEncoder row col + + PortColon row col -> + portColonEncoder row col + + PortType tipe row col -> + portTypeEncoder tipe row col + + PortIndentName row col -> + portIndentNameEncoder row col + + PortIndentColon row col -> + portIndentColonEncoder row col + + PortIndentType row col -> + portIndentTypeEncoder row col + ) + |> Serialize.variant3 PortSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 PortName Serialize.int Serialize.int + |> Serialize.variant2 PortColon Serialize.int Serialize.int + |> Serialize.variant3 PortType typeCodec Serialize.int Serialize.int + |> Serialize.variant2 PortIndentName Serialize.int Serialize.int + |> Serialize.variant2 PortIndentColon Serialize.int Serialize.int + |> Serialize.variant2 PortIndentType Serialize.int Serialize.int + |> Serialize.finishCustomType + + +declTypeCodec : Codec e DeclType +declTypeCodec = + Serialize.customType + (\dT_SpaceEncoder dT_NameEncoder dT_AliasEncoder dT_UnionEncoder dT_IndentNameEncoder value -> + case value of + DT_Space space row col -> + dT_SpaceEncoder space row col + + DT_Name row col -> + dT_NameEncoder row col + + DT_Alias typeAlias row col -> + dT_AliasEncoder typeAlias row col + + DT_Union customType row col -> + dT_UnionEncoder customType row col + + DT_IndentName row col -> + dT_IndentNameEncoder row col + ) + |> Serialize.variant3 DT_Space spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 DT_Name Serialize.int Serialize.int + |> Serialize.variant3 DT_Alias typeAliasCodec Serialize.int Serialize.int + |> Serialize.variant3 DT_Union customTypeCodec Serialize.int Serialize.int + |> Serialize.variant2 DT_IndentName Serialize.int Serialize.int + |> Serialize.finishCustomType + + +declDefCodec : Codec e DeclDef +declDefCodec = + Serialize.customType + (\declDefSpaceEncoder declDefEqualsEncoder declDefTypeEncoder declDefArgEncoder declDefBodyEncoder declDefNameRepeatEncoder declDefNameMatchEncoder declDefIndentTypeEncoder declDefIndentEqualsEncoder declDefIndentBodyEncoder value -> + case value of + DeclDefSpace space row col -> + declDefSpaceEncoder space row col + + DeclDefEquals row col -> + declDefEqualsEncoder row col + + DeclDefType tipe row col -> + declDefTypeEncoder tipe row col + + DeclDefArg pattern row col -> + declDefArgEncoder pattern row col + + DeclDefBody expr row col -> + declDefBodyEncoder expr row col + + DeclDefNameRepeat row col -> + declDefNameRepeatEncoder row col + + DeclDefNameMatch name row col -> + declDefNameMatchEncoder name row col + + DeclDefIndentType row col -> + declDefIndentTypeEncoder row col + + DeclDefIndentEquals row col -> + declDefIndentEqualsEncoder row col + + DeclDefIndentBody row col -> + declDefIndentBodyEncoder row col + ) + |> Serialize.variant3 DeclDefSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 DeclDefEquals Serialize.int Serialize.int + |> Serialize.variant3 DeclDefType typeCodec Serialize.int Serialize.int + |> Serialize.variant3 DeclDefArg patternCodec Serialize.int Serialize.int + |> Serialize.variant3 DeclDefBody exprCodec Serialize.int Serialize.int + |> Serialize.variant2 DeclDefNameRepeat Serialize.int Serialize.int + |> Serialize.variant3 DeclDefNameMatch Serialize.string Serialize.int Serialize.int + |> Serialize.variant2 DeclDefIndentType Serialize.int Serialize.int + |> Serialize.variant2 DeclDefIndentEquals Serialize.int Serialize.int + |> Serialize.variant2 DeclDefIndentBody Serialize.int Serialize.int + |> Serialize.finishCustomType + + +typeCodec : Codec e Type +typeCodec = + Serialize.customType + (\tRecordCodecEncoder tTupleCodecEncoder tStartEncoder tSpaceEncoder tIndentStartEncoder value -> + case value of + TRecord record row col -> + tRecordCodecEncoder record row col + + TTuple tuple row col -> + tTupleCodecEncoder tuple row col + + TStart row col -> + tStartEncoder row col + + TSpace space row col -> + tSpaceEncoder space row col + + TIndentStart row col -> + tIndentStartEncoder row col + ) + |> Serialize.variant3 TRecord tRecordCodec Serialize.int Serialize.int + |> Serialize.variant3 TTuple (Serialize.lazy (\() -> tTupleCodec)) Serialize.int Serialize.int + |> Serialize.variant2 TStart Serialize.int Serialize.int + |> Serialize.variant3 TSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 TIndentStart Serialize.int Serialize.int + |> Serialize.finishCustomType + + +patternCodec : Codec e Pattern +patternCodec = + Serialize.customType + (\pRecordCodecEncoder pTupleCodecEncoder pListCodecEncoder pStartEncoder pCharEncoder pStringEncoder pNumberEncoder pFloatEncoder pAliasEncoder pWildcardNotVarEncoder pSpaceEncoder pIndentStartEncoder pIndentAliasEncoder value -> + case value of + PRecord record row col -> + pRecordCodecEncoder record row col + + PTuple tuple row col -> + pTupleCodecEncoder tuple row col + + PList list row col -> + pListCodecEncoder list row col + + PStart row col -> + pStartEncoder row col - AliasIndentBody row col -> - Encode.object - [ ( "type", Encode.string "AliasIndentBody" ) - , ( "row", Encode.int row ) - , ( "col", Encode.int col ) - ] + PChar char row col -> + pCharEncoder char row col + PString string row col -> + pStringEncoder string row col -typeAliasDecoder : Decode.Decoder TypeAlias -typeAliasDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "AliasSpace" -> - Decode.map3 AliasSpace - (Decode.field "space" spaceDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "AliasName" -> - Decode.map2 AliasName - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "AliasEquals" -> - Decode.map2 AliasEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "AliasBody" -> - Decode.map3 AliasBody - (Decode.field "tipe" typeDecoder) - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "AliasIndentEquals" -> - Decode.map2 AliasIndentEquals - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - "AliasIndentBody" -> - Decode.map2 AliasIndentBody - (Decode.field "row" Decode.int) - (Decode.field "col" Decode.int) - - _ -> - Decode.fail ("Failed to decode TypeAlias's type: " ++ type_) - ) + PNumber number row col -> + pNumberEncoder number row col + + PFloat width row col -> + pFloatEncoder width row col + + PAlias row col -> + pAliasEncoder row col + + PWildcardNotVar name width row col -> + pWildcardNotVarEncoder name width row col + + PSpace space row col -> + pSpaceEncoder space row col + + PIndentStart row col -> + pIndentStartEncoder row col + + PIndentAlias row col -> + pIndentAliasEncoder row col + ) + |> Serialize.variant3 PRecord pRecordCodec Serialize.int Serialize.int + |> Serialize.variant3 PTuple (Serialize.lazy (\() -> pTupleCodec)) Serialize.int Serialize.int + |> Serialize.variant3 PList pListCodec Serialize.int Serialize.int + |> Serialize.variant2 PStart Serialize.int Serialize.int + |> Serialize.variant3 PChar charCodec Serialize.int Serialize.int + |> Serialize.variant3 PString string_Codec Serialize.int Serialize.int + |> Serialize.variant3 PNumber numberCodec Serialize.int Serialize.int + |> Serialize.variant3 PFloat Serialize.int Serialize.int Serialize.int + |> Serialize.variant2 PAlias Serialize.int Serialize.int + |> Serialize.variant4 PWildcardNotVar Serialize.string Serialize.int Serialize.int Serialize.int + |> Serialize.variant3 PSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 PIndentStart Serialize.int Serialize.int + |> Serialize.variant2 PIndentAlias Serialize.int Serialize.int + |> Serialize.finishCustomType + + +exprCodec : Codec e Expr +exprCodec = + Serialize.customType + (\letCodecEncoder caseCodecEncoder ifCodecEncoder listCodecEncoder recordCodecEncoder tupleCodecEncoder funcCodecEncoder dotEncoder accessEncoder operatorRightEncoder operatorReservedEncoder startEncoder charCodecEncoder string_Encoder numberCodecEncoder spaceCodecEncoder endlessShaderEncoder shaderProblemEncoder indentOperatorRightEncoder value -> + case value of + Let let_ row col -> + letCodecEncoder let_ row col + + Case case_ row col -> + caseCodecEncoder case_ row col + + If if_ row col -> + ifCodecEncoder if_ row col + + List list row col -> + listCodecEncoder list row col + + Record record row col -> + recordCodecEncoder record row col + + Tuple tuple row col -> + tupleCodecEncoder tuple row col + + Func func row col -> + funcCodecEncoder func row col + + Dot row col -> + dotEncoder row col + + Access row col -> + accessEncoder row col + + OperatorRight op row col -> + operatorRightEncoder op row col + + OperatorReserved operator row col -> + operatorReservedEncoder operator row col + + Start row col -> + startEncoder row col + + Char char row col -> + charCodecEncoder char row col + + String_ string row col -> + string_Encoder string row col + + Number number row col -> + numberCodecEncoder number row col + + Space space row col -> + spaceCodecEncoder space row col + + EndlessShader row col -> + endlessShaderEncoder row col + + ShaderProblem problem row col -> + shaderProblemEncoder problem row col + + IndentOperatorRight op row col -> + indentOperatorRightEncoder op row col + ) + |> Serialize.variant3 Let (Serialize.lazy (\() -> letCodec)) Serialize.int Serialize.int + |> Serialize.variant3 Case caseCodec Serialize.int Serialize.int + |> Serialize.variant3 If (Serialize.lazy (\() -> ifCodec)) Serialize.int Serialize.int + |> Serialize.variant3 List (Serialize.lazy (\() -> listCodec)) Serialize.int Serialize.int + |> Serialize.variant3 Record (Serialize.lazy (\() -> recordCodec)) Serialize.int Serialize.int + |> Serialize.variant3 Tuple (Serialize.lazy (\() -> tupleCodec)) Serialize.int Serialize.int + |> Serialize.variant3 Func (Serialize.lazy (\() -> funcCodec)) Serialize.int Serialize.int + |> Serialize.variant2 Dot Serialize.int Serialize.int + |> Serialize.variant2 Access Serialize.int Serialize.int + |> Serialize.variant3 OperatorRight Serialize.string Serialize.int Serialize.int + |> Serialize.variant3 OperatorReserved Compiler.Parse.Symbol.badOperatorCodec Serialize.int Serialize.int + |> Serialize.variant2 Start Serialize.int Serialize.int + |> Serialize.variant3 Char charCodec Serialize.int Serialize.int + |> Serialize.variant3 String_ string_Codec Serialize.int Serialize.int + |> Serialize.variant3 Number numberCodec Serialize.int Serialize.int + |> Serialize.variant3 Space spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 EndlessShader Serialize.int Serialize.int + |> Serialize.variant3 ShaderProblem Serialize.string Serialize.int Serialize.int + |> Serialize.variant3 IndentOperatorRight Serialize.string Serialize.int Serialize.int + |> Serialize.finishCustomType + + +letCodec : Codec e Let +letCodec = + Serialize.customType + (\letSpaceEncoder letInEncoder letDefAlignmentEncoder letDefNameEncoder letDefEncoder letDestructEncoder letBodyEncoder letIndentDefEncoder letIndentInEncoder letIndentBodyEncoder value -> + case value of + LetSpace space row col -> + letSpaceEncoder space row col + + LetIn row col -> + letInEncoder row col + + LetDefAlignment int row col -> + letDefAlignmentEncoder int row col + + LetDefName row col -> + letDefNameEncoder row col + + LetDef name def row col -> + letDefEncoder name def row col + + LetDestruct destruct row col -> + letDestructEncoder destruct row col + + LetBody expr row col -> + letBodyEncoder expr row col + + LetIndentDef row col -> + letIndentDefEncoder row col + + LetIndentIn row col -> + letIndentInEncoder row col + + LetIndentBody row col -> + letIndentBodyEncoder row col + ) + |> Serialize.variant3 LetSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 LetIn Serialize.int Serialize.int + |> Serialize.variant3 LetDefAlignment Serialize.int Serialize.int Serialize.int + |> Serialize.variant2 LetDefName Serialize.int Serialize.int + |> Serialize.variant4 LetDef Serialize.string defCodec Serialize.int Serialize.int + |> Serialize.variant3 LetDestruct destructCodec Serialize.int Serialize.int + |> Serialize.variant3 LetBody exprCodec Serialize.int Serialize.int + |> Serialize.variant2 LetIndentDef Serialize.int Serialize.int + |> Serialize.variant2 LetIndentIn Serialize.int Serialize.int + |> Serialize.variant2 LetIndentBody Serialize.int Serialize.int + |> Serialize.finishCustomType + + +caseCodec : Codec e Case +caseCodec = + Serialize.customType + (\caseSpaceEncoder caseOfEncoder casePatternEncoder caseArrowEncoder caseExprEncoder caseBranchEncoder caseIndentOfEncoder caseIndentExprEncoder caseIndentPatternEncoder caseIndentArrowEncoder caseIndentBranchEncoder casePatternAlignmentEncoder value -> + case value of + CaseSpace space row col -> + caseSpaceEncoder space row col + + CaseOf row col -> + caseOfEncoder row col + + CasePattern pattern row col -> + casePatternEncoder pattern row col + + CaseArrow row col -> + caseArrowEncoder row col + + CaseExpr expr row col -> + caseExprEncoder expr row col + + CaseBranch expr row col -> + caseBranchEncoder expr row col + + CaseIndentOf row col -> + caseIndentOfEncoder row col + + CaseIndentExpr row col -> + caseIndentExprEncoder row col + + CaseIndentPattern row col -> + caseIndentPatternEncoder row col + + CaseIndentArrow row col -> + caseIndentArrowEncoder row col + + CaseIndentBranch row col -> + caseIndentBranchEncoder row col + + CasePatternAlignment indent row col -> + casePatternAlignmentEncoder indent row col + ) + |> Serialize.variant3 CaseSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 CaseOf Serialize.int Serialize.int + |> Serialize.variant3 CasePattern patternCodec Serialize.int Serialize.int + |> Serialize.variant2 CaseArrow Serialize.int Serialize.int + |> Serialize.variant3 CaseExpr (Serialize.lazy (\() -> exprCodec)) Serialize.int Serialize.int + |> Serialize.variant3 CaseBranch (Serialize.lazy (\() -> exprCodec)) Serialize.int Serialize.int + |> Serialize.variant2 CaseIndentOf Serialize.int Serialize.int + |> Serialize.variant2 CaseIndentExpr Serialize.int Serialize.int + |> Serialize.variant2 CaseIndentPattern Serialize.int Serialize.int + |> Serialize.variant2 CaseIndentArrow Serialize.int Serialize.int + |> Serialize.variant2 CaseIndentBranch Serialize.int Serialize.int + |> Serialize.variant3 CasePatternAlignment Serialize.int Serialize.int Serialize.int + |> Serialize.finishCustomType + + +ifCodec : Codec e If +ifCodec = + Serialize.customType + (\ifSpaceEncoder ifThenEncoder ifElseEncoder ifElseBranchStartEncoder ifConditionEncoder ifThenBranchEncoder ifElseBranchEncoder ifIndentConditionEncoder ifIndentThenEncoder ifIndentThenBranchEncoder ifIndentElseBranchEncoder ifIndentElseEncoder value -> + case value of + IfSpace space row col -> + ifSpaceEncoder space row col + + IfThen row col -> + ifThenEncoder row col + + IfElse row col -> + ifElseEncoder row col + + IfElseBranchStart row col -> + ifElseBranchStartEncoder row col + + IfCondition expr row col -> + ifConditionEncoder expr row col + + IfThenBranch expr row col -> + ifThenBranchEncoder expr row col + + IfElseBranch expr row col -> + ifElseBranchEncoder expr row col + + IfIndentCondition row col -> + ifIndentConditionEncoder row col + + IfIndentThen row col -> + ifIndentThenEncoder row col + + IfIndentThenBranch row col -> + ifIndentThenBranchEncoder row col + + IfIndentElseBranch row col -> + ifIndentElseBranchEncoder row col + + IfIndentElse row col -> + ifIndentElseEncoder row col + ) + |> Serialize.variant3 IfSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 IfThen Serialize.int Serialize.int + |> Serialize.variant2 IfElse Serialize.int Serialize.int + |> Serialize.variant2 IfElseBranchStart Serialize.int Serialize.int + |> Serialize.variant3 IfCondition exprCodec Serialize.int Serialize.int + |> Serialize.variant3 IfThenBranch exprCodec Serialize.int Serialize.int + |> Serialize.variant3 IfElseBranch exprCodec Serialize.int Serialize.int + |> Serialize.variant2 IfIndentCondition Serialize.int Serialize.int + |> Serialize.variant2 IfIndentThen Serialize.int Serialize.int + |> Serialize.variant2 IfIndentThenBranch Serialize.int Serialize.int + |> Serialize.variant2 IfIndentElseBranch Serialize.int Serialize.int + |> Serialize.variant2 IfIndentElse Serialize.int Serialize.int + |> Serialize.finishCustomType + + +listCodec : Codec e List_ +listCodec = + Serialize.customType + (\listSpaceEncoder listOpenEncoder listExprEncoder listEndEncoder listIndentOpenEncoder listIndentEndEncoder listIndentExprEncoder value -> + case value of + ListSpace space row col -> + listSpaceEncoder space row col + + ListOpen row col -> + listOpenEncoder row col + + ListExpr expr row col -> + listExprEncoder expr row col + + ListEnd row col -> + listEndEncoder row col + + ListIndentOpen row col -> + listIndentOpenEncoder row col + + ListIndentEnd row col -> + listIndentEndEncoder row col + + ListIndentExpr row col -> + listIndentExprEncoder row col + ) + |> Serialize.variant3 ListSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 ListOpen Serialize.int Serialize.int + |> Serialize.variant3 ListExpr exprCodec Serialize.int Serialize.int + |> Serialize.variant2 ListEnd Serialize.int Serialize.int + |> Serialize.variant2 ListIndentOpen Serialize.int Serialize.int + |> Serialize.variant2 ListIndentEnd Serialize.int Serialize.int + |> Serialize.variant2 ListIndentExpr Serialize.int Serialize.int + |> Serialize.finishCustomType + + +recordCodec : Codec e Record +recordCodec = + Serialize.customType + (\recordOpenEncoder recordEndEncoder recordFieldEncoder recordEqualsEncoder recordExprEncoder recordSpaceEncoder recordIndentOpenEncoder recordIndentEndEncoder recordIndentFieldEncoder recordIndentEqualsEncoder recordIndentExprEncoder value -> + case value of + RecordOpen row col -> + recordOpenEncoder row col + + RecordEnd row col -> + recordEndEncoder row col + + RecordField row col -> + recordFieldEncoder row col + + RecordEquals row col -> + recordEqualsEncoder row col + + RecordExpr expr row col -> + recordExprEncoder expr row col + + RecordSpace space row col -> + recordSpaceEncoder space row col + + RecordIndentOpen row col -> + recordIndentOpenEncoder row col + + RecordIndentEnd row col -> + recordIndentEndEncoder row col + + RecordIndentField row col -> + recordIndentFieldEncoder row col + + RecordIndentEquals row col -> + recordIndentEqualsEncoder row col + + RecordIndentExpr row col -> + recordIndentExprEncoder row col + ) + |> Serialize.variant2 RecordOpen Serialize.int Serialize.int + |> Serialize.variant2 RecordEnd Serialize.int Serialize.int + |> Serialize.variant2 RecordField Serialize.int Serialize.int + |> Serialize.variant2 RecordEquals Serialize.int Serialize.int + |> Serialize.variant3 RecordExpr exprCodec Serialize.int Serialize.int + |> Serialize.variant3 RecordSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 RecordIndentOpen Serialize.int Serialize.int + |> Serialize.variant2 RecordIndentEnd Serialize.int Serialize.int + |> Serialize.variant2 RecordIndentField Serialize.int Serialize.int + |> Serialize.variant2 RecordIndentEquals Serialize.int Serialize.int + |> Serialize.variant2 RecordIndentExpr Serialize.int Serialize.int + |> Serialize.finishCustomType + + +tupleCodec : Codec e Tuple +tupleCodec = + Serialize.customType + (\tupleExprEncoder tupleSpaceEncoder tupleEndEncoder tupleOperatorCloseEncoder tupleOperatorReservedEncoder tupleIndentExpr1Encoder tupleIndentExprNEncoder tupleIndentEndEncoder value -> + case value of + TupleExpr expr row col -> + tupleExprEncoder expr row col + + TupleSpace space row col -> + tupleSpaceEncoder space row col + + TupleEnd row col -> + tupleEndEncoder row col + + TupleOperatorClose row col -> + tupleOperatorCloseEncoder row col + + TupleOperatorReserved operator row col -> + tupleOperatorReservedEncoder operator row col + + TupleIndentExpr1 row col -> + tupleIndentExpr1Encoder row col + + TupleIndentExprN row col -> + tupleIndentExprNEncoder row col + + TupleIndentEnd row col -> + tupleIndentEndEncoder row col + ) + |> Serialize.variant3 TupleExpr exprCodec Serialize.int Serialize.int + |> Serialize.variant3 TupleSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 TupleEnd Serialize.int Serialize.int + |> Serialize.variant2 TupleOperatorClose Serialize.int Serialize.int + |> Serialize.variant3 TupleOperatorReserved Compiler.Parse.Symbol.badOperatorCodec Serialize.int Serialize.int + |> Serialize.variant2 TupleIndentExpr1 Serialize.int Serialize.int + |> Serialize.variant2 TupleIndentExprN Serialize.int Serialize.int + |> Serialize.variant2 TupleIndentEnd Serialize.int Serialize.int + |> Serialize.finishCustomType + + +funcCodec : Codec e Func +funcCodec = + Serialize.customType + (\funcSpaceEncoder funcArgEncoder funcBodyEncoder funcArrowEncoder funcIndentArgEncoder funcIndentArrowEncoder funcIndentBodyEncoder value -> + case value of + FuncSpace space row col -> + funcSpaceEncoder space row col + + FuncArg pattern row col -> + funcArgEncoder pattern row col + + FuncBody expr row col -> + funcBodyEncoder expr row col + + FuncArrow row col -> + funcArrowEncoder row col + + FuncIndentArg row col -> + funcIndentArgEncoder row col + + FuncIndentArrow row col -> + funcIndentArrowEncoder row col + + FuncIndentBody row col -> + funcIndentBodyEncoder row col + ) + |> Serialize.variant3 FuncSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant3 FuncArg patternCodec Serialize.int Serialize.int + |> Serialize.variant3 FuncBody exprCodec Serialize.int Serialize.int + |> Serialize.variant2 FuncArrow Serialize.int Serialize.int + |> Serialize.variant2 FuncIndentArg Serialize.int Serialize.int + |> Serialize.variant2 FuncIndentArrow Serialize.int Serialize.int + |> Serialize.variant2 FuncIndentBody Serialize.int Serialize.int + |> Serialize.finishCustomType + + +charCodec : Codec e Char +charCodec = + Serialize.customType + (\charEndlessEncoder charEscapeEncoder charNotStringEncoder value -> + case value of + CharEndless -> + charEndlessEncoder + + CharEscape escape -> + charEscapeEncoder escape + + CharNotString width -> + charNotStringEncoder width + ) + |> Serialize.variant0 CharEndless + |> Serialize.variant1 CharEscape escapeCodec + |> Serialize.variant1 CharNotString Serialize.int + |> Serialize.finishCustomType + + +string_Codec : Codec e String_ +string_Codec = + Serialize.customType + (\stringEndless_SingleEncoder stringEndless_MultiEncoder stringEscapeEncoder value -> + case value of + StringEndless_Single -> + stringEndless_SingleEncoder + + StringEndless_Multi -> + stringEndless_MultiEncoder + + StringEscape escape -> + stringEscapeEncoder escape + ) + |> Serialize.variant0 StringEndless_Single + |> Serialize.variant0 StringEndless_Multi + |> Serialize.variant1 StringEscape escapeCodec + |> Serialize.finishCustomType + + +numberCodec : Codec e Number +numberCodec = + Serialize.customType + (\numberEndEncoder numberDotEncoder numberHexDigitEncoder numberNoLeadingZeroEncoder value -> + case value of + NumberEnd -> + numberEndEncoder + + NumberDot n -> + numberDotEncoder n + + NumberHexDigit -> + numberHexDigitEncoder + + NumberNoLeadingZero -> + numberNoLeadingZeroEncoder + ) + |> Serialize.variant0 NumberEnd + |> Serialize.variant1 NumberDot Serialize.int + |> Serialize.variant0 NumberHexDigit + |> Serialize.variant0 NumberNoLeadingZero + |> Serialize.finishCustomType + + +escapeCodec : Codec e Escape +escapeCodec = + Serialize.customType + (\escapeUnknownEncoder badUnicodeFormatEncoder badUnicodeCodeEncoder badUnicodeLengthEncoder value -> + case value of + EscapeUnknown -> + escapeUnknownEncoder + + BadUnicodeFormat width -> + badUnicodeFormatEncoder width + + BadUnicodeCode width -> + badUnicodeCodeEncoder width + + BadUnicodeLength width numDigits badCode -> + badUnicodeLengthEncoder width numDigits badCode + ) + |> Serialize.variant0 EscapeUnknown + |> Serialize.variant1 BadUnicodeFormat Serialize.int + |> Serialize.variant1 BadUnicodeCode Serialize.int + |> Serialize.variant3 BadUnicodeLength Serialize.int Serialize.int Serialize.int + |> Serialize.finishCustomType + + +defCodec : Codec e Def +defCodec = + Serialize.customType + (\defSpaceEncoder defTypeEncoder defNameRepeatEncoder defNameMatchEncoder defArgEncoder defEqualsEncoder defBodyEncoder defIndentEqualsEncoder defIndentTypeEncoder defIndentBodyEncoder defAlignmentEncoder value -> + case value of + DefSpace space row col -> + defSpaceEncoder space row col + + DefType tipe row col -> + defTypeEncoder tipe row col + + DefNameRepeat row col -> + defNameRepeatEncoder row col + + DefNameMatch name row col -> + defNameMatchEncoder name row col + + DefArg pattern row col -> + defArgEncoder pattern row col + + DefEquals row col -> + defEqualsEncoder row col + + DefBody expr row col -> + defBodyEncoder expr row col + + DefIndentEquals row col -> + defIndentEqualsEncoder row col + + DefIndentType row col -> + defIndentTypeEncoder row col + + DefIndentBody row col -> + defIndentBodyEncoder row col + + DefAlignment indent row col -> + defAlignmentEncoder indent row col + ) + |> Serialize.variant3 DefSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant3 DefType typeCodec Serialize.int Serialize.int + |> Serialize.variant2 DefNameRepeat Serialize.int Serialize.int + |> Serialize.variant3 DefNameMatch Serialize.string Serialize.int Serialize.int + |> Serialize.variant3 DefArg patternCodec Serialize.int Serialize.int + |> Serialize.variant2 DefEquals Serialize.int Serialize.int + |> Serialize.variant3 DefBody exprCodec Serialize.int Serialize.int + |> Serialize.variant2 DefIndentEquals Serialize.int Serialize.int + |> Serialize.variant2 DefIndentType Serialize.int Serialize.int + |> Serialize.variant2 DefIndentBody Serialize.int Serialize.int + |> Serialize.variant3 DefAlignment Serialize.int Serialize.int Serialize.int + |> Serialize.finishCustomType + + +destructCodec : Codec e Destruct +destructCodec = + Serialize.customType + (\destructSpaceEncoder destructPatternEncoder destructEqualsEncoder destructBodyEncoder destructIndentEqualsEncoder destructIndentBodyEncoder value -> + case value of + DestructSpace space row col -> + destructSpaceEncoder space row col + + DestructPattern pattern row col -> + destructPatternEncoder pattern row col + + DestructEquals row col -> + destructEqualsEncoder row col + + DestructBody expr row col -> + destructBodyEncoder expr row col + + DestructIndentEquals row col -> + destructIndentEqualsEncoder row col + + DestructIndentBody row col -> + destructIndentBodyEncoder row col + ) + |> Serialize.variant3 DestructSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant3 DestructPattern patternCodec Serialize.int Serialize.int + |> Serialize.variant2 DestructEquals Serialize.int Serialize.int + |> Serialize.variant3 DestructBody exprCodec Serialize.int Serialize.int + |> Serialize.variant2 DestructIndentEquals Serialize.int Serialize.int + |> Serialize.variant2 DestructIndentBody Serialize.int Serialize.int + |> Serialize.finishCustomType + + +pRecordCodec : Codec e PRecord +pRecordCodec = + Serialize.customType + (\pRecordOpenEncoder pRecordEndEncoder pRecordFieldEncoder pRecordSpaceEncoder pRecordIndentOpenEncoder pRecordIndentEndEncoder pRecordIndentFieldEncoder value -> + case value of + PRecordOpen row col -> + pRecordOpenEncoder row col + + PRecordEnd row col -> + pRecordEndEncoder row col + + PRecordField row col -> + pRecordFieldEncoder row col + + PRecordSpace space row col -> + pRecordSpaceEncoder space row col + + PRecordIndentOpen row col -> + pRecordIndentOpenEncoder row col + + PRecordIndentEnd row col -> + pRecordIndentEndEncoder row col + + PRecordIndentField row col -> + pRecordIndentFieldEncoder row col + ) + |> Serialize.variant2 PRecordOpen Serialize.int Serialize.int + |> Serialize.variant2 PRecordEnd Serialize.int Serialize.int + |> Serialize.variant2 PRecordField Serialize.int Serialize.int + |> Serialize.variant3 PRecordSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 PRecordIndentOpen Serialize.int Serialize.int + |> Serialize.variant2 PRecordIndentEnd Serialize.int Serialize.int + |> Serialize.variant2 PRecordIndentField Serialize.int Serialize.int + |> Serialize.finishCustomType + + +pTupleCodec : Codec e PTuple +pTupleCodec = + Serialize.customType + (\pTupleOpenEncoder pTupleEndEncoder pTupleExprEncoder pTupleSpaceEncoder pTupleIndentEndEncoder pTupleIndentExpr1Encoder pTupleIndentExprNEncoder value -> + case value of + PTupleOpen row col -> + pTupleOpenEncoder row col + + PTupleEnd row col -> + pTupleEndEncoder row col + + PTupleExpr pattern row col -> + pTupleExprEncoder pattern row col + + PTupleSpace space row col -> + pTupleSpaceEncoder space row col + + PTupleIndentEnd row col -> + pTupleIndentEndEncoder row col + + PTupleIndentExpr1 row col -> + pTupleIndentExpr1Encoder row col + + PTupleIndentExprN row col -> + pTupleIndentExprNEncoder row col + ) + |> Serialize.variant2 PTupleOpen Serialize.int Serialize.int + |> Serialize.variant2 PTupleEnd Serialize.int Serialize.int + |> Serialize.variant3 PTupleExpr patternCodec Serialize.int Serialize.int + |> Serialize.variant3 PTupleSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 PTupleIndentEnd Serialize.int Serialize.int + |> Serialize.variant2 PTupleIndentExpr1 Serialize.int Serialize.int + |> Serialize.variant2 PTupleIndentExprN Serialize.int Serialize.int + |> Serialize.finishCustomType + + +pListCodec : Codec e PList +pListCodec = + Serialize.customType + (\pListOpenEncoder pListEndEncoder pListExprEncoder pListSpaceEncoder pListIndentOpenEncoder pListIndentEndEncoder pListIndentExprEncoder value -> + case value of + PListOpen row col -> + pListOpenEncoder row col + + PListEnd row col -> + pListEndEncoder row col + + PListExpr pattern row col -> + pListExprEncoder pattern row col + + PListSpace space row col -> + pListSpaceEncoder space row col + + PListIndentOpen row col -> + pListIndentOpenEncoder row col + + PListIndentEnd row col -> + pListIndentEndEncoder row col + + PListIndentExpr row col -> + pListIndentExprEncoder row col + ) + |> Serialize.variant2 PListOpen Serialize.int Serialize.int + |> Serialize.variant2 PListEnd Serialize.int Serialize.int + |> Serialize.variant3 PListExpr (Serialize.lazy (\() -> patternCodec)) Serialize.int Serialize.int + |> Serialize.variant3 PListSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 PListIndentOpen Serialize.int Serialize.int + |> Serialize.variant2 PListIndentEnd Serialize.int Serialize.int + |> Serialize.variant2 PListIndentExpr Serialize.int Serialize.int + |> Serialize.finishCustomType + + +tRecordCodec : Codec e TRecord +tRecordCodec = + Serialize.customType + (\tRecordOpenEncoder tRecordEndEncoder tRecordFieldEncoder tRecordColonEncoder tRecordTypeEncoder tRecordSpaceEncoder tRecordIndentOpenEncoder tRecordIndentFieldEncoder tRecordIndentColonEncoder tRecordIndentTypeEncoder tRecordIndentEndEncoder value -> + case value of + TRecordOpen row col -> + tRecordOpenEncoder row col + + TRecordEnd row col -> + tRecordEndEncoder row col + + TRecordField row col -> + tRecordFieldEncoder row col + + TRecordColon row col -> + tRecordColonEncoder row col + + TRecordType tipe row col -> + tRecordTypeEncoder tipe row col + + TRecordSpace space row col -> + tRecordSpaceEncoder space row col + + TRecordIndentOpen row col -> + tRecordIndentOpenEncoder row col + + TRecordIndentField row col -> + tRecordIndentFieldEncoder row col + + TRecordIndentColon row col -> + tRecordIndentColonEncoder row col + + TRecordIndentType row col -> + tRecordIndentTypeEncoder row col + + TRecordIndentEnd row col -> + tRecordIndentEndEncoder row col + ) + |> Serialize.variant2 TRecordOpen Serialize.int Serialize.int + |> Serialize.variant2 TRecordEnd Serialize.int Serialize.int + |> Serialize.variant2 TRecordField Serialize.int Serialize.int + |> Serialize.variant2 TRecordColon Serialize.int Serialize.int + |> Serialize.variant3 TRecordType (Serialize.lazy (\() -> typeCodec)) Serialize.int Serialize.int + |> Serialize.variant3 TRecordSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 TRecordIndentOpen Serialize.int Serialize.int + |> Serialize.variant2 TRecordIndentField Serialize.int Serialize.int + |> Serialize.variant2 TRecordIndentColon Serialize.int Serialize.int + |> Serialize.variant2 TRecordIndentType Serialize.int Serialize.int + |> Serialize.variant2 TRecordIndentEnd Serialize.int Serialize.int + |> Serialize.finishCustomType + + +tTupleCodec : Codec e TTuple +tTupleCodec = + Serialize.customType + (\tTupleOpenEncoder tTupleEndEncoder tTupleTypeEncoder tTupleSpaceEncoder tTupleIndentType1Encoder tTupleIndentTypeNEncoder tTupleIndentEndEncoder value -> + case value of + TTupleOpen row col -> + tTupleOpenEncoder row col + + TTupleEnd row col -> + tTupleEndEncoder row col + + TTupleType tipe row col -> + tTupleTypeEncoder tipe row col + + TTupleSpace space row col -> + tTupleSpaceEncoder space row col + + TTupleIndentType1 row col -> + tTupleIndentType1Encoder row col + + TTupleIndentTypeN row col -> + tTupleIndentTypeNEncoder row col + + TTupleIndentEnd row col -> + tTupleIndentEndEncoder row col + ) + |> Serialize.variant2 TTupleOpen Serialize.int Serialize.int + |> Serialize.variant2 TTupleEnd Serialize.int Serialize.int + |> Serialize.variant3 TTupleType typeCodec Serialize.int Serialize.int + |> Serialize.variant3 TTupleSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 TTupleIndentType1 Serialize.int Serialize.int + |> Serialize.variant2 TTupleIndentTypeN Serialize.int Serialize.int + |> Serialize.variant2 TTupleIndentEnd Serialize.int Serialize.int + |> Serialize.finishCustomType + + +customTypeCodec : Codec e CustomType +customTypeCodec = + Serialize.customType + (\cT_SpaceEncoder cT_NameEncoder cT_EqualsEncoder cT_BarEncoder cT_VariantEncoder cT_VariantArgEncoder cT_IndentEqualsEncoder cT_IndentBarEncoder cT_IndentAfterBarEncoder cT_IndentAfterEqualsEncoder value -> + case value of + CT_Space space row col -> + cT_SpaceEncoder space row col + + CT_Name row col -> + cT_NameEncoder row col + + CT_Equals row col -> + cT_EqualsEncoder row col + + CT_Bar row col -> + cT_BarEncoder row col + + CT_Variant row col -> + cT_VariantEncoder row col + + CT_VariantArg tipe row col -> + cT_VariantArgEncoder tipe row col + + CT_IndentEquals row col -> + cT_IndentEqualsEncoder row col + + CT_IndentBar row col -> + cT_IndentBarEncoder row col + + CT_IndentAfterBar row col -> + cT_IndentAfterBarEncoder row col + + CT_IndentAfterEquals row col -> + cT_IndentAfterEqualsEncoder row col + ) + |> Serialize.variant3 CT_Space spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 CT_Name Serialize.int Serialize.int + |> Serialize.variant2 CT_Equals Serialize.int Serialize.int + |> Serialize.variant2 CT_Bar Serialize.int Serialize.int + |> Serialize.variant2 CT_Variant Serialize.int Serialize.int + |> Serialize.variant3 CT_VariantArg typeCodec Serialize.int Serialize.int + |> Serialize.variant2 CT_IndentEquals Serialize.int Serialize.int + |> Serialize.variant2 CT_IndentBar Serialize.int Serialize.int + |> Serialize.variant2 CT_IndentAfterBar Serialize.int Serialize.int + |> Serialize.variant2 CT_IndentAfterEquals Serialize.int Serialize.int + |> Serialize.finishCustomType + + +typeAliasCodec : Codec e TypeAlias +typeAliasCodec = + Serialize.customType + (\aliasSpaceEncoder aliasNameEncoder aliasEqualsEncoder aliasBodyEncoder aliasIndentEqualsEncoder aliasIndentBodyEncoder value -> + case value of + AliasSpace space row col -> + aliasSpaceEncoder space row col + + AliasName row col -> + aliasNameEncoder row col + + AliasEquals row col -> + aliasEqualsEncoder row col + + AliasBody tipe row col -> + aliasBodyEncoder tipe row col + + AliasIndentEquals row col -> + aliasIndentEqualsEncoder row col + + AliasIndentBody row col -> + aliasIndentBodyEncoder row col + ) + |> Serialize.variant3 AliasSpace spaceCodec Serialize.int Serialize.int + |> Serialize.variant2 AliasName Serialize.int Serialize.int + |> Serialize.variant2 AliasEquals Serialize.int Serialize.int + |> Serialize.variant3 AliasBody typeCodec Serialize.int Serialize.int + |> Serialize.variant2 AliasIndentEquals Serialize.int Serialize.int + |> Serialize.variant2 AliasIndentBody Serialize.int Serialize.int + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Error/Type.elm b/src/Compiler/Reporting/Error/Type.elm index b143b1ca7..3a9b5dfe5 100644 --- a/src/Compiler/Reporting/Error/Type.elm +++ b/src/Compiler/Reporting/Error/Type.elm @@ -8,8 +8,7 @@ module Compiler.Reporting.Error.Type exposing , PContext(..) , PExpected(..) , SubContext(..) - , errorDecoder - , errorEncoder + , errorCodec , ptypeReplace , toReport , typeReplace @@ -18,8 +17,6 @@ module Compiler.Reporting.Error.Type exposing import Compiler.AST.Canonical as Can import Compiler.Data.Index as Index import Compiler.Data.Name exposing (Name) -import Compiler.Json.Decode as DecodeX -import Compiler.Json.Encode as EncodeX import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code @@ -27,10 +24,10 @@ import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Render.Type.Localizer as L import Compiler.Reporting.Report as Report import Compiler.Reporting.Suggest as Suggest +import Compiler.Serialize as S import Compiler.Type.Error as T import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) @@ -2524,711 +2521,318 @@ toInfiniteReport source localizer region name overallType = -- ENCODERS and DECODERS -errorEncoder : Error -> Encode.Value -errorEncoder error = - case error of - BadExpr region category actualType expected -> - Encode.object - [ ( "type", Encode.string "BadExpr" ) - , ( "region", A.regionEncoder region ) - , ( "category", categoryEncoder category ) - , ( "actualType", T.typeEncoder actualType ) - , ( "expected", expectedEncoder T.typeEncoder expected ) - ] - - BadPattern region category tipe expected -> - Encode.object - [ ( "type", Encode.string "BadPattern" ) - , ( "region", A.regionEncoder region ) - , ( "category", pCategoryEncoder category ) - , ( "tipe", T.typeEncoder tipe ) - , ( "expected", pExpectedEncoder T.typeEncoder expected ) - ] - - InfiniteType region name overallType -> - Encode.object - [ ( "type", Encode.string "InfiniteType" ) - , ( "region", A.regionEncoder region ) - , ( "name", Encode.string name ) - , ( "overallType", T.typeEncoder overallType ) - ] - - -errorDecoder : Decode.Decoder Error -errorDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "BadExpr" -> - Decode.map4 BadExpr - (Decode.field "region" A.regionDecoder) - (Decode.field "category" categoryDecoder) - (Decode.field "actualType" T.typeDecoder) - (Decode.field "expected" (expectedDecoder T.typeDecoder)) - - "BadPattern" -> - Decode.map4 BadPattern - (Decode.field "region" A.regionDecoder) - (Decode.field "category" pCategoryDecoder) - (Decode.field "tipe" T.typeDecoder) - (Decode.field "expected" (pExpectedDecoder T.typeDecoder)) - - "InfiniteType" -> - Decode.map3 InfiniteType - (Decode.field "region" A.regionDecoder) - (Decode.field "name" Decode.string) - (Decode.field "overallType" T.typeDecoder) - - _ -> - Decode.fail ("Failed to decode Error's type: " ++ type_) - ) - - -categoryEncoder : Category -> Encode.Value -categoryEncoder category = - case category of - List -> - Encode.object - [ ( "type", Encode.string "List" ) - ] - - Number -> - Encode.object - [ ( "type", Encode.string "Number" ) - ] - - Float -> - Encode.object - [ ( "type", Encode.string "Float" ) - ] - - String -> - Encode.object - [ ( "type", Encode.string "String" ) - ] - - Char -> - Encode.object - [ ( "type", Encode.string "Char" ) - ] - - If -> - Encode.object - [ ( "type", Encode.string "If" ) - ] - - Case -> - Encode.object - [ ( "type", Encode.string "Case" ) - ] - - CallResult maybeName -> - Encode.object - [ ( "type", Encode.string "CallResult" ) - , ( "maybeName", maybeNameEncoder maybeName ) - ] - - Lambda -> - Encode.object - [ ( "type", Encode.string "Lambda" ) - ] - - Accessor field -> - Encode.object - [ ( "type", Encode.string "Accessor" ) - , ( "field", Encode.string field ) - ] - - Access field -> - Encode.object - [ ( "type", Encode.string "Access" ) - , ( "field", Encode.string field ) - ] - - Record -> - Encode.object - [ ( "type", Encode.string "Record" ) - ] - - Tuple -> - Encode.object - [ ( "type", Encode.string "Tuple" ) - ] - - Unit -> - Encode.object - [ ( "type", Encode.string "Unit" ) - ] - - Shader -> - Encode.object - [ ( "type", Encode.string "Shader" ) - ] - - Effects -> - Encode.object - [ ( "type", Encode.string "Effects" ) - ] - - Local name -> - Encode.object - [ ( "type", Encode.string "Local" ) - , ( "name", Encode.string name ) - ] - - Foreign name -> - Encode.object - [ ( "type", Encode.string "Foreign" ) - , ( "name", Encode.string name ) - ] - - -categoryDecoder : Decode.Decoder Category -categoryDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "List" -> - Decode.succeed List - - "Number" -> - Decode.succeed Number - - "Float" -> - Decode.succeed Float - - "String" -> - Decode.succeed String - - "Char" -> - Decode.succeed Char - - "If" -> - Decode.succeed If - - "Case" -> - Decode.succeed Case - - "CallResult" -> - Decode.map CallResult (Decode.field "maybeName" maybeNameDecoder) - - "Lambda" -> - Decode.succeed Lambda - - "Accessor" -> - Decode.map Accessor (Decode.field "field" Decode.string) - - "Access" -> - Decode.map Access (Decode.field "field" Decode.string) - - "Record" -> - Decode.succeed Record - - "Tuple" -> - Decode.succeed Tuple - - "Unit" -> - Decode.succeed Unit - - "Shader" -> - Decode.succeed Shader - - "Effects" -> - Decode.succeed Effects - - "Local" -> - Decode.map Local (Decode.field "name" Decode.string) - - "Foreign" -> - Decode.map Foreign (Decode.field "name" Decode.string) - - _ -> - Decode.fail ("Failed to decode Category's type: " ++ type_) - ) - - -expectedEncoder : (a -> Encode.Value) -> Expected a -> Encode.Value -expectedEncoder encoder expected = - case expected of - NoExpectation expectedType -> - Encode.object - [ ( "type", Encode.string "NoExpectation" ) - , ( "expectedType", encoder expectedType ) - ] - - FromContext region context expectedType -> - Encode.object - [ ( "type", Encode.string "FromContext" ) - , ( "region", A.regionEncoder region ) - , ( "context", contextEncoder context ) - , ( "expectedType", encoder expectedType ) - ] - - FromAnnotation name arity subContext expectedType -> - Encode.object - [ ( "type", Encode.string "FromAnnotation" ) - , ( "name", Encode.string name ) - , ( "arity", Encode.int arity ) - , ( "subContext", subContextEncoder subContext ) - , ( "expectedType", encoder expectedType ) - ] - - -expectedDecoder : Decode.Decoder a -> Decode.Decoder (Expected a) -expectedDecoder decoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "NoExpectation" -> - Decode.map NoExpectation - (Decode.field "expectedType" decoder) - - "FromContext" -> - Decode.map3 FromContext - (Decode.field "region" A.regionDecoder) - (Decode.field "context" contextDecoder) - (Decode.field "expectedType" decoder) - - "FromAnnotation" -> - Decode.map4 FromAnnotation - (Decode.field "name" Decode.string) - (Decode.field "arity" Decode.int) - (Decode.field "subContext" subContextDecoder) - (Decode.field "expectedType" decoder) - - _ -> - Decode.fail ("Unknown Expected's type: " ++ type_) - ) - - -contextDecoder : Decode.Decoder Context -contextDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "ListEntry" -> - Decode.map ListEntry (Decode.field "index" Index.zeroBasedDecoder) - - "Negate" -> - Decode.succeed Negate - - "OpLeft" -> - Decode.map OpLeft (Decode.field "op" Decode.string) - - "OpRight" -> - Decode.map OpRight (Decode.field "op" Decode.string) +errorCodec : Codec e Error +errorCodec = + Serialize.customType + (\badExprEncoder badPatternEncoder infiniteTypeEncoder value -> + case value of + BadExpr region category actualType expected -> + badExprEncoder region category actualType expected - "IfCondition" -> - Decode.succeed IfCondition + BadPattern region category tipe expected -> + badPatternEncoder region category tipe expected - "IfBranch" -> - Decode.map IfBranch (Decode.field "index" Index.zeroBasedDecoder) - - "CaseBranch" -> - Decode.map CaseBranch (Decode.field "index" Index.zeroBasedDecoder) - - "CallArity" -> - Decode.map2 CallArity - (Decode.field "maybeFuncName" maybeNameDecoder) - (Decode.field "numGivenArgs" Decode.int) - - "CallArg" -> - Decode.map2 CallArg - (Decode.field "maybeFuncName" maybeNameDecoder) - (Decode.field "index" Index.zeroBasedDecoder) - - "RecordAccess" -> - Decode.map4 RecordAccess - (Decode.field "recordRegion" A.regionDecoder) - (Decode.field "maybeName" (Decode.nullable Decode.string)) - (Decode.field "fieldRegion" A.regionDecoder) - (Decode.field "field" Decode.string) - - "RecordUpdateKeys" -> - Decode.map2 RecordUpdateKeys - (Decode.field "record" Decode.string) - (Decode.field "expectedFields" (DecodeX.assocListDict identity Decode.string Can.fieldUpdateDecoder)) - - "RecordUpdateValue" -> - Decode.map RecordUpdateValue (Decode.field "field" Decode.string) - - "Destructure" -> - Decode.succeed Destructure - - _ -> - Decode.fail ("Unknown Context's type: " ++ type_) - ) - - -contextEncoder : Context -> Encode.Value -contextEncoder context = - case context of - ListEntry index -> - Encode.object - [ ( "type", Encode.string "ListEntry" ) - , ( "index", Index.zeroBasedEncoder index ) - ] - - Negate -> - Encode.object - [ ( "type", Encode.string "Negate" ) - ] - - OpLeft op -> - Encode.object - [ ( "type", Encode.string "OpLeft" ) - , ( "op", Encode.string op ) - ] - - OpRight op -> - Encode.object - [ ( "type", Encode.string "OpRight" ) - , ( "op", Encode.string op ) - ] - - IfCondition -> - Encode.object - [ ( "type", Encode.string "IfCondition" ) - ] - - IfBranch index -> - Encode.object - [ ( "type", Encode.string "IfBranch" ) - , ( "index", Index.zeroBasedEncoder index ) - ] - - CaseBranch index -> - Encode.object - [ ( "type", Encode.string "CaseBranch" ) - , ( "index", Index.zeroBasedEncoder index ) - ] - - CallArity maybeFuncName numGivenArgs -> - Encode.object - [ ( "type", Encode.string "CallArity" ) - , ( "maybeFuncName", maybeNameEncoder maybeFuncName ) - , ( "numGivenArgs", Encode.int numGivenArgs ) - ] - - CallArg maybeFuncName index -> - Encode.object - [ ( "type", Encode.string "CallArg" ) - , ( "maybeFuncName", maybeNameEncoder maybeFuncName ) - , ( "index", Index.zeroBasedEncoder index ) - ] - - RecordAccess recordRegion maybeName fieldRegion field -> - Encode.object - [ ( "type", Encode.string "RecordAccess" ) - , ( "recordRegion", A.regionEncoder recordRegion ) - , ( "maybeName", EncodeX.maybe Encode.string maybeName ) - , ( "fieldRegion", A.regionEncoder fieldRegion ) - , ( "field", Encode.string field ) - ] - - RecordUpdateKeys record expectedFields -> - Encode.object - [ ( "type", Encode.string "RecordUpdateKeys" ) - , ( "record", Encode.string record ) - , ( "expectedFields", EncodeX.assocListDict compare Encode.string Can.fieldUpdateEncoder expectedFields ) - ] - - RecordUpdateValue field -> - Encode.object - [ ( "type", Encode.string "RecordUpdateValue" ) - , ( "field", Encode.string field ) - ] - - Destructure -> - Encode.object - [ ( "type", Encode.string "Destructure" ) - ] - - -subContextDecoder : Decode.Decoder SubContext -subContextDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "TypedIfBranch" -> - Decode.map TypedIfBranch - (Decode.field "index" Index.zeroBasedDecoder) - - "TypedCaseBranch" -> - Decode.map TypedCaseBranch - (Decode.field "index" Index.zeroBasedDecoder) - - "TypedBody" -> - Decode.succeed TypedBody + InfiniteType region name overallType -> + infiniteTypeEncoder region name overallType + ) + |> Serialize.variant4 BadExpr A.regionCodec categoryCodec T.typeCodec (expectedCodec T.typeCodec) + |> Serialize.variant4 BadPattern A.regionCodec pCategoryCodec T.typeCodec (pExpectedCodec T.typeCodec) + |> Serialize.variant3 InfiniteType A.regionCodec Serialize.string T.typeCodec + |> Serialize.finishCustomType - _ -> - Decode.fail ("Unknown SubContext's type: " ++ type_) - ) +categoryCodec : Codec e Category +categoryCodec = + Serialize.customType + (\listEncoder numberEncoder floatEncoder stringEncoder charEncoder ifEncoder caseEncoder callResultEncoder lambdaEncoder accessorEncoder accessEncoder recordEncoder tupleEncoder unitEncoder shaderEncoder effectsEncoder localEncoder foreignEncoder value -> + case value of + List -> + listEncoder -subContextEncoder : SubContext -> Encode.Value -subContextEncoder subContext = - case subContext of - TypedIfBranch index -> - Encode.object - [ ( "type", Encode.string "TypedIfBranch" ) - , ( "index", Index.zeroBasedEncoder index ) - ] + Number -> + numberEncoder - TypedCaseBranch index -> - Encode.object - [ ( "type", Encode.string "TypedCaseBranch" ) - , ( "index", Index.zeroBasedEncoder index ) - ] + Float -> + floatEncoder - TypedBody -> - Encode.object - [ ( "type", Encode.string "TypedBody" ) - ] + String -> + stringEncoder + Char -> + charEncoder -pCategoryEncoder : PCategory -> Encode.Value -pCategoryEncoder pCategory = - case pCategory of - PRecord -> - Encode.object - [ ( "type", Encode.string "PRecord" ) - ] + If -> + ifEncoder - PUnit -> - Encode.object - [ ( "type", Encode.string "PUnit" ) - ] + Case -> + caseEncoder - PTuple -> - Encode.object - [ ( "type", Encode.string "PTuple" ) - ] + CallResult maybeName -> + callResultEncoder maybeName - PList -> - Encode.object - [ ( "type", Encode.string "PList" ) - ] + Lambda -> + lambdaEncoder - PCtor name -> - Encode.object - [ ( "type", Encode.string "PCtor" ) - , ( "name", Encode.string name ) - ] + Accessor field -> + accessorEncoder field - PInt -> - Encode.object - [ ( "type", Encode.string "PInt" ) - ] + Access field -> + accessEncoder field - PStr -> - Encode.object - [ ( "type", Encode.string "PStr" ) - ] + Record -> + recordEncoder - PChr -> - Encode.object - [ ( "type", Encode.string "PChr" ) - ] + Tuple -> + tupleEncoder - PBool -> - Encode.object - [ ( "type", Encode.string "PBool" ) - ] + Unit -> + unitEncoder + Shader -> + shaderEncoder -pCategoryDecoder : Decode.Decoder PCategory -pCategoryDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PRecord" -> - Decode.succeed PRecord + Effects -> + effectsEncoder - "PUnit" -> - Decode.succeed PUnit + Local name -> + localEncoder name - "PTuple" -> - Decode.succeed PTuple - - "PList" -> - Decode.succeed PList - - "PCtor" -> - Decode.map PCtor (Decode.field "name" Decode.string) + Foreign name -> + foreignEncoder name + ) + |> Serialize.variant0 List + |> Serialize.variant0 Number + |> Serialize.variant0 Float + |> Serialize.variant0 String + |> Serialize.variant0 Char + |> Serialize.variant0 If + |> Serialize.variant0 Case + |> Serialize.variant1 CallResult maybeNameCodec + |> Serialize.variant0 Lambda + |> Serialize.variant1 Accessor Serialize.string + |> Serialize.variant1 Access Serialize.string + |> Serialize.variant0 Record + |> Serialize.variant0 Tuple + |> Serialize.variant0 Unit + |> Serialize.variant0 Shader + |> Serialize.variant0 Effects + |> Serialize.variant1 Local Serialize.string + |> Serialize.variant1 Foreign Serialize.string + |> Serialize.finishCustomType + + +expectedCodec : Codec e tipe -> Codec e (Expected tipe) +expectedCodec tipe = + Serialize.customType + (\noExpectationEncoder fromContextEncoder fromAnnotationEncoder value -> + case value of + NoExpectation expectedType -> + noExpectationEncoder expectedType + + FromContext region context expectedType -> + fromContextEncoder region context expectedType + + FromAnnotation name arity subContext expectedType -> + fromAnnotationEncoder name arity subContext expectedType + ) + |> Serialize.variant1 NoExpectation tipe + |> Serialize.variant3 FromContext A.regionCodec contextCodec tipe + |> Serialize.variant4 FromAnnotation Serialize.string Serialize.int subContextCodec tipe + |> Serialize.finishCustomType - "PInt" -> - Decode.succeed PInt - "PStr" -> - Decode.succeed PStr +contextCodec : Codec e Context +contextCodec = + Serialize.customType + (\listEntryEncoder negateEncoder opLeftEncoder opRightEncoder ifConditionEncoder ifBranchEncoder caseBranchEncoder callArityEncoder callArgEncoder recordAccessEncoder recordUpdateKeysEncoder recordUpdateValueEncoder destructureEncoder value -> + case value of + ListEntry index -> + listEntryEncoder index - "PChr" -> - Decode.succeed PChr + Negate -> + negateEncoder - "PBool" -> - Decode.succeed PBool + OpLeft op -> + opLeftEncoder op - _ -> - Decode.fail ("Unknown PCategory's type: " ++ type_) - ) + OpRight op -> + opRightEncoder op + IfCondition -> + ifConditionEncoder -pExpectedEncoder : (a -> Encode.Value) -> PExpected a -> Encode.Value -pExpectedEncoder encoder pExpected = - case pExpected of - PNoExpectation expectedType -> - Encode.object - [ ( "type", Encode.string "PNoExpectation" ) - , ( "expectedType", encoder expectedType ) - ] + IfBranch index -> + ifBranchEncoder index - PFromContext region context expectedType -> - Encode.object - [ ( "type", Encode.string "PFromContext" ) - , ( "region", A.regionEncoder region ) - , ( "context", pContextEncoder context ) - , ( "expectedType", encoder expectedType ) - ] + CaseBranch index -> + caseBranchEncoder index + CallArity maybeFuncName numGivenArgs -> + callArityEncoder maybeFuncName numGivenArgs -pExpectedDecoder : Decode.Decoder a -> Decode.Decoder (PExpected a) -pExpectedDecoder decoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PNoExpectation" -> - Decode.map PNoExpectation (Decode.field "expectedType" decoder) + CallArg maybeFuncName index -> + callArgEncoder maybeFuncName index - -- | PFromContext A.Region PContext tipe - "PFromContext" -> - Decode.map3 PFromContext - (Decode.field "region" A.regionDecoder) - (Decode.field "context" pContextDecoder) - (Decode.field "expectedType" decoder) + RecordAccess recordRegion maybeName fieldRegion field -> + recordAccessEncoder recordRegion maybeName fieldRegion field - _ -> - Decode.fail ("Failed to decode PExpected's type: " ++ type_) - ) + RecordUpdateKeys record expectedFields -> + recordUpdateKeysEncoder record expectedFields + RecordUpdateValue field -> + recordUpdateValueEncoder field -maybeNameEncoder : MaybeName -> Encode.Value -maybeNameEncoder maybeName = - case maybeName of - FuncName name -> - Encode.object - [ ( "type", Encode.string "FuncName" ) - , ( "name", Encode.string name ) - ] + Destructure -> + destructureEncoder + ) + |> Serialize.variant1 ListEntry Index.zeroBasedCodec + |> Serialize.variant0 Negate + |> Serialize.variant1 OpLeft Serialize.string + |> Serialize.variant1 OpRight Serialize.string + |> Serialize.variant0 IfCondition + |> Serialize.variant1 IfBranch Index.zeroBasedCodec + |> Serialize.variant1 CaseBranch Index.zeroBasedCodec + |> Serialize.variant2 CallArity maybeNameCodec Serialize.int + |> Serialize.variant2 CallArg maybeNameCodec Index.zeroBasedCodec + |> Serialize.variant4 + RecordAccess + A.regionCodec + (Serialize.maybe Serialize.string) + A.regionCodec + Serialize.string + |> Serialize.variant2 RecordUpdateKeys Serialize.string (S.assocListDict identity compare Serialize.string Can.fieldUpdateCodec) + |> Serialize.variant1 RecordUpdateValue Serialize.string + |> Serialize.variant0 Destructure + |> Serialize.finishCustomType + + +subContextCodec : Codec e SubContext +subContextCodec = + Serialize.customType + (\typedIfBranchEncoder typedCaseBranchEncoder typedBodyEncoder value -> + case value of + TypedIfBranch index -> + typedIfBranchEncoder index + + TypedCaseBranch index -> + typedCaseBranchEncoder index + + TypedBody -> + typedBodyEncoder + ) + |> Serialize.variant1 TypedIfBranch Index.zeroBasedCodec + |> Serialize.variant1 TypedCaseBranch Index.zeroBasedCodec + |> Serialize.variant0 TypedBody + |> Serialize.finishCustomType - CtorName name -> - Encode.object - [ ( "type", Encode.string "CtorName" ) - , ( "name", Encode.string name ) - ] - OpName op -> - Encode.object - [ ( "type", Encode.string "OpName" ) - , ( "op", Encode.string op ) - ] - - NoName -> - Encode.object - [ ( "type", Encode.string "NoName" ) - ] +pCategoryCodec : Codec e PCategory +pCategoryCodec = + Serialize.customType + (\pRecordEncoder pUnitEncoder pTupleEncoder pListEncoder pCtorEncoder pIntEncoder pStrEncoder pChrEncoder pBoolEncoder value -> + case value of + PRecord -> + pRecordEncoder + PUnit -> + pUnitEncoder -maybeNameDecoder : Decode.Decoder MaybeName -maybeNameDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "FuncName" -> - Decode.map FuncName (Decode.field "name" Decode.string) + PTuple -> + pTupleEncoder - "CtorName" -> - Decode.map CtorName (Decode.field "name" Decode.string) + PList -> + pListEncoder - "OpName" -> - Decode.map OpName (Decode.field "op" Decode.string) + PCtor name -> + pCtorEncoder name - "NoName" -> - Decode.succeed NoName + PInt -> + pIntEncoder - _ -> - Decode.fail ("Failed to decode MaybeName's type: " ++ type_) - ) + PStr -> + pStrEncoder + PChr -> + pChrEncoder -pContextEncoder : PContext -> Encode.Value -pContextEncoder pContext = - case pContext of - PTypedArg name index -> - Encode.object - [ ( "type", Encode.string "PTypedArg" ) - , ( "name", Encode.string name ) - , ( "index", Index.zeroBasedEncoder index ) - ] + PBool -> + pBoolEncoder + ) + |> Serialize.variant0 PRecord + |> Serialize.variant0 PUnit + |> Serialize.variant0 PTuple + |> Serialize.variant0 PList + |> Serialize.variant1 PCtor Serialize.string + |> Serialize.variant0 PInt + |> Serialize.variant0 PStr + |> Serialize.variant0 PChr + |> Serialize.variant0 PBool + |> Serialize.finishCustomType + + +pExpectedCodec : Codec e tipe -> Codec e (PExpected tipe) +pExpectedCodec tipe = + Serialize.customType + (\pNoExpectationEncoder pFromContextEncoder value -> + case value of + PNoExpectation expectedType -> + pNoExpectationEncoder expectedType + + PFromContext region context expectedType -> + pFromContextEncoder region context expectedType + ) + |> Serialize.variant1 PNoExpectation tipe + |> Serialize.variant3 PFromContext A.regionCodec pContextCodec tipe + |> Serialize.finishCustomType - PCaseMatch index -> - Encode.object - [ ( "type", Encode.string "PCaseMatch" ) - , ( "index", Index.zeroBasedEncoder index ) - ] - PCtorArg name index -> - Encode.object - [ ( "type", Encode.string "PCtorArg" ) - , ( "name", Encode.string name ) - , ( "index", Index.zeroBasedEncoder index ) - ] +maybeNameCodec : Codec e MaybeName +maybeNameCodec = + Serialize.customType + (\funcNameEncoder ctorNameEncoder opNameEncoder noNameEncoder value -> + case value of + FuncName name -> + funcNameEncoder name - PListEntry index -> - Encode.object - [ ( "type", Encode.string "PListEntry" ) - , ( "index", Index.zeroBasedEncoder index ) - ] + CtorName name -> + ctorNameEncoder name - PTail -> - Encode.object - [ ( "type", Encode.string "PTail" ) - ] + OpName op -> + opNameEncoder op + NoName -> + noNameEncoder + ) + |> Serialize.variant1 FuncName Serialize.string + |> Serialize.variant1 CtorName Serialize.string + |> Serialize.variant1 OpName Serialize.string + |> Serialize.variant0 NoName + |> Serialize.finishCustomType -pContextDecoder : Decode.Decoder PContext -pContextDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "PTypedArg" -> - Decode.map2 PTypedArg - (Decode.field "name" Decode.string) - (Decode.field "index" Index.zeroBasedDecoder) - "PCaseMatch" -> - Decode.map PCaseMatch (Decode.field "index" Index.zeroBasedDecoder) +pContextCodec : Codec e PContext +pContextCodec = + Serialize.customType + (\pTypedArgEncoder pCaseMatchEncoder pCtorArgEncoder pListEntryEncoder pTailEncoder value -> + case value of + PTypedArg name index -> + pTypedArgEncoder name index - "PCtorArg" -> - Decode.map2 PCtorArg - (Decode.field "name" Decode.string) - (Decode.field "index" Index.zeroBasedDecoder) + PCaseMatch index -> + pCaseMatchEncoder index - "PListEntry" -> - Decode.map PListEntry (Decode.field "index" Index.zeroBasedDecoder) + PCtorArg name index -> + pCtorArgEncoder name index - "PTail" -> - Decode.succeed PTail + PListEntry index -> + pListEntryEncoder index - _ -> - Decode.fail ("Failed to decode PContext's type: " ++ type_) - ) + PTail -> + pTailEncoder + ) + |> Serialize.variant2 PTypedArg Serialize.string Index.zeroBasedCodec + |> Serialize.variant1 PCaseMatch Index.zeroBasedCodec + |> Serialize.variant2 PCtorArg Serialize.string Index.zeroBasedCodec + |> Serialize.variant1 PListEntry Index.zeroBasedCodec + |> Serialize.variant0 PTail + |> Serialize.finishCustomType diff --git a/src/Compiler/Reporting/Render/Type/Localizer.elm b/src/Compiler/Reporting/Render/Type/Localizer.elm index 5aa9aebb1..ec2d33a03 100644 --- a/src/Compiler/Reporting/Render/Type/Localizer.elm +++ b/src/Compiler/Reporting/Render/Type/Localizer.elm @@ -3,8 +3,7 @@ module Compiler.Reporting.Render.Type.Localizer exposing , empty , fromModule , fromNames - , localizerDecoder - , localizerEncoder + , localizerCodec , toChars , toDoc ) @@ -12,14 +11,12 @@ module Compiler.Reporting.Render.Type.Localizer exposing import Compiler.AST.Source as Src import Compiler.Data.Name as Name exposing (Name) import Compiler.Elm.ModuleName as ModuleName -import Compiler.Json.Decode as DecodeX -import Compiler.Json.Encode as EncodeX import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) import Data.Set as EverySet exposing (EverySet) -import Json.Decode as Decode -import Json.Encode as Encode +import Serialize exposing (Codec) import System.TypeCheck.IO as IO @@ -132,59 +129,35 @@ addType exposed types = -- ENCODERS and DECODERS -localizerEncoder : Localizer -> Encode.Value -localizerEncoder (Localizer localizer) = - EncodeX.assocListDict compare Encode.string importEncoder localizer +localizerCodec : Codec e Localizer +localizerCodec = + Serialize.customType + (\localizerCodecEncoder (Localizer localizer) -> + localizerCodecEncoder localizer + ) + |> Serialize.variant1 Localizer (S.assocListDict identity compare Serialize.string importCodec) + |> Serialize.finishCustomType -localizerDecoder : Decode.Decoder Localizer -localizerDecoder = - Decode.map Localizer (DecodeX.assocListDict identity Decode.string importDecoder) +importCodec : Codec e Import +importCodec = + Serialize.record Import + |> Serialize.field .alias (Serialize.maybe Serialize.string) + |> Serialize.field .exposing_ exposingCodec + |> Serialize.finishRecord -importEncoder : Import -> Encode.Value -importEncoder import_ = - Encode.object - [ ( "type", Encode.string "Import" ) - , ( "alias", EncodeX.maybe Encode.string import_.alias ) - , ( "exposing", exposingEncoder import_.exposing_ ) - ] - - -importDecoder : Decode.Decoder Import -importDecoder = - Decode.map2 Import - (Decode.field "alias" (Decode.maybe Decode.string)) - (Decode.field "exposing" exposingDecoder) - +exposingCodec : Codec e Exposing +exposingCodec = + Serialize.customType + (\allEncoder onlyEncoder value -> + case value of + All -> + allEncoder -exposingEncoder : Exposing -> Encode.Value -exposingEncoder exposing_ = - case exposing_ of - All -> - Encode.object - [ ( "type", Encode.string "All" ) - ] - - Only set -> - Encode.object - [ ( "type", Encode.string "Only" ) - , ( "set", EncodeX.everySet compare Encode.string set ) - ] - - -exposingDecoder : Decode.Decoder Exposing -exposingDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "All" -> - Decode.succeed All - - "Only" -> - Decode.map Only (Decode.field "set" (DecodeX.everySet identity Decode.string)) - - _ -> - Decode.fail ("Unknown Exposing's type: " ++ type_) - ) + Only set -> + onlyEncoder set + ) + |> Serialize.variant0 All + |> Serialize.variant1 Only (S.everySet identity compare Serialize.string) + |> Serialize.finishCustomType diff --git a/src/Compiler/Serialize.elm b/src/Compiler/Serialize.elm new file mode 100644 index 000000000..088970289 --- /dev/null +++ b/src/Compiler/Serialize.elm @@ -0,0 +1,56 @@ +module Compiler.Serialize exposing + ( assocListDict + , everySet + , nonempty + , oneOrMore + ) + +import Compiler.Data.NonEmptyList as NE +import Compiler.Data.OneOrMore as OneOrMore exposing (OneOrMore) +import Data.Map as Dict exposing (Dict) +import Data.Set as EverySet exposing (EverySet) +import Serialize as S exposing (Codec) + + +assocListDict : (k -> comparable) -> (k -> k -> Order) -> Codec e k -> Codec e a -> Codec e (Dict comparable k a) +assocListDict toComparable keyComparison keyCodec valueCodec = + S.list (S.tuple keyCodec valueCodec) + |> S.map (Dict.fromList toComparable) (Dict.toList keyComparison) + + +everySet : (a -> comparable) -> (a -> a -> Order) -> Codec e a -> Codec e (EverySet comparable a) +everySet toComparable keyComparison codec = + S.list codec + |> S.map (EverySet.fromList toComparable) (List.reverse << EverySet.toList keyComparison) + + +nonempty : Codec e a -> Codec (S.Error e) (NE.Nonempty a) +nonempty codec = + S.list codec + |> S.mapError S.CustomError + |> S.mapValid + (\values -> + case values of + x :: xs -> + Ok (NE.Nonempty x xs) + + [] -> + Err S.DataCorrupted + ) + (\(NE.Nonempty x xs) -> x :: xs) + + +oneOrMore : Codec e a -> Codec e (OneOrMore a) +oneOrMore codec = + S.customType + (\oneEncoder moreEncoder value -> + case value of + OneOrMore.One x -> + oneEncoder x + + OneOrMore.More a b -> + moreEncoder a b + ) + |> S.variant1 OneOrMore.One codec + |> S.variant2 OneOrMore.More (S.lazy (\() -> oneOrMore codec)) (S.lazy (\() -> oneOrMore codec)) + |> S.finishCustomType diff --git a/src/Compiler/Type/Error.elm b/src/Compiler/Type/Error.elm index 02f2dcf03..2f2bfdf8a 100644 --- a/src/Compiler/Type/Error.elm +++ b/src/Compiler/Type/Error.elm @@ -12,23 +12,20 @@ module Compiler.Type.Error exposing , iteratedDealias , toComparison , toDoc - , typeDecoder - , typeEncoder + , typeCodec ) import Compiler.Data.Bag as Bag import Compiler.Data.Name as Name exposing (Name) import Compiler.Elm.ModuleName as ModuleName -import Compiler.Json.Decode as DecodeX -import Compiler.Json.Encode as EncodeX import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Render.Type.Localizer as L +import Compiler.Serialize as S import Data.Map as Dict exposing (Dict) -import Json.Decode as Decode -import Json.Encode as Encode import Maybe.Extra as Maybe import Prelude +import Serialize exposing (Codec) import System.TypeCheck.IO as IO @@ -834,232 +831,118 @@ extToStatus ext1 ext2 = -- ENCODERS and DECODERS -typeEncoder : Type -> Encode.Value -typeEncoder type_ = - case type_ of - Lambda x y zs -> - Encode.object - [ ( "type", Encode.string "Lambda" ) - , ( "x", typeEncoder x ) - , ( "y", typeEncoder y ) - , ( "zs", Encode.list typeEncoder zs ) - ] - - Infinite -> - Encode.object - [ ( "type", Encode.string "Infinite" ) - ] - - Error -> - Encode.object - [ ( "type", Encode.string "Error" ) - ] - - FlexVar name -> - Encode.object - [ ( "type", Encode.string "FlexVar" ) - , ( "name", Encode.string name ) - ] - - FlexSuper s x -> - Encode.object - [ ( "type", Encode.string "FlexSuper" ) - , ( "s", superEncoder s ) - , ( "x", Encode.string x ) - ] - - RigidVar name -> - Encode.object - [ ( "type", Encode.string "RigidVar" ) - , ( "name", Encode.string name ) - ] - - RigidSuper s x -> - Encode.object - [ ( "type", Encode.string "RigidSuper" ) - , ( "s", superEncoder s ) - , ( "x", Encode.string x ) - ] - - Type home name args -> - Encode.object - [ ( "type", Encode.string "Type" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "args", Encode.list typeEncoder args ) - ] - - Record msgType decoder -> - Encode.object - [ ( "type", Encode.string "Record" ) - , ( "msgType", EncodeX.assocListDict compare Encode.string typeEncoder msgType ) - , ( "decoder", extensionEncoder decoder ) - ] - - Unit -> - Encode.object - [ ( "type", Encode.string "Unit" ) - ] +typeCodec : Codec e Type +typeCodec = + Serialize.customType + (\lambdaEncoder infiniteEncoder errorCodecEncoder flexVarEncoder flexSuperEncoder rigidVarEncoder rigidSuperEncoder typeCodecEncoder recordEncoder unitEncoder tupleEncoder aliasEncoder value -> + case value of + Lambda x y zs -> + lambdaEncoder x y zs + + Infinite -> + infiniteEncoder + + Error -> + errorCodecEncoder + + FlexVar name -> + flexVarEncoder name + + FlexSuper s x -> + flexSuperEncoder s x + + RigidVar name -> + rigidVarEncoder name + + RigidSuper s x -> + rigidSuperEncoder s x + + Type home name args -> + typeCodecEncoder home name args + + Record msgType decoder -> + recordEncoder msgType decoder + + Unit -> + unitEncoder + + Tuple a b maybeC -> + tupleEncoder a b maybeC + + Alias home name args tipe -> + aliasEncoder home name args tipe + ) + |> Serialize.variant3 + Lambda + (Serialize.lazy (\() -> typeCodec)) + (Serialize.lazy (\() -> typeCodec)) + (Serialize.list (Serialize.lazy (\() -> typeCodec))) + |> Serialize.variant0 Infinite + |> Serialize.variant0 Error + |> Serialize.variant1 FlexVar Serialize.string + |> Serialize.variant2 FlexSuper superCodec Serialize.string + |> Serialize.variant1 RigidVar Serialize.string + |> Serialize.variant2 RigidSuper superCodec Serialize.string + |> Serialize.variant3 + Type + ModuleName.canonicalCodec + Serialize.string + (Serialize.list (Serialize.lazy (\() -> typeCodec))) + |> Serialize.variant2 Record (S.assocListDict identity compare Serialize.string (Serialize.lazy (\() -> typeCodec))) extensionCodec + |> Serialize.variant0 Unit + |> Serialize.variant3 + Tuple + (Serialize.lazy (\() -> typeCodec)) + (Serialize.lazy (\() -> typeCodec)) + (Serialize.maybe (Serialize.lazy (\() -> typeCodec))) + |> Serialize.variant4 + Alias + ModuleName.canonicalCodec + Serialize.string + (Serialize.list (Serialize.tuple Serialize.string (Serialize.lazy (\() -> typeCodec)))) + (Serialize.lazy (\() -> typeCodec)) + |> Serialize.finishCustomType + + +superCodec : Codec e Super +superCodec = + Serialize.customType + (\numberEncoder comparableEncoder appendableEncoder compAppendEncoder value -> + case value of + Number -> + numberEncoder - Tuple a b maybeC -> - Encode.object - [ ( "type", Encode.string "Tuple" ) - , ( "a", typeEncoder a ) - , ( "b", typeEncoder b ) - , ( "maybeC", EncodeX.maybe typeEncoder maybeC ) - ] - - Alias home name args tipe -> - Encode.object - [ ( "type", Encode.string "Alias" ) - , ( "home", ModuleName.canonicalEncoder home ) - , ( "name", Encode.string name ) - , ( "args", Encode.list (EncodeX.jsonPair Encode.string typeEncoder) args ) - , ( "tipe", typeEncoder tipe ) - ] - - -typeDecoder : Decode.Decoder Type -typeDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Lambda" -> - Decode.map3 Lambda - (Decode.field "x" typeDecoder) - (Decode.field "y" typeDecoder) - (Decode.field "zs" (Decode.list typeDecoder)) - - "Infinite" -> - Decode.succeed Infinite - - "Error" -> - Decode.succeed Error - - "FlexVar" -> - Decode.map FlexVar (Decode.field "name" Decode.string) - - "FlexSuper" -> - Decode.map2 FlexSuper - (Decode.field "s" superDecoder) - (Decode.field "x" Decode.string) - - "RigidVar" -> - Decode.map RigidVar (Decode.field "name" Decode.string) - - "RigidSuper" -> - Decode.map2 RigidSuper - (Decode.field "s" superDecoder) - (Decode.field "x" Decode.string) - - "Type" -> - Decode.map3 Type - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list typeDecoder)) - - "Record" -> - Decode.map2 Record - (Decode.field "msgType" (DecodeX.assocListDict identity Decode.string typeDecoder)) - (Decode.field "decoder" extensionDecoder) - - "Unit" -> - Decode.succeed Unit - - "Tuple" -> - Decode.map3 Tuple - (Decode.field "a" typeDecoder) - (Decode.field "b" typeDecoder) - (Decode.field "maybeC" (Decode.maybe typeDecoder)) - - "Alias" -> - Decode.map4 Alias - (Decode.field "home" ModuleName.canonicalDecoder) - (Decode.field "name" Decode.string) - (Decode.field "args" (Decode.list (DecodeX.jsonPair Decode.string typeDecoder))) - (Decode.field "tipe" typeDecoder) - - _ -> - Decode.fail ("Unknown Type's type: " ++ type_) - ) - - -superEncoder : Super -> Encode.Value -superEncoder super = - case super of - Number -> - Encode.string "Number" - - Comparable -> - Encode.string "Comparable" - - Appendable -> - Encode.string "Appendable" - - CompAppend -> - Encode.string "CompAppend" - - -superDecoder : Decode.Decoder Super -superDecoder = - Decode.string - |> Decode.andThen - (\str -> - case str of - "Number" -> - Decode.succeed Number - - "Comparable" -> - Decode.succeed Comparable - - "Appendable" -> - Decode.succeed Appendable - - "CompAppend" -> - Decode.succeed CompAppend - - _ -> - Decode.fail ("Unknown Super: " ++ str) - ) - - -extensionEncoder : Extension -> Encode.Value -extensionEncoder extension = - case extension of - Closed -> - Encode.object - [ ( "type", Encode.string "Closed" ) - ] + Comparable -> + comparableEncoder - FlexOpen x -> - Encode.object - [ ( "type", Encode.string "FlexOpen" ) - , ( "x", Encode.string x ) - ] + Appendable -> + appendableEncoder - RigidOpen x -> - Encode.object - [ ( "type", Encode.string "RigidOpen" ) - , ( "x", Encode.string x ) - ] - - -extensionDecoder : Decode.Decoder Extension -extensionDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "Closed" -> - Decode.succeed Closed - - "FlexOpen" -> - Decode.map FlexOpen (Decode.field "x" Decode.string) - - "RigidOpen" -> - Decode.map RigidOpen (Decode.field "x" Decode.string) - - _ -> - Decode.fail ("Unknown Extension's type: " ++ type_) - ) + CompAppend -> + compAppendEncoder + ) + |> Serialize.variant0 Number + |> Serialize.variant0 Comparable + |> Serialize.variant0 Appendable + |> Serialize.variant0 CompAppend + |> Serialize.finishCustomType + + +extensionCodec : Codec e Extension +extensionCodec = + Serialize.customType + (\closedEncoder flexOpenEncoder rigidOpenEncoder value -> + case value of + Closed -> + closedEncoder + + FlexOpen x -> + flexOpenEncoder x + + RigidOpen x -> + rigidOpenEncoder x + ) + |> Serialize.variant0 Closed + |> Serialize.variant1 FlexOpen Serialize.string + |> Serialize.variant1 RigidOpen Serialize.string + |> Serialize.finishCustomType diff --git a/src/Serialize.elm b/src/Serialize.elm new file mode 100644 index 000000000..75f628959 --- /dev/null +++ b/src/Serialize.elm @@ -0,0 +1,1955 @@ +module Serialize exposing + ( encodeToJson, decodeFromJson, encodeToBytes, decodeFromBytes, encodeToString, decodeFromString, getJsonDecoder + , Codec, Error(..) + , string, bool, float, int, unit, bytes, byte + , maybe, list, array, dict, set, tuple, triple, result, enum + , RecordCodec, record, field, finishRecord + , CustomTypeCodec, customType, variant0, variant1, variant2, variant3, variant4, variant5, variant6, variant7, variant8, variant9, finishCustomType, VariantEncoder + , map, mapValid, mapError + , lazy + ) + +{-| Ref.: **Initial implementation from `MartinSStewart/elm-serialize/1.3.1`** + + +# Serialization + +You have three options when encoding data. You can represent the data either as json, bytes, or a string. +Here's some advice when choosing: + + - If performance is important, use `encodeToJson` and `decodeFromJson` + - If space efficiency is important, use `encodeToBytes` and `decodeFromBytes`\* + - `encodeToString` and `decodeFromString` are good for URL safe strings but otherwise one of the other choices is probably better. + +\*`encodeToJson` is more compact when encoding integers with 6 or fewer digits. You may want to try both `encodeToBytes` and `encodeToJson` and see which is better for your use case. + +@docs encodeToJson, decodeFromJson, encodeToBytes, decodeFromBytes, encodeToString, decodeFromString, getJsonDecoder + + +# Definition + +@docs Codec, Error + + +# Primitives + +@docs string, bool, float, int, unit, bytes, byte + + +# Data Structures + +@docs maybe, list, array, dict, set, tuple, triple, result, enum + + +# Records + +@docs RecordCodec, record, field, finishRecord + + +# Custom Types + +@docs CustomTypeCodec, customType, variant0, variant1, variant2, variant3, variant4, variant5, variant6, variant7, variant8, variant9, finishCustomType, VariantEncoder + + +# Mapping + +@docs map, mapValid, mapError + + +# Stack unsafe + +@docs lazy + +-} + +import Array exposing (Array) +import Base64 +import Bytes +import Bytes.Decode as BD +import Bytes.Encode as BE +import Dict exposing (Dict) +import Json.Decode as JD +import Json.Encode as JE +import Regex exposing (Regex) +import Set exposing (Set) +import Toop exposing (T4(..), T5(..), T6(..), T7(..), T8(..), T9(..)) + + + +-- DEFINITION + + +{-| A value that knows how to encode and decode an Elm data structure. +-} +type Codec e a + = Codec + { encoder : a -> BE.Encoder + , decoder : BD.Decoder (Result (Error e) a) + , jsonEncoder : a -> JE.Value + , jsonDecoder : JD.Decoder (Result (Error e) a) + } + + +{-| Possible errors that can occur when decoding. + + - `CustomError` - An error caused by `andThen` returning an Err value. + - `DataCorrupted` - This most likely will occur if you make breaking changes to your codec and try to decode old data\*. Have a look at `How do I change my codecs and still be able to decode old data?` in the readme for how to avoid introducing breaking changes. + - `SerializerOutOfDate` - When encoding, this package will include a version number. This makes it possible for me to make improvements to how data gets encoded without introducing breaking changes to your codecs. This error then, says that you're trying to decode data encoded with a newer version of elm-serialize. + +\*It's possible for corrupted data to still succeed in decoding (but with nonsense Elm values). +This is because internally we're just encoding Elm values and not storing any kind of structural information. +So if you encoded an Int and then a Float, and then tried decoding it as a Float and then an Int, there's no way for the decoder to know it read the data in the wrong order. + +-} +type Error e + = CustomError e + | DataCorrupted + | SerializerOutOfDate + + +version : Int +version = + 1 + + + +-- DECODE + + +endian : Bytes.Endianness +endian = + Bytes.BE + + +{-| Extracts the `Decoder` contained inside the `Codec`. +-} +getBytesDecoderHelper : Codec e a -> BD.Decoder (Result (Error e) a) +getBytesDecoderHelper (Codec m) = + m.decoder + + +{-| Extracts the json `Decoder` contained inside the `Codec`. +-} +getJsonDecoderHelper : Codec e a -> JD.Decoder (Result (Error e) a) +getJsonDecoderHelper (Codec m) = + m.jsonDecoder + + +{-| Run a `Codec` to turn a sequence of bytes into an Elm value. +-} +decodeFromBytes : Codec e a -> Bytes.Bytes -> Result (Error e) a +decodeFromBytes codec bytes_ = + let + decoder : BD.Decoder (Result (Error e) a) + decoder = + BD.unsignedInt8 + |> BD.andThen + (\value -> + if value <= 0 then + Err DataCorrupted |> BD.succeed + + else if value == version then + getBytesDecoderHelper codec + + else + Err SerializerOutOfDate |> BD.succeed + ) + in + case BD.decode decoder bytes_ of + Just value -> + value + + Nothing -> + Err DataCorrupted + + + +--{-| Get the decoder from a `Codec` which you can use inside a elm/bytes decoder. Note that if you do this, you lose any error information that might have been returned. +---} +--getBytesDecoder : Codec e a -> BD.Decoder a +--getBytesDecoder codec = +-- BD.unsignedInt8 +-- |> BD.andThen +-- (\value -> +-- if value <= 0 then +-- BD.fail +-- +-- else if value == version then +-- getBytesDecoderHelper codec +-- |> BD.andThen +-- (\result_ -> +-- case result_ of +-- Ok ok -> +-- BD.succeed ok +-- +-- Err _ -> +-- BD.fail +-- ) +-- +-- else +-- BD.fail +-- ) + + +{-| Run a `Codec` to turn a String encoded with `encodeToString` into an Elm value. +-} +decodeFromString : Codec e a -> String -> Result (Error e) a +decodeFromString codec base64 = + case decode base64 of + Just bytes_ -> + decodeFromBytes codec bytes_ + + Nothing -> + Err DataCorrupted + + +{-| Run a `Codec` to turn a json value encoded with `encodeToJson` into an Elm value. +-} +decodeFromJson : Codec e a -> JE.Value -> Result (Error e) a +decodeFromJson codec json = + let + decoder : JD.Decoder (Result (Error e) a) + decoder = + JD.index 0 JD.int + |> JD.andThen + (\value -> + if value <= 0 then + Err DataCorrupted |> JD.succeed + + else if value == version then + JD.index 1 (getJsonDecoderHelper codec) + + else + Err SerializerOutOfDate |> JD.succeed + ) + in + case JD.decodeValue decoder json of + Ok value -> + value + + Err _ -> + Err DataCorrupted + + +{-| Get the decoder from a `Codec` which you can use inside a elm/json decoder. + + import Json.Decode + import Serialize + + type alias Point = + { x : Float, y : Float } + + pointCodec : Serialize.Codec e Point + pointCodec = + Serialize.record Point + |> Serialize.field .x Serialize.float + |> Serialize.field .y Serialize.float + |> Serialize.finishRecord + + pointDecoder : Json.Decode.Decoder Point + pointDecoder = + -- Since pointCodec doesn't have any custom error values, we can use `never` for our errorToString parameter. + Serialize.getJsonDecoder never pointCodec + +-} +getJsonDecoder : (e -> String) -> Codec e a -> JD.Decoder a +getJsonDecoder errorToString codec = + JD.value + |> JD.andThen + (\value -> + case decodeFromJson codec value of + Ok ok -> + JD.succeed ok + + Err (CustomError error) -> + errorToString error |> JD.fail + + Err DataCorrupted -> + JD.fail "Data corrupted (elm-serialize error)" + + Err SerializerOutOfDate -> + JD.fail "Serializer out of date (elm-serialize error)" + ) + + +decode : String -> Maybe Bytes.Bytes +decode base64text = + let + replaceChar : Regex.Match -> String + replaceChar rematch = + case rematch.match of + "-" -> + "+" + + _ -> + "/" + + strlen : Int + strlen = + String.length base64text + in + if strlen == 0 then + BE.encode (BE.sequence []) |> Just + + else + let + hanging : Int + hanging = + modBy 4 strlen + + ilen : Int + ilen = + if hanging == 0 then + 0 + + else + 4 - hanging + in + Regex.replace replaceFromUrl replaceChar (base64text ++ String.repeat ilen "=") |> Base64.toBytes + + +replaceFromUrl : Regex +replaceFromUrl = + Regex.fromString "[-_]" |> Maybe.withDefault Regex.never + + + +-- ENCODE + + +{-| Extracts the encoding function contained inside the `Codec`. +-} +getBytesEncoderHelper : Codec e a -> a -> BE.Encoder +getBytesEncoderHelper (Codec m) = + m.encoder + + +{-| Extracts the json encoding function contained inside the `Codec`. +-} +getJsonEncoderHelper : Codec e a -> a -> JE.Value +getJsonEncoderHelper (Codec m) = + m.jsonEncoder + + +{-| Convert an Elm value into a sequence of bytes. +-} +encodeToBytes : Codec e a -> a -> Bytes.Bytes +encodeToBytes codec value = + BE.sequence + [ BE.unsignedInt8 version + , value |> getBytesEncoderHelper codec + ] + |> BE.encode + + +{-| Convert an Elm value into a string. This string contains only url safe characters, so you can do the following: + + import Serialize as S + + myUrl = + "www.mywebsite.com/?data=" ++ S.encodeToString S.float 1234 + +and not risk generating an invalid url. + +-} +encodeToString : Codec e a -> a -> String +encodeToString codec = + encodeToBytes codec >> replaceBase64Chars + + +{-| Convert an Elm value into json data. +-} +encodeToJson : Codec e a -> a -> JE.Value +encodeToJson codec value = + JE.list + identity + [ JE.int version + , value |> getJsonEncoderHelper codec + ] + + +replaceBase64Chars : Bytes.Bytes -> String +replaceBase64Chars = + let + replaceChar : Regex.Match -> String + replaceChar rematch = + case rematch.match of + "+" -> + "-" + + "/" -> + "_" + + _ -> + "" + in + Base64.fromBytes >> Maybe.withDefault "" >> Regex.replace replaceForUrl replaceChar + + +replaceForUrl : Regex +replaceForUrl = + Regex.fromString "[\\+/=]" |> Maybe.withDefault Regex.never + + + +-- BASE + + +build : + (a -> BE.Encoder) + -> BD.Decoder (Result (Error e) a) + -> (a -> JE.Value) + -> JD.Decoder (Result (Error e) a) + -> Codec e a +build encoder_ decoder_ jsonEncoder jsonDecoder = + Codec + { encoder = encoder_ + , decoder = decoder_ + , jsonEncoder = jsonEncoder + , jsonDecoder = jsonDecoder + } + + +{-| Codec for serializing a `String` +-} +string : Codec e String +string = + build + (\text -> + BE.sequence + [ BE.unsignedInt32 endian (BE.getStringWidth text) + , BE.string text + ] + ) + (BD.unsignedInt32 endian + |> BD.andThen + (\charCount -> BD.string charCount |> BD.map Ok) + ) + JE.string + (JD.string |> JD.map Ok) + + +{-| Codec for serializing a `Bool` +-} +bool : Codec e Bool +bool = + build + (\value -> + if value then + BE.unsignedInt8 1 + + else + BE.unsignedInt8 0 + ) + (BD.unsignedInt8 + |> BD.map + (\value -> + case value of + 0 -> + Ok False + + 1 -> + Ok True + + _ -> + Err DataCorrupted + ) + ) + JE.bool + (JD.bool |> JD.map Ok) + + +{-| Codec for serializing an `Int` +-} +int : Codec e Int +int = + build + (toFloat >> BE.float64 endian) + (BD.float64 endian |> BD.map (round >> Ok)) + JE.int + (JD.int |> JD.map Ok) + + +{-| Codec for serializing a `Float` +-} +float : Codec e Float +float = + build + (BE.float64 endian) + (BD.float64 endian |> BD.map Ok) + JE.float + (JD.float |> JD.map Ok) + + + +-- DATA STRUCTURES + + +{-| Codec for serializing a `Maybe` + + import Serialize as S + + maybeIntCodec : S.Codec e (Maybe Int) + maybeIntCodec = + S.maybe S.int + +-} +maybe : Codec e a -> Codec e (Maybe a) +maybe justCodec = + customType + (\nothingEncoder justEncoder value -> + case value of + Nothing -> + nothingEncoder + + Just value_ -> + justEncoder value_ + ) + |> variant0 Nothing + |> variant1 Just justCodec + |> finishCustomType + + +{-| Codec for serializing a `List` + + import Serialize as S + + listOfStringsCodec : S.Codec e (List String) + listOfStringsCodec = + S.list S.string + +-} +list : Codec e a -> Codec e (List a) +list codec = + build + (listEncode (getBytesEncoderHelper codec)) + (BD.unsignedInt32 endian + |> BD.andThen + (\length -> BD.loop ( length, [] ) (listStep (getBytesDecoderHelper codec))) + ) + (JE.list (getJsonEncoderHelper codec)) + (JD.list (getJsonDecoderHelper codec) + |> JD.map + (List.foldr + (\value state -> + case ( value, state ) of + ( Ok ok, Ok okState ) -> + ok :: okState |> Ok + + ( _, Err _ ) -> + state + + ( Err error, Ok _ ) -> + Err error + ) + (Ok []) + ) + ) + + +listEncode : (a -> BE.Encoder) -> List a -> BE.Encoder +listEncode encoder_ list_ = + list_ + |> List.map encoder_ + |> (::) (BE.unsignedInt32 endian (List.length list_)) + |> BE.sequence + + +listStep : BD.Decoder (Result (Error e) a) -> ( Int, List a ) -> BD.Decoder (BD.Step ( Int, List a ) (Result (Error e) (List a))) +listStep decoder_ ( n, xs ) = + if n <= 0 then + BD.succeed (BD.Done (xs |> List.reverse |> Ok)) + + else + BD.map + (\x -> + case x of + Ok ok -> + BD.Loop ( n - 1, ok :: xs ) + + Err err -> + BD.Done (Err err) + ) + decoder_ + + +{-| Codec for serializing an `Array` +-} +array : Codec e a -> Codec e (Array a) +array codec = + list codec |> mapHelper (Result.map Array.fromList) Array.toList + + +{-| Codec for serializing a `Dict` + + import Serialize as S + + type alias Name = + String + + peoplesAgeCodec : S.Codec e (Dict Name Int) + peoplesAgeCodec = + S.dict S.string S.int + +-} +dict : Codec e comparable -> Codec e a -> Codec e (Dict comparable a) +dict keyCodec valueCodec = + list (tuple keyCodec valueCodec) + |> mapHelper (Result.map Dict.fromList) Dict.toList + + +{-| Codec for serializing a `Set` +-} +set : Codec e comparable -> Codec e (Set comparable) +set codec = + list codec |> mapHelper (Result.map Set.fromList) Set.toList + + +{-| Codec for serializing `()` (aka `Unit`). +-} +unit : Codec e () +unit = + build + (always (BE.sequence [])) + (BD.succeed (Ok ())) + (\_ -> JE.int 0) + (JD.succeed (Ok ())) + + +{-| Codec for serializing a tuple with 2 elements + + import Serialize as S + + pointCodec : S.Codec e ( Float, Float ) + pointCodec = + S.tuple S.float S.float + +-} +tuple : Codec e a -> Codec e b -> Codec e ( a, b ) +tuple codecFirst codecSecond = + record Tuple.pair + |> field Tuple.first codecFirst + |> field Tuple.second codecSecond + |> finishRecord + + +{-| Codec for serializing a tuple with 3 elements + + import Serialize as S + + pointCodec : S.Codec e ( Float, Float, Float ) + pointCodec = + S.tuple S.float S.float S.float + +-} +triple : Codec e a -> Codec e b -> Codec e c -> Codec e ( a, b, c ) +triple codecFirst codecSecond codecThird = + record (\a b c -> ( a, b, c )) + |> field (\( a, _, _ ) -> a) codecFirst + |> field (\( _, b, _ ) -> b) codecSecond + |> field (\( _, _, c ) -> c) codecThird + |> finishRecord + + +{-| Codec for serializing a `Result` +-} +result : Codec e error -> Codec e value -> Codec e (Result error value) +result errorCodec valueCodec = + customType + (\errEncoder okEncoder value -> + case value of + Err err -> + errEncoder err + + Ok ok -> + okEncoder ok + ) + |> variant1 Err errorCodec + |> variant1 Ok valueCodec + |> finishCustomType + + +{-| Codec for serializing [`Bytes`](https://package.elm-lang.org/packages/elm/bytes/latest/). +This is useful in combination with `mapValid` for encoding and decoding data using some specialized format. + + import Image exposing (Image) + import Serialize as S + + imageCodec : S.Codec String Image + imageCodec = + S.bytes + |> S.mapValid + (Image.decode >> Result.fromMaybe "Failed to decode PNG image.") + Image.toPng + +-} +bytes : Codec e Bytes.Bytes +bytes = + build + (\bytes_ -> + BE.sequence + [ BE.unsignedInt32 endian (Bytes.width bytes_) + , BE.bytes bytes_ + ] + ) + (BD.unsignedInt32 endian |> BD.andThen (\length -> BD.bytes length |> BD.map Ok)) + (replaceBase64Chars >> JE.string) + (JD.string + |> JD.map + (\text -> + case decode text of + Just bytes_ -> + Ok bytes_ + + Nothing -> + Err DataCorrupted + ) + ) + + +{-| Codec for serializing an integer ranging from 0 to 255. +This is useful if you have a small integer you want to serialize and not use up a lot of space. + + import Serialize as S + + type alias Color = + { red : Int + , green : Int + , blue : Int + } + + color : S.Codec e Color + color = + Color.record Color + |> S.field .red byte + |> S.field .green byte + |> S.field .blue byte + |> S.finishRecord + +**Warning:** values greater than 255 or less than 0 will wrap around. +So if you encode -1 you'll get back 255 and if you encode 257 you'll get back 1. + +-} +byte : Codec e Int +byte = + build + BE.unsignedInt8 + (BD.unsignedInt8 |> BD.map Ok) + (modBy 256 >> JE.int) + (JD.int |> JD.map Ok) + + +{-| A codec for serializing an item from a list of possible items. +If you try to encode an item that isn't in the list then the first item is defaulted to. + + import Serialize as S + + type DaysOfWeek + = Monday + | Tuesday + | Wednesday + | Thursday + | Friday + | Saturday + | Sunday + + daysOfWeekCodec : S.Codec e DaysOfWeek + daysOfWeekCodec = + S.enum Monday [ Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday ] + +Note that inserting new items in the middle of the list or removing items is a breaking change. +It's safe to add items to the end of the list though. + +-} +enum : a -> List a -> Codec e a +enum defaultItem items = + let + getIndex : a -> Int + getIndex value = + items + |> findIndex ((==) value) + |> Maybe.withDefault -1 + |> (+) 1 + + getItem : Int -> Result (Error e) a + getItem index = + if index < 0 then + Err DataCorrupted + + else if index > List.length items then + Err DataCorrupted + + else + getAt (index - 1) items |> Maybe.withDefault defaultItem |> Ok + in + build + (getIndex >> BE.unsignedInt32 endian) + (BD.unsignedInt32 endian |> BD.map getItem) + (getIndex >> JE.int) + (JD.int |> JD.map getItem) + + +getAt : Int -> List a -> Maybe a +getAt idx xs = + if idx < 0 then + Nothing + + else + List.head <| List.drop idx xs + + +{-| +-} +findIndex : (a -> Bool) -> List a -> Maybe Int +findIndex = + findIndexHelp 0 + + +{-| +-} +findIndexHelp : Int -> (a -> Bool) -> List a -> Maybe Int +findIndexHelp index predicate list_ = + case list_ of + [] -> + Nothing + + x :: xs -> + if predicate x then + Just index + + else + findIndexHelp (index + 1) predicate xs + + + +-- OBJECTS + + +{-| A partially built Codec for a record. +-} +type RecordCodec e a b + = RecordCodec + { encoder : a -> List BE.Encoder + , decoder : BD.Decoder (Result (Error e) b) + , jsonEncoder : a -> List JE.Value + , jsonDecoder : JD.Decoder (Result (Error e) b) + , fieldIndex : Int + } + + +{-| Start creating a codec for a record. + + import Serialize as S + + type alias Point = + { x : Int + , y : Int + } + + pointCodec : S.Codec e Point + pointCodec = + S.record Point + -- Note that adding, removing, or reordering fields will prevent you from decoding any data you've previously encoded. + |> S.field .x S.int + |> S.field .y S.int + |> S.finishRecord + +-} +record : b -> RecordCodec e a b +record ctor = + RecordCodec + { encoder = \_ -> [] + , decoder = BD.succeed (Ok ctor) + , jsonEncoder = \_ -> [] + , jsonDecoder = JD.succeed (Ok ctor) + , fieldIndex = 0 + } + + +{-| Add a field to the record we are creating a codec for. +-} +field : (a -> f) -> Codec e f -> RecordCodec e a (f -> b) -> RecordCodec e a b +field getter codec (RecordCodec recordCodec) = + RecordCodec + { encoder = \v -> (getBytesEncoderHelper codec <| getter v) :: recordCodec.encoder v + , decoder = + BD.map2 + (\f x -> + case ( f, x ) of + ( Ok fOk, Ok xOk ) -> + fOk xOk |> Ok + + ( Err err, _ ) -> + Err err + + ( _, Err err ) -> + Err err + ) + recordCodec.decoder + (getBytesDecoderHelper codec) + , jsonEncoder = \v -> (getJsonEncoderHelper codec <| getter v) :: recordCodec.jsonEncoder v + , jsonDecoder = + JD.map2 + (\f x -> + case ( f, x ) of + ( Ok fOk, Ok xOk ) -> + fOk xOk |> Ok + + ( Err err, _ ) -> + Err err + + ( _, Err err ) -> + Err err + ) + recordCodec.jsonDecoder + (JD.index recordCodec.fieldIndex (getJsonDecoderHelper codec)) + , fieldIndex = recordCodec.fieldIndex + 1 + } + + +{-| Finish creating a codec for a record. +-} +finishRecord : RecordCodec e a a -> Codec e a +finishRecord (RecordCodec codec) = + Codec + { encoder = codec.encoder >> List.reverse >> BE.sequence + , decoder = codec.decoder + , jsonEncoder = codec.jsonEncoder >> List.reverse >> JE.list identity + , jsonDecoder = codec.jsonDecoder + } + + + +-- CUSTOM + + +{-| A partially built codec for a custom type. +-} +type CustomTypeCodec a e match v + = CustomTypeCodec + { match : match + , jsonMatch : match + , decoder : Int -> BD.Decoder (Result (Error e) v) -> BD.Decoder (Result (Error e) v) + , jsonDecoder : Int -> JD.Decoder (Result (Error e) v) -> JD.Decoder (Result (Error e) v) + , idCounter : Int + } + + +{-| Starts building a `Codec` for a custom type. +You need to pass a pattern matching function, see the FAQ for details. + + import Serialize as S + + type Semaphore + = Red Int String Bool + | Yellow Float + | Green + + semaphoreCodec : S.Codec e Semaphore + semaphoreCodec = + S.customType + (\redEncoder yellowEncoder greenEncoder value -> + case value of + Red i s b -> + redEncoder i s b + + Yellow f -> + yellowEncoder f + + Green -> + greenEncoder + ) + -- Note that removing a variant, inserting a variant before an existing one, or swapping two variants will prevent you from decoding any data you've previously encoded. + |> S.variant3 Red S.int S.string S.bool + |> S.variant1 Yellow S.float + |> S.variant0 Green + -- It's safe to add new variants here later though + |> S.finishCustomType + +-} +customType : match -> CustomTypeCodec { youNeedAtLeastOneVariant : () } e match value +customType match = + CustomTypeCodec + { match = match + , jsonMatch = match + , decoder = \_ -> identity + , jsonDecoder = \_ -> identity + , idCounter = 0 + } + + +{-| -} +type VariantEncoder + = VariantEncoder ( BE.Encoder, JE.Value ) + + +variant : + ((List BE.Encoder -> VariantEncoder) -> a) + -> ((List JE.Value -> VariantEncoder) -> a) + -> BD.Decoder (Result (Error error) v) + -> JD.Decoder (Result (Error error) v) + -> CustomTypeCodec z error (a -> b) v + -> CustomTypeCodec () error b v +variant matchPiece matchJsonPiece decoderPiece jsonDecoderPiece (CustomTypeCodec am) = + let + enc : List BE.Encoder -> VariantEncoder + enc v = + ( BE.unsignedInt16 endian am.idCounter :: v |> BE.sequence + , JE.null + ) + |> VariantEncoder + + jsonEnc : List JE.Value -> VariantEncoder + jsonEnc v = + ( BE.sequence [] + , JE.int am.idCounter :: v |> JE.list identity + ) + |> VariantEncoder + + decoder_ : Int -> BD.Decoder (Result (Error error) v) -> BD.Decoder (Result (Error error) v) + decoder_ tag orElse = + if tag == am.idCounter then + decoderPiece + + else + am.decoder tag orElse + + jsonDecoder_ : Int -> JD.Decoder (Result (Error error) v) -> JD.Decoder (Result (Error error) v) + jsonDecoder_ tag orElse = + if tag == am.idCounter then + jsonDecoderPiece + + else + am.jsonDecoder tag orElse + in + CustomTypeCodec + { match = am.match <| matchPiece enc + , jsonMatch = am.jsonMatch <| matchJsonPiece jsonEnc + , decoder = decoder_ + , jsonDecoder = jsonDecoder_ + , idCounter = am.idCounter + 1 + } + + +{-| Define a variant with 0 parameters for a custom type. +-} +variant0 : v -> CustomTypeCodec z e (VariantEncoder -> a) v -> CustomTypeCodec () e a v +variant0 ctor = + variant + (\c -> c []) + (\c -> c []) + (BD.succeed (Ok ctor)) + (JD.succeed (Ok ctor)) + + +{-| Define a variant with 1 parameters for a custom type. +-} +variant1 : + (a -> v) + -> Codec error a + -> CustomTypeCodec z error ((a -> VariantEncoder) -> b) v + -> CustomTypeCodec () error b v +variant1 ctor m1 = + variant + (\c v -> + c + [ getBytesEncoderHelper m1 v + ] + ) + (\c v -> + c + [ getJsonEncoderHelper m1 v + ] + ) + (BD.map (result1 ctor) (getBytesDecoderHelper m1)) + (JD.map (result1 ctor) (JD.index 1 (getJsonDecoderHelper m1))) + + +result1 : + (value -> a) + -> Result error value + -> Result error a +result1 ctor value = + case value of + Ok ok -> + ctor ok |> Ok + + Err err -> + Err err + + +{-| Define a variant with 2 parameters for a custom type. +-} +variant2 : + (a -> b -> v) + -> Codec error a + -> Codec error b + -> CustomTypeCodec z error ((a -> b -> VariantEncoder) -> c) v + -> CustomTypeCodec () error c v +variant2 ctor m1 m2 = + variant + (\c v1 v2 -> + [ getBytesEncoderHelper m1 v1 + , getBytesEncoderHelper m2 v2 + ] + |> c + ) + (\c v1 v2 -> + [ getJsonEncoderHelper m1 v1 + , getJsonEncoderHelper m2 v2 + ] + |> c + ) + (BD.map2 + (result2 ctor) + (getBytesDecoderHelper m1) + (getBytesDecoderHelper m2) + ) + (JD.map2 + (result2 ctor) + (JD.index 1 (getJsonDecoderHelper m1)) + (JD.index 2 (getJsonDecoderHelper m2)) + ) + + +result2 : + (value -> a -> b) + -> Result error value + -> Result error a + -> Result error b +result2 ctor v1 v2 = + case ( v1, v2 ) of + ( Ok ok1, Ok ok2 ) -> + ctor ok1 ok2 |> Ok + + ( Err err, _ ) -> + Err err + + ( _, Err err ) -> + Err err + + +{-| Define a variant with 3 parameters for a custom type. +-} +variant3 : + (a -> b -> c -> v) + -> Codec error a + -> Codec error b + -> Codec error c + -> CustomTypeCodec z error ((a -> b -> c -> VariantEncoder) -> partial) v + -> CustomTypeCodec () error partial v +variant3 ctor m1 m2 m3 = + variant + (\c v1 v2 v3 -> + [ getBytesEncoderHelper m1 v1 + , getBytesEncoderHelper m2 v2 + , getBytesEncoderHelper m3 v3 + ] + |> c + ) + (\c v1 v2 v3 -> + [ getJsonEncoderHelper m1 v1 + , getJsonEncoderHelper m2 v2 + , getJsonEncoderHelper m3 v3 + ] + |> c + ) + (BD.map3 + (result3 ctor) + (getBytesDecoderHelper m1) + (getBytesDecoderHelper m2) + (getBytesDecoderHelper m3) + ) + (JD.map3 + (result3 ctor) + (JD.index 1 (getJsonDecoderHelper m1)) + (JD.index 2 (getJsonDecoderHelper m2)) + (JD.index 3 (getJsonDecoderHelper m3)) + ) + + +result3 : + (value -> a -> b -> c) + -> Result error value + -> Result error a + -> Result error b + -> Result error c +result3 ctor v1 v2 v3 = + case ( v1, v2, v3 ) of + ( Ok ok1, Ok ok2, Ok ok3 ) -> + ctor ok1 ok2 ok3 |> Ok + + ( Err err, _, _ ) -> + Err err + + ( _, Err err, _ ) -> + Err err + + ( _, _, Err err ) -> + Err err + + +{-| Define a variant with 4 parameters for a custom type. +-} +variant4 : + (a -> b -> c -> d -> v) + -> Codec error a + -> Codec error b + -> Codec error c + -> Codec error d + -> CustomTypeCodec z error ((a -> b -> c -> d -> VariantEncoder) -> partial) v + -> CustomTypeCodec () error partial v +variant4 ctor m1 m2 m3 m4 = + variant + (\c v1 v2 v3 v4 -> + [ getBytesEncoderHelper m1 v1 + , getBytesEncoderHelper m2 v2 + , getBytesEncoderHelper m3 v3 + , getBytesEncoderHelper m4 v4 + ] + |> c + ) + (\c v1 v2 v3 v4 -> + [ getJsonEncoderHelper m1 v1 + , getJsonEncoderHelper m2 v2 + , getJsonEncoderHelper m3 v3 + , getJsonEncoderHelper m4 v4 + ] + |> c + ) + (BD.map4 + (result4 ctor) + (getBytesDecoderHelper m1) + (getBytesDecoderHelper m2) + (getBytesDecoderHelper m3) + (getBytesDecoderHelper m4) + ) + (JD.map4 + (result4 ctor) + (JD.index 1 (getJsonDecoderHelper m1)) + (JD.index 2 (getJsonDecoderHelper m2)) + (JD.index 3 (getJsonDecoderHelper m3)) + (JD.index 4 (getJsonDecoderHelper m4)) + ) + + +result4 : + (value -> a -> b -> c -> d) + -> Result error value + -> Result error a + -> Result error b + -> Result error c + -> Result error d +result4 ctor v1 v2 v3 v4 = + case T4 v1 v2 v3 v4 of + T4 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) -> + ctor ok1 ok2 ok3 ok4 |> Ok + + T4 (Err err) _ _ _ -> + Err err + + T4 _ (Err err) _ _ -> + Err err + + T4 _ _ (Err err) _ -> + Err err + + T4 _ _ _ (Err err) -> + Err err + + +{-| Define a variant with 5 parameters for a custom type. +-} +variant5 : + (a -> b -> c -> d -> e -> v) + -> Codec error a + -> Codec error b + -> Codec error c + -> Codec error d + -> Codec error e + -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> VariantEncoder) -> partial) v + -> CustomTypeCodec () error partial v +variant5 ctor m1 m2 m3 m4 m5 = + variant + (\c v1 v2 v3 v4 v5 -> + [ getBytesEncoderHelper m1 v1 + , getBytesEncoderHelper m2 v2 + , getBytesEncoderHelper m3 v3 + , getBytesEncoderHelper m4 v4 + , getBytesEncoderHelper m5 v5 + ] + |> c + ) + (\c v1 v2 v3 v4 v5 -> + [ getJsonEncoderHelper m1 v1 + , getJsonEncoderHelper m2 v2 + , getJsonEncoderHelper m3 v3 + , getJsonEncoderHelper m4 v4 + , getJsonEncoderHelper m5 v5 + ] + |> c + ) + (BD.map5 + (result5 ctor) + (getBytesDecoderHelper m1) + (getBytesDecoderHelper m2) + (getBytesDecoderHelper m3) + (getBytesDecoderHelper m4) + (getBytesDecoderHelper m5) + ) + (JD.map5 + (result5 ctor) + (JD.index 1 (getJsonDecoderHelper m1)) + (JD.index 2 (getJsonDecoderHelper m2)) + (JD.index 3 (getJsonDecoderHelper m3)) + (JD.index 4 (getJsonDecoderHelper m4)) + (JD.index 5 (getJsonDecoderHelper m5)) + ) + + +result5 : + (value -> a -> b -> c -> d -> e) + -> Result error value + -> Result error a + -> Result error b + -> Result error c + -> Result error d + -> Result error e +result5 ctor v1 v2 v3 v4 v5 = + case T5 v1 v2 v3 v4 v5 of + T5 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) -> + ctor ok1 ok2 ok3 ok4 ok5 |> Ok + + T5 (Err err) _ _ _ _ -> + Err err + + T5 _ (Err err) _ _ _ -> + Err err + + T5 _ _ (Err err) _ _ -> + Err err + + T5 _ _ _ (Err err) _ -> + Err err + + T5 _ _ _ _ (Err err) -> + Err err + + +{-| Define a variant with 6 parameters for a custom type. +-} +variant6 : + (a -> b -> c -> d -> e -> f -> v) + -> Codec error a + -> Codec error b + -> Codec error c + -> Codec error d + -> Codec error e + -> Codec error f + -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> VariantEncoder) -> partial) v + -> CustomTypeCodec () error partial v +variant6 ctor m1 m2 m3 m4 m5 m6 = + variant + (\c v1 v2 v3 v4 v5 v6 -> + [ getBytesEncoderHelper m1 v1 + , getBytesEncoderHelper m2 v2 + , getBytesEncoderHelper m3 v3 + , getBytesEncoderHelper m4 v4 + , getBytesEncoderHelper m5 v5 + , getBytesEncoderHelper m6 v6 + ] + |> c + ) + (\c v1 v2 v3 v4 v5 v6 -> + [ getJsonEncoderHelper m1 v1 + , getJsonEncoderHelper m2 v2 + , getJsonEncoderHelper m3 v3 + , getJsonEncoderHelper m4 v4 + , getJsonEncoderHelper m5 v5 + , getJsonEncoderHelper m6 v6 + ] + |> c + ) + (BD.map5 + (result6 ctor) + (getBytesDecoderHelper m1) + (getBytesDecoderHelper m2) + (getBytesDecoderHelper m3) + (getBytesDecoderHelper m4) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m5) + (getBytesDecoderHelper m6) + ) + ) + (JD.map5 + (result6 ctor) + (JD.index 1 (getJsonDecoderHelper m1)) + (JD.index 2 (getJsonDecoderHelper m2)) + (JD.index 3 (getJsonDecoderHelper m3)) + (JD.index 4 (getJsonDecoderHelper m4)) + (JD.map2 Tuple.pair + (JD.index 5 (getJsonDecoderHelper m5)) + (JD.index 6 (getJsonDecoderHelper m6)) + ) + ) + + +result6 : + (value -> a -> b -> c -> d -> e -> f) + -> Result error value + -> Result error a + -> Result error b + -> Result error c + -> ( Result error d, Result error e ) + -> Result error f +result6 ctor v1 v2 v3 v4 ( v5, v6 ) = + case T6 v1 v2 v3 v4 v5 v6 of + T6 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) -> + ctor ok1 ok2 ok3 ok4 ok5 ok6 |> Ok + + T6 (Err err) _ _ _ _ _ -> + Err err + + T6 _ (Err err) _ _ _ _ -> + Err err + + T6 _ _ (Err err) _ _ _ -> + Err err + + T6 _ _ _ (Err err) _ _ -> + Err err + + T6 _ _ _ _ (Err err) _ -> + Err err + + T6 _ _ _ _ _ (Err err) -> + Err err + + +{-| Define a variant with 7 parameters for a custom type. +-} +variant7 : + (a -> b -> c -> d -> e -> f -> g -> v) + -> Codec error a + -> Codec error b + -> Codec error c + -> Codec error d + -> Codec error e + -> Codec error f + -> Codec error g + -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> g -> VariantEncoder) -> partial) v + -> CustomTypeCodec () error partial v +variant7 ctor m1 m2 m3 m4 m5 m6 m7 = + variant + (\c v1 v2 v3 v4 v5 v6 v7 -> + [ getBytesEncoderHelper m1 v1 + , getBytesEncoderHelper m2 v2 + , getBytesEncoderHelper m3 v3 + , getBytesEncoderHelper m4 v4 + , getBytesEncoderHelper m5 v5 + , getBytesEncoderHelper m6 v6 + , getBytesEncoderHelper m7 v7 + ] + |> c + ) + (\c v1 v2 v3 v4 v5 v6 v7 -> + [ getJsonEncoderHelper m1 v1 + , getJsonEncoderHelper m2 v2 + , getJsonEncoderHelper m3 v3 + , getJsonEncoderHelper m4 v4 + , getJsonEncoderHelper m5 v5 + , getJsonEncoderHelper m6 v6 + , getJsonEncoderHelper m7 v7 + ] + |> c + ) + (BD.map5 + (result7 ctor) + (getBytesDecoderHelper m1) + (getBytesDecoderHelper m2) + (getBytesDecoderHelper m3) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m4) + (getBytesDecoderHelper m5) + ) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m6) + (getBytesDecoderHelper m7) + ) + ) + (JD.map5 + (result7 ctor) + (JD.index 1 (getJsonDecoderHelper m1)) + (JD.index 2 (getJsonDecoderHelper m2)) + (JD.index 3 (getJsonDecoderHelper m3)) + (JD.map2 Tuple.pair + (JD.index 4 (getJsonDecoderHelper m4)) + (JD.index 5 (getJsonDecoderHelper m5)) + ) + (JD.map2 Tuple.pair + (JD.index 6 (getJsonDecoderHelper m6)) + (JD.index 7 (getJsonDecoderHelper m7)) + ) + ) + + +result7 : + (value -> a -> b -> c -> d -> e -> f -> g) + -> Result error value + -> Result error a + -> Result error b + -> ( Result error c, Result error d ) + -> ( Result error e, Result error f ) + -> Result error g +result7 ctor v1 v2 v3 ( v4, v5 ) ( v6, v7 ) = + case T7 v1 v2 v3 v4 v5 v6 v7 of + T7 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) (Ok ok7) -> + ctor ok1 ok2 ok3 ok4 ok5 ok6 ok7 |> Ok + + T7 (Err err) _ _ _ _ _ _ -> + Err err + + T7 _ (Err err) _ _ _ _ _ -> + Err err + + T7 _ _ (Err err) _ _ _ _ -> + Err err + + T7 _ _ _ (Err err) _ _ _ -> + Err err + + T7 _ _ _ _ (Err err) _ _ -> + Err err + + T7 _ _ _ _ _ (Err err) _ -> + Err err + + T7 _ _ _ _ _ _ (Err err) -> + Err err + + +{-| Define a variant with 8 parameters for a custom type. +-} +variant8 : + (a -> b -> c -> d -> e -> f -> g -> h -> v) + -> Codec error a + -> Codec error b + -> Codec error c + -> Codec error d + -> Codec error e + -> Codec error f + -> Codec error g + -> Codec error h + -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> g -> h -> VariantEncoder) -> partial) v + -> CustomTypeCodec () error partial v +variant8 ctor m1 m2 m3 m4 m5 m6 m7 m8 = + variant + (\c v1 v2 v3 v4 v5 v6 v7 v8 -> + [ getBytesEncoderHelper m1 v1 + , getBytesEncoderHelper m2 v2 + , getBytesEncoderHelper m3 v3 + , getBytesEncoderHelper m4 v4 + , getBytesEncoderHelper m5 v5 + , getBytesEncoderHelper m6 v6 + , getBytesEncoderHelper m7 v7 + , getBytesEncoderHelper m8 v8 + ] + |> c + ) + (\c v1 v2 v3 v4 v5 v6 v7 v8 -> + [ getJsonEncoderHelper m1 v1 + , getJsonEncoderHelper m2 v2 + , getJsonEncoderHelper m3 v3 + , getJsonEncoderHelper m4 v4 + , getJsonEncoderHelper m5 v5 + , getJsonEncoderHelper m6 v6 + , getJsonEncoderHelper m7 v7 + , getJsonEncoderHelper m8 v8 + ] + |> c + ) + (BD.map5 + (result8 ctor) + (getBytesDecoderHelper m1) + (getBytesDecoderHelper m2) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m3) + (getBytesDecoderHelper m4) + ) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m5) + (getBytesDecoderHelper m6) + ) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m7) + (getBytesDecoderHelper m8) + ) + ) + (JD.map5 + (result8 ctor) + (JD.index 1 (getJsonDecoderHelper m1)) + (JD.index 2 (getJsonDecoderHelper m2)) + (JD.map2 Tuple.pair + (JD.index 3 (getJsonDecoderHelper m3)) + (JD.index 4 (getJsonDecoderHelper m4)) + ) + (JD.map2 Tuple.pair + (JD.index 5 (getJsonDecoderHelper m5)) + (JD.index 6 (getJsonDecoderHelper m6)) + ) + (JD.map2 Tuple.pair + (JD.index 7 (getJsonDecoderHelper m7)) + (JD.index 8 (getJsonDecoderHelper m8)) + ) + ) + + +result8 : + (value -> a -> b -> c -> d -> e -> f -> g -> h) + -> Result error value + -> Result error a + -> ( Result error b, Result error c ) + -> ( Result error d, Result error e ) + -> ( Result error f, Result error g ) + -> Result error h +result8 ctor v1 v2 ( v3, v4 ) ( v5, v6 ) ( v7, v8 ) = + case T8 v1 v2 v3 v4 v5 v6 v7 v8 of + T8 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) (Ok ok7) (Ok ok8) -> + ctor ok1 ok2 ok3 ok4 ok5 ok6 ok7 ok8 |> Ok + + T8 (Err err) _ _ _ _ _ _ _ -> + Err err + + T8 _ (Err err) _ _ _ _ _ _ -> + Err err + + T8 _ _ (Err err) _ _ _ _ _ -> + Err err + + T8 _ _ _ (Err err) _ _ _ _ -> + Err err + + T8 _ _ _ _ (Err err) _ _ _ -> + Err err + + T8 _ _ _ _ _ (Err err) _ _ -> + Err err + + T8 _ _ _ _ _ _ (Err err) _ -> + Err err + + T8 _ _ _ _ _ _ _ (Err err) -> + Err err + + +{-| Define a variant with 9 parameters for a custom type. +-} +variant9 : + (a -> b -> c -> d -> e -> f -> g -> h -> i -> v) + -> Codec error a + -> Codec error b + -> Codec error c + -> Codec error d + -> Codec error e + -> Codec error f + -> Codec error g + -> Codec error h + -> Codec error i + -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> g -> h -> i -> VariantEncoder) -> partial) v + -> CustomTypeCodec () error partial v +variant9 ctor m1 m2 m3 m4 m5 m6 m7 m8 m9 = + variant + (\c v1 v2 v3 v4 v5 v6 v7 v8 v9 -> + [ getBytesEncoderHelper m1 v1 + , getBytesEncoderHelper m2 v2 + , getBytesEncoderHelper m3 v3 + , getBytesEncoderHelper m4 v4 + , getBytesEncoderHelper m5 v5 + , getBytesEncoderHelper m6 v6 + , getBytesEncoderHelper m7 v7 + , getBytesEncoderHelper m8 v8 + , getBytesEncoderHelper m9 v9 + ] + |> c + ) + (\c v1 v2 v3 v4 v5 v6 v7 v8 v9 -> + [ getJsonEncoderHelper m1 v1 + , getJsonEncoderHelper m2 v2 + , getJsonEncoderHelper m3 v3 + , getJsonEncoderHelper m4 v4 + , getJsonEncoderHelper m5 v5 + , getJsonEncoderHelper m6 v6 + , getJsonEncoderHelper m7 v7 + , getJsonEncoderHelper m8 v8 + , getJsonEncoderHelper m9 v9 + ] + |> c + ) + (BD.map5 + (result9 ctor) + (getBytesDecoderHelper m1) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m2) + (getBytesDecoderHelper m3) + ) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m4) + (getBytesDecoderHelper m5) + ) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m6) + (getBytesDecoderHelper m7) + ) + (BD.map2 Tuple.pair + (getBytesDecoderHelper m8) + (getBytesDecoderHelper m9) + ) + ) + (JD.map5 + (result9 ctor) + (JD.index 1 (getJsonDecoderHelper m1)) + (JD.map2 Tuple.pair + (JD.index 2 (getJsonDecoderHelper m2)) + (JD.index 3 (getJsonDecoderHelper m3)) + ) + (JD.map2 Tuple.pair + (JD.index 4 (getJsonDecoderHelper m4)) + (JD.index 5 (getJsonDecoderHelper m5)) + ) + (JD.map2 Tuple.pair + (JD.index 6 (getJsonDecoderHelper m6)) + (JD.index 7 (getJsonDecoderHelper m7)) + ) + (JD.map2 Tuple.pair + (JD.index 8 (getJsonDecoderHelper m8)) + (JD.index 9 (getJsonDecoderHelper m9)) + ) + ) + + +result9 : + (value -> a -> b -> c -> d -> e -> f -> g -> h -> i) + -> Result error value + -> ( Result error a, Result error b ) + -> ( Result error c, Result error d ) + -> ( Result error e, Result error f ) + -> ( Result error g, Result error h ) + -> Result error i +result9 ctor v1 ( v2, v3 ) ( v4, v5 ) ( v6, v7 ) ( v8, v9 ) = + case T9 v1 v2 v3 v4 v5 v6 v7 v8 v9 of + T9 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) (Ok ok7) (Ok ok8) (Ok ok9) -> + ctor ok1 ok2 ok3 ok4 ok5 ok6 ok7 ok8 ok9 |> Ok + + T9 (Err err) _ _ _ _ _ _ _ _ -> + Err err + + T9 _ (Err err) _ _ _ _ _ _ _ -> + Err err + + T9 _ _ (Err err) _ _ _ _ _ _ -> + Err err + + T9 _ _ _ (Err err) _ _ _ _ _ -> + Err err + + T9 _ _ _ _ (Err err) _ _ _ _ -> + Err err + + T9 _ _ _ _ _ (Err err) _ _ _ -> + Err err + + T9 _ _ _ _ _ _ (Err err) _ _ -> + Err err + + T9 _ _ _ _ _ _ _ (Err err) _ -> + Err err + + T9 _ _ _ _ _ _ _ _ (Err err) -> + Err err + + +{-| Finish creating a codec for a custom type. +-} +finishCustomType : CustomTypeCodec () e (a -> VariantEncoder) a -> Codec e a +finishCustomType (CustomTypeCodec am) = + build + (am.match >> (\(VariantEncoder ( a, _ )) -> a)) + (BD.unsignedInt16 endian + |> BD.andThen + (\tag -> + am.decoder tag (BD.succeed (Err DataCorrupted)) + ) + ) + (am.jsonMatch >> (\(VariantEncoder ( _, a )) -> a)) + (JD.index 0 JD.int + |> JD.andThen + (\tag -> + am.jsonDecoder tag (JD.succeed (Err DataCorrupted)) + ) + ) + + + +---- MAPPING + + +{-| Map from one codec to another codec + + import Serialize as S + + type UserId + = UserId Int + + userIdCodec : S.Codec e UserId + userIdCodec = + S.int |> S.map UserId (\(UserId id) -> id) + +Note that there's nothing preventing you from encoding Elm values that will map to some different value when you decode them. +I recommend writing tests for Codecs that use `map` to make sure you get back the same Elm value you put in. +[Here's some helper functions to get you started.](https://github.com/MartinSStewart/elm-geometry-serialize/blob/6f2244c28631ede1b864cb43541d1573dc628904/tests/Tests.elm#L49-L74) + +-} +map : (a -> b) -> (b -> a) -> Codec e a -> Codec e b +map fromBytes_ toBytes_ codec = + mapHelper + (\value -> + case value of + Ok ok -> + fromBytes_ ok |> Ok + + Err err -> + Err err + ) + toBytes_ + codec + + +mapHelper : (Result (Error e) a -> Result (Error e) b) -> (b -> a) -> Codec e a -> Codec e b +mapHelper fromBytes_ toBytes_ codec = + build + (\v -> toBytes_ v |> getBytesEncoderHelper codec) + (getBytesDecoderHelper codec |> BD.map fromBytes_) + (\v -> toBytes_ v |> getJsonEncoderHelper codec) + (getJsonDecoderHelper codec |> JD.map fromBytes_) + + +{-| Map from one codec to another codec in a way that can potentially fail when decoding. + + -- Email module is from https://package.elm-lang.org/packages/tricycle/elm-email/1.0.2/ + + + import Email + import Serialize as S + + emailCodec : S.Codec String Float + emailCodec = + S.string + |> S.mapValid + (\text -> + case Email.fromString text of + Just email -> + Ok email + + Nothing -> + Err "Invalid email" + ) + Email.toString + +Note that there's nothing preventing you from encoding Elm values that will produce Err when you decode them. +I recommend writing tests for Codecs that use `mapValid` to make sure you get back the same Elm value you put in. +[Here's some helper functions to get you started.](https://github.com/MartinSStewart/elm-geometry-serialize/blob/6f2244c28631ede1b864cb43541d1573dc628904/tests/Tests.elm#L49-L74) + +-} +mapValid : (a -> Result e b) -> (b -> a) -> Codec e a -> Codec e b +mapValid fromBytes_ toBytes_ codec = + build + (\v -> toBytes_ v |> getBytesEncoderHelper codec) + (getBytesDecoderHelper codec + |> BD.map + (\value -> + case value of + Ok ok -> + fromBytes_ ok |> Result.mapError CustomError + + Err err -> + Err err + ) + ) + (\v -> toBytes_ v |> getJsonEncoderHelper codec) + (getJsonDecoderHelper codec + |> JD.map + (\value -> + case value of + Ok ok -> + fromBytes_ ok |> Result.mapError CustomError + + Err err -> + Err err + ) + ) + + +{-| Map errors generated by `mapValid`. +-} +mapError : (e1 -> e2) -> Codec e1 a -> Codec e2 a +mapError mapFunc codec = + build + (getBytesEncoderHelper codec) + (getBytesDecoderHelper codec |> BD.map (mapErrorHelper mapFunc)) + (getJsonEncoderHelper codec) + (getJsonDecoderHelper codec |> JD.map (mapErrorHelper mapFunc)) + + +mapErrorHelper : (e -> a) -> Result (Error e) b -> Result (Error a) b +mapErrorHelper mapFunc = + Result.mapError + (\error -> + case error of + CustomError custom -> + mapFunc custom |> CustomError + + DataCorrupted -> + DataCorrupted + + SerializerOutOfDate -> + SerializerOutOfDate + ) + + + +-- STACK UNSAFE + + +{-| Handle situations where you need to define a codec in terms of itself. + + import Serialize as S + + type Peano + = Peano (Maybe Peano) + + {-| The compiler will complain that this function causes an infinite loop. + -} + badPeanoCodec : S.Codec e Peano + badPeanoCodec = + S.maybe badPeanoCodec |> S.map Peano (\(Peano a) -> a) + + {-| Now the compiler is happy! + -} + goodPeanoCodec : S.Codec e Peano + goodPeanoCodec = + S.maybe (S.lazy (\() -> goodPeanoCodec)) |> S.map Peano (\(Peano a) -> a) + +**Warning:** This is not stack safe. + +In general if you have a type that contains itself, like with our the Peano example, then you're at risk of a stack overflow while decoding. +Even if you're translating your nested data into a list before encoding, you're at risk, because the function translating back after decoding can cause a stack overflow if the original value was nested deeply enough. +Be careful here, and test your codecs using elm-test with larger inputs than you ever expect to see in real life. + +-} +lazy : (() -> Codec e a) -> Codec e a +lazy f = + build + (\value -> getBytesEncoderHelper (f ()) value) + (BD.succeed () |> BD.andThen (\() -> getBytesDecoderHelper (f ()))) + (\value -> getJsonEncoderHelper (f ()) value) + (JD.lazy (\() -> getJsonDecoderHelper (f ()))) diff --git a/src/Terminal/Bump.elm b/src/Terminal/Bump.elm index 2cfeb44f3..ea10a333a 100644 --- a/src/Terminal/Bump.elm +++ b/src/Terminal/Bump.elm @@ -188,7 +188,7 @@ generateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) = e :: es -> Task.eio Exit.BumpBadBuild <| - Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.keepDocs (NE.Nonempty e es) + Build.fromExposed Docs.jsonCodec Reporting.silent root details Build.keepDocs (NE.Nonempty e es) ) diff --git a/src/Terminal/Diff.elm b/src/Terminal/Diff.elm index 136da8f62..b5ae5bc36 100644 --- a/src/Terminal/Diff.elm +++ b/src/Terminal/Diff.elm @@ -216,7 +216,7 @@ generateDocs (Env maybeRoot _ _ _) = e :: es -> Task.eio Exit.DiffBadBuild <| - Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.keepDocs (NE.Nonempty e es) + Build.fromExposed Docs.jsonCodec Reporting.silent root details Build.keepDocs (NE.Nonempty e es) ) diff --git a/src/Terminal/Make.elm b/src/Terminal/Make.elm index 6e11376b3..c3dac5b4a 100644 --- a/src/Terminal/Make.elm +++ b/src/Terminal/Make.elm @@ -24,9 +24,8 @@ import Compiler.AST.Optimized as Opt import Compiler.Data.NonEmptyList as NE import Compiler.Elm.ModuleName as ModuleName import Compiler.Generate.Html as Html -import Json.Decode as Decode -import Json.Encode as Encode import Maybe.Extra as Maybe +import Serialize import System.IO as IO exposing (IO) import Terminal.Terminal.Internal exposing (Parser(..)) import Utils.Main as Utils exposing (FilePath) @@ -207,7 +206,7 @@ buildExposed style root details maybeDocs exposed = Maybe.unwrap Build.ignoreDocs Build.writeDocs maybeDocs in Task.eio Exit.MakeCannotBuild <| - Build.fromExposed (Decode.succeed ()) (\_ -> Encode.object []) style root details docsGoal exposed + Build.fromExposed Serialize.unit style root details docsGoal exposed buildPaths : Reporting.Style -> FilePath -> Details.Details -> NE.Nonempty FilePath -> Task Build.Artifacts diff --git a/src/Terminal/Publish.elm b/src/Terminal/Publish.elm index fc4f110ee..edd9666c0 100644 --- a/src/Terminal/Publish.elm +++ b/src/Terminal/Publish.elm @@ -24,6 +24,7 @@ import Compiler.Json.Decode as D import Compiler.Json.String as Json import Compiler.Reporting.Doc as D import List.Extra as List +import Serialize import System.Exit as Exit import System.IO as IO exposing (IO) import System.Process as Process @@ -239,7 +240,7 @@ verifyBuild root = |> Task.bind (\exposed -> Task.eio Exit.PublishBuildProblem <| - Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.keepDocs exposed + Build.fromExposed Docs.jsonCodec Reporting.silent root details Build.keepDocs exposed ) ) ) @@ -424,7 +425,7 @@ verifyZipBuild root = |> Task.bind (\exposed -> Task.eio Exit.PublishZipBuildProblem - (Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.keepDocs exposed) + (Build.fromExposed Docs.jsonCodec Reporting.silent root details Build.keepDocs exposed) |> Task.fmap (\_ -> ()) ) ) @@ -514,7 +515,7 @@ register manager pkg vsn docs commitHash sha = Http.upload manager url [ Http.filePart "elm.json" "elm.json" - , Http.jsonPart "docs.json" "docs.json" (Docs.jsonEncoder docs) + , Http.jsonPart "docs.json" "docs.json" (Serialize.encodeToJson Docs.jsonCodec docs) , Http.filePart "README.md" "README.md" , Http.stringPart "github-hash" (Http.shaToChars sha) ] diff --git a/src/Utils/Main.elm b/src/Utils/Main.elm index 9cbcffbb0..72b101b77 100644 --- a/src/Utils/Main.elm +++ b/src/Utils/Main.elm @@ -1,6 +1,5 @@ module Utils.Main exposing - ( AsyncException(..) - , ChItem + ( ChItem , Chan , FilePath , HttpExceptionContent(..) @@ -57,8 +56,7 @@ module Utils.Main exposing , fpTakeDirectory , fpTakeExtension , fpTakeFileName - , httpExceptionContentDecoder - , httpExceptionContentEncoder + , httpExceptionContentCodec , httpHLocation , httpResponseHeaders , httpResponseStatus @@ -74,8 +72,7 @@ module Utils.Main exposing , listTraverse , listTraverse_ , lockWithFileLock - , mVarDecoder - , mVarEncoder + , mVarCodec , mapFindMin , mapFromKeys , mapFromListWith @@ -93,7 +90,6 @@ module Utils.Main exposing , mapUnionWith , mapUnions , mapUnionsWith - , maybeEncoder , maybeMapM , maybeTraverseTask , newChan @@ -114,8 +110,7 @@ module Utils.Main exposing , sequenceDictResult_ , sequenceListMaybe , sequenceNonemptyListResult - , someExceptionDecoder - , someExceptionEncoder + , someExceptionCodec , takeMVar , unlines , unzip3 @@ -127,17 +122,14 @@ import Basics.Extra exposing (flip) import Builder.Reporting.Task as Task exposing (Task) import Compiler.Data.Index as Index import Compiler.Data.NonEmptyList as NE -import Compiler.Json.Decode as D -import Compiler.Json.Encode as E import Compiler.Reporting.Result as R import Control.Monad.State.Strict as State import Data.Map as Map exposing (Dict) import Data.Set as EverySet exposing (EverySet) import Dict -import Json.Decode as Decode -import Json.Encode as Encode import Maybe.Extra as Maybe import Prelude +import Serialize exposing (Codec) import System.Exit as Exit import System.IO as IO exposing (IO(..)) import Time @@ -192,16 +184,6 @@ mapFromListWith toComparable f = Map.empty -maybeEncoder : (a -> Encode.Value) -> Maybe a -> Encode.Value -maybeEncoder encoder maybeValue = - case maybeValue of - Just value -> - encoder value - - Nothing -> - Encode.null - - eitherLefts : List (Result e a) -> List e eitherLefts = List.filterMap @@ -885,10 +867,6 @@ type SomeException = SomeException -type AsyncException - = UserInterrupt - - bracket : IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket before after thing = before @@ -929,22 +907,22 @@ type MVar a = MVar Int -newMVar : (a -> Encode.Value) -> a -> IO (MVar a) -newMVar encoder value = +newMVar : Codec e a -> a -> IO (MVar a) +newMVar codec value = newEmptyMVar |> IO.bind (\mvar -> - putMVar encoder mvar value + putMVar codec mvar value |> IO.fmap (\_ -> mvar) ) -readMVar : Decode.Decoder a -> MVar a -> IO a -readMVar decoder (MVar ref) = +readMVar : Codec e a -> MVar a -> IO a +readMVar codec (MVar ref) = IO (\s -> ( s, IO.ReadMVar IO.pure ref )) |> IO.fmap (\encodedValue -> - case Decode.decodeValue decoder encodedValue of + case Serialize.decodeFromJson codec encodedValue of Ok value -> value @@ -953,23 +931,23 @@ readMVar decoder (MVar ref) = ) -modifyMVar : Decode.Decoder a -> (a -> Encode.Value) -> MVar a -> (a -> IO ( a, b )) -> IO b -modifyMVar decoder encoder m io = - takeMVar decoder m +modifyMVar : Codec e a -> MVar a -> (a -> IO ( a, b )) -> IO b +modifyMVar codec m io = + takeMVar codec m |> IO.bind io |> IO.bind (\( a, b ) -> - putMVar encoder m a + putMVar codec m a |> IO.fmap (\_ -> b) ) -takeMVar : Decode.Decoder a -> MVar a -> IO a -takeMVar decoder (MVar ref) = +takeMVar : Codec e a -> MVar a -> IO a +takeMVar codec (MVar ref) = IO (\s -> ( s, IO.TakeMVar IO.pure ref )) |> IO.fmap (\encodedValue -> - case Decode.decodeValue decoder encodedValue of + case Serialize.decodeFromJson codec encodedValue of Ok value -> value @@ -978,9 +956,9 @@ takeMVar decoder (MVar ref) = ) -putMVar : (a -> Encode.Value) -> MVar a -> a -> IO () -putMVar encoder (MVar ref) value = - IO (\s -> ( s, IO.PutMVar IO.pure ref (encoder value) )) +putMVar : Codec e a -> MVar a -> a -> IO () +putMVar codec (MVar ref) value = + IO (\s -> ( s, IO.PutMVar IO.pure ref (Serialize.encodeToJson codec value) )) newEmptyMVar : IO (MVar a) @@ -1005,15 +983,15 @@ type ChItem a = ChItem a (Stream a) -newChan : (MVar (ChItem a) -> Encode.Value) -> IO (Chan a) -newChan encoder = +newChan : Codec e (MVar (ChItem a)) -> IO (Chan a) +newChan codec = newEmptyMVar |> IO.bind (\hole -> - newMVar encoder hole + newMVar codec hole |> IO.bind (\readVar -> - newMVar encoder hole + newMVar codec hole |> IO.fmap (\writeVar -> Chan readVar writeVar @@ -1022,11 +1000,11 @@ newChan encoder = ) -readChan : Decode.Decoder a -> Chan a -> IO a -readChan decoder (Chan readVar _) = - modifyMVar mVarDecoder mVarEncoder readVar <| +readChan : Codec e a -> Chan a -> IO a +readChan codec (Chan readVar _) = + modifyMVar mVarCodec readVar <| \read_end -> - readMVar (chItemDecoder decoder) read_end + readMVar (chItemCodec codec) read_end |> IO.fmap (\(ChItem val new_read_end) -> -- Use readMVar here, not takeMVar, @@ -1035,16 +1013,16 @@ readChan decoder (Chan readVar _) = ) -writeChan : (a -> Encode.Value) -> Chan a -> a -> IO () -writeChan encoder (Chan _ writeVar) val = +writeChan : Codec e a -> Chan a -> a -> IO () +writeChan codec (Chan _ writeVar) val = newEmptyMVar |> IO.bind (\new_hole -> - takeMVar mVarDecoder writeVar + takeMVar mVarCodec writeVar |> IO.bind (\old_hole -> - putMVar (chItemEncoder encoder) old_hole (ChItem val new_hole) - |> IO.bind (\_ -> putMVar mVarEncoder writeVar new_hole) + putMVar (chItemCodec codec) old_hole (ChItem val new_hole) + |> IO.bind (\_ -> putMVar mVarCodec writeVar new_hole) ) ) @@ -1062,18 +1040,18 @@ builderHPutBuilder handle str = -- Data.Binary -binaryDecodeFileOrFail : Decode.Decoder a -> FilePath -> IO (Result ( Int, String ) a) -binaryDecodeFileOrFail decoder filename = +binaryDecodeFileOrFail : Codec e a -> FilePath -> IO (Result ( Int, String ) a) +binaryDecodeFileOrFail codec filename = IO (\s -> ( s, IO.BinaryDecodeFileOrFail IO.pure filename )) |> IO.fmap - (Decode.decodeValue decoder + (Serialize.decodeFromJson codec >> Result.mapError (\_ -> ( 0, "Could not find file " ++ filename )) ) -binaryEncodeFile : (a -> Encode.Value) -> FilePath -> a -> IO () -binaryEncodeFile encoder path value = - IO (\s -> ( s, IO.Write IO.pure path (encoder value) )) +binaryEncodeFile : Codec e a -> FilePath -> a -> IO () +binaryEncodeFile codec path value = + IO (\s -> ( s, IO.Write IO.pure path (Serialize.encodeToJson codec value) )) @@ -1130,128 +1108,75 @@ replGetInputLineWithInitial prompt ( left, right ) = -- ENCODERS and DECODERS -mVarDecoder : Decode.Decoder (MVar a) -mVarDecoder = - Decode.map MVar Decode.int - +mVarCodec : Codec e (MVar a) +mVarCodec = + Serialize.int |> Serialize.map MVar (\(MVar ref) -> ref) -mVarEncoder : MVar a -> Encode.Value -mVarEncoder (MVar ref) = - Encode.int ref - -chItemEncoder : (a -> Encode.Value) -> ChItem a -> Encode.Value -chItemEncoder valueEncoder (ChItem value hole) = - Encode.object - [ ( "type", Encode.string "ChItem" ) - , ( "value", valueEncoder value ) - , ( "hole", mVarEncoder hole ) - ] +chItemCodec : Codec e a -> Codec e (ChItem a) +chItemCodec codec = + Serialize.customType + (\chItemCodecEncoder (ChItem value hole) -> + chItemCodecEncoder value hole + ) + |> Serialize.variant2 ChItem codec mVarCodec + |> Serialize.finishCustomType -chItemDecoder : Decode.Decoder a -> Decode.Decoder (ChItem a) -chItemDecoder decoder = - Decode.map2 ChItem (Decode.field "value" decoder) (Decode.field "hole" mVarDecoder) +someExceptionCodec : Codec e SomeException +someExceptionCodec = + Serialize.customType + (\someExceptionCodecEncoder SomeException -> + someExceptionCodecEncoder + ) + |> Serialize.variant0 SomeException + |> Serialize.finishCustomType -someExceptionEncoder : SomeException -> Encode.Value -someExceptionEncoder _ = - Encode.object [ ( "type", Encode.string "SomeException" ) ] +httpExceptionContentCodec : Codec e HttpExceptionContent +httpExceptionContentCodec = + Serialize.customType + (\statusCodeExceptionEncoder tooManyRedirectsEncoder connectionFailureEncoder value -> + case value of + StatusCodeException response body -> + statusCodeExceptionEncoder response body + TooManyRedirects responses -> + tooManyRedirectsEncoder responses -someExceptionDecoder : Decode.Decoder SomeException -someExceptionDecoder = - Decode.succeed SomeException + ConnectionFailure someException -> + connectionFailureEncoder someException + ) + |> Serialize.variant2 StatusCodeException httpResponseCodec Serialize.string + |> Serialize.variant1 TooManyRedirects (Serialize.list httpResponseCodec) + |> Serialize.variant1 ConnectionFailure someExceptionCodec + |> Serialize.finishCustomType -httpResponseEncoder : HttpResponse body -> Encode.Value -httpResponseEncoder (HttpResponse httpResponse) = - Encode.object - [ ( "type", Encode.string "HttpResponse" ) - , ( "responseStatus", httpStatusEncoder httpResponse.responseStatus ) - , ( "responseHeaders", httpResponseHeadersEncoder httpResponse.responseHeaders ) - ] +httpResponseCodec : Codec e (HttpResponse body) +httpResponseCodec = + Serialize.customType + (\httpResponseCodecEncoder (HttpResponse httpResponse) -> + httpResponseCodecEncoder httpResponse + ) + |> Serialize.variant1 + HttpResponse + (Serialize.record + (\responseStatus responseHeaders -> + { responseStatus = responseStatus, responseHeaders = responseHeaders } + ) + |> Serialize.field .responseStatus httpStatusCodec + |> Serialize.field .responseHeaders (Serialize.list (Serialize.tuple Serialize.string Serialize.string)) + |> Serialize.finishRecord + ) + |> Serialize.finishCustomType -httpResponseDecoder : Decode.Decoder (HttpResponse body) -httpResponseDecoder = - Decode.map2 - (\responseStatus responseHeaders -> - HttpResponse - { responseStatus = responseStatus - , responseHeaders = responseHeaders - } +httpStatusCodec : Codec e HttpStatus +httpStatusCodec = + Serialize.customType + (\httpStatusCodecEncoder (HttpStatus statusCode statusMessage) -> + httpStatusCodecEncoder statusCode statusMessage ) - (Decode.field "responseStatus" httpStatusDecoder) - (Decode.field "responseHeaders" httpResponseHeadersDecoder) - - -httpStatusEncoder : HttpStatus -> Encode.Value -httpStatusEncoder (HttpStatus statusCode statusMessage) = - Encode.object - [ ( "type", Encode.string "HttpStatus" ) - , ( "statusCode", Encode.int statusCode ) - , ( "statusMessage", Encode.string statusMessage ) - ] - - -httpStatusDecoder : Decode.Decoder HttpStatus -httpStatusDecoder = - Decode.map2 HttpStatus - (Decode.field "statusCode" Decode.int) - (Decode.field "statusMessage" Decode.string) - - -httpResponseHeadersEncoder : HttpResponseHeaders -> Encode.Value -httpResponseHeadersEncoder = - Encode.list (E.jsonPair Encode.string Encode.string) - - -httpResponseHeadersDecoder : Decode.Decoder HttpResponseHeaders -httpResponseHeadersDecoder = - Decode.list (D.jsonPair Decode.string Decode.string) - - -httpExceptionContentEncoder : HttpExceptionContent -> Encode.Value -httpExceptionContentEncoder httpExceptionContent = - case httpExceptionContent of - StatusCodeException response body -> - Encode.object - [ ( "type", Encode.string "StatusCodeException" ) - , ( "response", httpResponseEncoder response ) - , ( "body", Encode.string body ) - ] - - TooManyRedirects responses -> - Encode.object - [ ( "type", Encode.string "TooManyRedirects" ) - , ( "responses", Encode.list httpResponseEncoder responses ) - ] - - ConnectionFailure someException -> - Encode.object - [ ( "type", Encode.string "ConnectionFailure" ) - , ( "someException", someExceptionEncoder someException ) - ] - - -httpExceptionContentDecoder : Decode.Decoder HttpExceptionContent -httpExceptionContentDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "StatusCodeException" -> - Decode.map2 StatusCodeException - (Decode.field "response" httpResponseDecoder) - (Decode.field "body" Decode.string) - - "TooManyRedirects" -> - Decode.map TooManyRedirects (Decode.field "responses" (Decode.list httpResponseDecoder)) - - "ConnectionFailure" -> - Decode.map ConnectionFailure (Decode.field "someException" someExceptionDecoder) - - _ -> - Decode.fail ("Failed to decode HttpExceptionContent's type: " ++ type_) - ) + |> Serialize.variant2 HttpStatus Serialize.int Serialize.string + |> Serialize.finishCustomType