Stabel

Check-in [655d66871f]
Login
Overview
Comment:Imported types are now qualified when used in type match.
Timelines: family | ancestors | descendants | both | module-definition
Files: files | file ages | folders
SHA3-256: 655d66871fbcd65c34fba20d67a2a55509fb2a92b4f6b5da4139e696628cd9d2
User & Date: robin.hansen on 2021-05-26 09:43:20
Other Links: branch diff | manifest | tags
Context
2021-05-26
17:53
Detect required modules from type definitions, type signatures and type matches. check-in: 8d4e3a7233 user: robin.hansen tags: module-definition
09:43
Imported types are now qualified when used in type match. check-in: 655d66871f user: robin.hansen tags: module-definition
2021-05-25
19:37
Qualifier nearly understands imports, now. A failing test marks what remains of work. check-in: d888dffff5 user: robin.hansen tags: module-definition
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified src/Play/Qualifier.elm from [8c3fd626e6] to [f67fc10ec5].

436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
...
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
...
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
...
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
...
700
701
702
703
704
705
706
707




708






709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
...
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809

        ( newWordsAfterWhens, qualifiedWhensResult ) =
            whens
                |> List.foldr
                    (qualifyWhen
                        config
                        qualifiedTypes
                        moduleReferences.aliases
                        moduleReferences.imports
                        unqualifiedWord.name
                        moduleReferences
                    )
                    ( acc, [] )
                |> Tuple.mapSecond Result.combine

        ( newWordsAfterImpl, qualifiedImplementationResult ) =
................................................................................
    , output = List.map (resolveUnion typeDefs) wt.output
    }


qualifyWhen :
    RunConfig
    -> Dict String TypeDefinition
    -> Dict String String
    -> Dict String (List String)
    -> String
    -> ModuleReferences
    -> ( Parser.TypeMatch, List Parser.AstNode )
    -> ( Dict String WordDefinition, List (Result Problem ( TypeMatch, List Node )) )
    -> ( Dict String WordDefinition, List (Result Problem ( TypeMatch, List Node )) )
qualifyWhen config qualifiedTypes aliases imports wordName modRefs ( typeMatch, impl ) ( qualifiedWords, result ) =
    let
        ( newWords, qualifiedImplementationResult ) =
            initQualifyNode config wordName modRefs qualifiedWords impl

        qualifiedMatchResult =
            qualifyMatch config qualifiedTypes aliases imports typeMatch
    in
    case ( qualifiedImplementationResult, qualifiedMatchResult ) of
        ( Err err, _ ) ->
            ( newWords
            , Err err :: result
            )

................................................................................
            , Ok ( qualifiedMatch, qualifiedImplementation ) :: result
            )


qualifyMatch :
    RunConfig
    -> Dict String TypeDefinition
    -> Dict String String
    -> Dict String (List String)
    -> Parser.TypeMatch
    -> Result Problem TypeMatch
qualifyMatch config qualifiedTypes aliases imports typeMatch =
    let
        qualifiedNameToMatch range name patterns =
            case Dict.get name qualifiedTypes of
                Just (CustomTypeDef _ _ gens members) ->
                    let
                        memberNames =
                            members
................................................................................

                        qualifiedPatternsResult =
                            patterns
                                |> List.map
                                    (qualifyMatchValue
                                        config
                                        qualifiedTypes
                                        aliases
                                        imports
                                        range
                                        name
                                        memberNames
                                    )
                                |> Result.combine

                        actualType =
................................................................................
        Parser.TypeMatch range (Parser.LocalRef "Int" []) [ ( "value", Parser.LiteralInt val ) ] ->
            Ok <| TypeMatch range Type.Int [ ( "value", LiteralInt val ) ]

        Parser.TypeMatch range (Parser.Generic sym) [] ->
            Ok <| TypeMatch range (Type.Generic sym) []

        Parser.TypeMatch range (Parser.LocalRef name []) patterns ->
            qualifiedNameToMatch range (qualifyName config name) patterns











        Parser.TypeMatch range (Parser.InternalRef [ possibleAlias ] name _) patterns ->
            case Dict.get possibleAlias aliases of
                Just actualPath ->
                    if String.startsWith "/" actualPath then
                        let
                            extPath =
                                actualPath
                                    |> String.dropLeft 1
                                    |> String.split "/"
                        in
                        qualifyMatch config qualifiedTypes aliases imports <|
                            Parser.TypeMatch range (Parser.ExternalRef extPath name []) patterns

                    else
                        let
                            qualifiedName =
                                actualPath
                                    ++ "/"
................................................................................
        Parser.TypeMatch range _ _ ->
            Err <| InvalidTypeMatch range


qualifyMatchValue :
    RunConfig
    -> Dict String TypeDefinition
    -> Dict String String
    -> Dict String (List String)
    -> SourceLocationRange
    -> String
    -> Set String
    -> ( String, Parser.TypeMatchValue )
    -> Result Problem ( String, TypeMatchValue )
qualifyMatchValue config qualifiedTypes aliases imports range typeName memberNames ( fieldName, matchValue ) =
    if Set.member fieldName memberNames then
        case matchValue of
            Parser.LiteralInt val ->
                Ok <| ( fieldName, LiteralInt val )

            Parser.LiteralType type_ ->
                let
                    modRefs =
                        { aliases = aliases
                        , imports = imports
                        }

                    qualifyTypeResult =
                        qualifyMemberType config modRefs range type_
                in
                case qualifyTypeResult of
                    Ok qualifiedType ->
                        Ok <| ( fieldName, LiteralType qualifiedType )

                    Err err ->
                        Err err

            Parser.RecursiveMatch typeMatch ->
                case qualifyMatch config qualifiedTypes aliases imports typeMatch of
                    Err err ->
                        Err err

                    Ok match ->
                        Ok <| ( fieldName, RecursiveMatch match )

    else







<
<







 







<
<





|





|







 







|
<


|







 







|
<







 







|
>
>
>
>

>
>
>
>
>
>

|








|







 







|
<





|







<
<
<
<
<











|







436
437
438
439
440
441
442


443
444
445
446
447
448
449
...
598
599
600
601
602
603
604


605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
...
631
632
633
634
635
636
637
638

639
640
641
642
643
644
645
646
647
648
...
651
652
653
654
655
656
657
658

659
660
661
662
663
664
665
...
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
...
768
769
770
771
772
773
774
775

776
777
778
779
780
781
782
783
784
785
786
787
788





789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807

        ( newWordsAfterWhens, qualifiedWhensResult ) =
            whens
                |> List.foldr
                    (qualifyWhen
                        config
                        qualifiedTypes


                        unqualifiedWord.name
                        moduleReferences
                    )
                    ( acc, [] )
                |> Tuple.mapSecond Result.combine

        ( newWordsAfterImpl, qualifiedImplementationResult ) =
................................................................................
    , output = List.map (resolveUnion typeDefs) wt.output
    }


qualifyWhen :
    RunConfig
    -> Dict String TypeDefinition


    -> String
    -> ModuleReferences
    -> ( Parser.TypeMatch, List Parser.AstNode )
    -> ( Dict String WordDefinition, List (Result Problem ( TypeMatch, List Node )) )
    -> ( Dict String WordDefinition, List (Result Problem ( TypeMatch, List Node )) )
qualifyWhen config qualifiedTypes wordName modRefs ( typeMatch, impl ) ( qualifiedWords, result ) =
    let
        ( newWords, qualifiedImplementationResult ) =
            initQualifyNode config wordName modRefs qualifiedWords impl

        qualifiedMatchResult =
            qualifyMatch config qualifiedTypes modRefs typeMatch
    in
    case ( qualifiedImplementationResult, qualifiedMatchResult ) of
        ( Err err, _ ) ->
            ( newWords
            , Err err :: result
            )

................................................................................
            , Ok ( qualifiedMatch, qualifiedImplementation ) :: result
            )


qualifyMatch :
    RunConfig
    -> Dict String TypeDefinition
    -> ModuleReferences

    -> Parser.TypeMatch
    -> Result Problem TypeMatch
qualifyMatch config qualifiedTypes modRefs typeMatch =
    let
        qualifiedNameToMatch range name patterns =
            case Dict.get name qualifiedTypes of
                Just (CustomTypeDef _ _ gens members) ->
                    let
                        memberNames =
                            members
................................................................................

                        qualifiedPatternsResult =
                            patterns
                                |> List.map
                                    (qualifyMatchValue
                                        config
                                        qualifiedTypes
                                        modRefs

                                        range
                                        name
                                        memberNames
                                    )
                                |> Result.combine

                        actualType =
................................................................................
        Parser.TypeMatch range (Parser.LocalRef "Int" []) [ ( "value", Parser.LiteralInt val ) ] ->
            Ok <| TypeMatch range Type.Int [ ( "value", LiteralInt val ) ]

        Parser.TypeMatch range (Parser.Generic sym) [] ->
            Ok <| TypeMatch range (Type.Generic sym) []

        Parser.TypeMatch range (Parser.LocalRef name []) patterns ->
            case qualifiedNameToMatch range (qualifyName config name) patterns of
                (Err (UnknownTypeRef _ _)) as errMsg ->
                    case resolveImportedType config modRefs name of
                        Just importedModule ->
                            qualifiedNameToMatch range (importedModule ++ "/" ++ name) patterns

                        Nothing ->
                            errMsg

                result ->
                    result

        Parser.TypeMatch range (Parser.InternalRef [ possibleAlias ] name _) patterns ->
            case Dict.get possibleAlias modRefs.aliases of
                Just actualPath ->
                    if String.startsWith "/" actualPath then
                        let
                            extPath =
                                actualPath
                                    |> String.dropLeft 1
                                    |> String.split "/"
                        in
                        qualifyMatch config qualifiedTypes modRefs <|
                            Parser.TypeMatch range (Parser.ExternalRef extPath name []) patterns

                    else
                        let
                            qualifiedName =
                                actualPath
                                    ++ "/"
................................................................................
        Parser.TypeMatch range _ _ ->
            Err <| InvalidTypeMatch range


qualifyMatchValue :
    RunConfig
    -> Dict String TypeDefinition
    -> ModuleReferences

    -> SourceLocationRange
    -> String
    -> Set String
    -> ( String, Parser.TypeMatchValue )
    -> Result Problem ( String, TypeMatchValue )
qualifyMatchValue config qualifiedTypes modRefs range typeName memberNames ( fieldName, matchValue ) =
    if Set.member fieldName memberNames then
        case matchValue of
            Parser.LiteralInt val ->
                Ok <| ( fieldName, LiteralInt val )

            Parser.LiteralType type_ ->
                let





                    qualifyTypeResult =
                        qualifyMemberType config modRefs range type_
                in
                case qualifyTypeResult of
                    Ok qualifiedType ->
                        Ok <| ( fieldName, LiteralType qualifiedType )

                    Err err ->
                        Err err

            Parser.RecursiveMatch typeMatch ->
                case qualifyMatch config qualifiedTypes modRefs typeMatch of
                    Err err ->
                        Err err

                    Ok match ->
                        Ok <| ( fieldName, RecursiveMatch match )

    else