Skip to content

Commit 445299a

Browse files
wolfadexwolfadex
authored
Merge pull request #242 from wolfadex/track-warnings-in-monad
Use CliMonad to track warnings instead of doing it manually
2 parents 3d23473 + 10b971f commit 445299a

File tree

1 file changed

+74
-103
lines changed

1 file changed

+74
-103
lines changed

‎src/SchemaUtils.elm‎

Lines changed: 74 additions & 103 deletions
Original file line numberDiff line numberDiff line change
@@ -499,71 +499,38 @@ areSchemasDisjoint qualify schemas =
499499

500500
_ ->
501501
True
502-
503-
merged : Result (List String) ()
504-
merged =
505-
FastDict.merge
506-
(\_ lval prev ->
507-
case prev of
508-
Ok () ->
509-
prev
510-
511-
Err _ ->
512-
-- A required field on the left when additionalProperties are forbidden on the right means the sets are disjoint
513-
if lval.required && not radd then
514-
Ok ()
515-
516-
else
517-
prev
502+
in
503+
FastDict.merge
504+
(\_ lval ->
505+
CliMonad.map
506+
(\prev ->
507+
prev
508+
|| -- A required field on the left when additionalProperties are forbidden on the right means the sets are disjoint
509+
(lval.required && not radd)
518510
)
519-
(\_ lval rval prev ->
520-
case prev of
521-
Ok () ->
522-
prev
523-
524-
Err warns ->
525-
-- If the field is optional in both we could have a value without it, so it's not enough to distinguish, so we ask it's required in at least one of them
526-
if lval.required || rval.required then
527-
let
528-
( res, newWarns ) =
529-
areTypesDisjoint lval.type_ rval.type_
530-
in
531-
if res then
532-
Ok ()
533-
534-
else
535-
Err (warns ++ newWarns)
536-
537-
else
538-
prev
511+
)
512+
(\_ lval rval ->
513+
CliMonad.andThen
514+
(\prev ->
515+
if not prev && (lval.required || rval.required) then
516+
-- If the field is optional in both we could have a value without it, so it's not enough to distinguish, so we ask it's required in at least one of them
517+
areTypesDisjoint lval.type_ rval.type_
518+
519+
else
520+
CliMonad.succeed prev
539521
)
540-
(\_ rval prev ->
541-
case prev of
542-
Ok () ->
543-
prev
544-
545-
Err _ ->
546-
-- A required field on the right when additionalProperties are forbidden on the left means the sets are disjoint
547-
if rval.required && not ladd then
548-
Ok ()
549-
550-
else
551-
prev
522+
)
523+
(\_ rval ->
524+
CliMonad.map
525+
(\prev ->
526+
prev
527+
|| -- A required field on the right when additionalProperties are forbidden on the left means the sets are disjoint
528+
(rval.required && not ladd)
552529
)
553-
ldict
554-
rdict
555-
(Err [])
556-
in
557-
case merged of
558-
Ok () ->
559-
CliMonad.succeed True
560-
561-
Err warns ->
562-
warns
563-
|> Set.fromList
564-
|> Set.foldl
565-
CliMonad.withWarning
566-
(CliMonad.succeed False)
530+
)
531+
ldict
532+
rdict
533+
(CliMonad.succeed False)
567534
)
568535
(schemaToProperties qualify l)
569536
(schemaToProperties qualify r)
@@ -603,29 +570,31 @@ type SimplifiedForDisjointBasicType
603570
| SimplifiedForDisjointBool (Maybe Bool)
604571

605572

606-
areTypesDisjoint : Common.Type -> Common.Type -> ( Bool, List String )
573+
areTypesDisjoint : Common.Type -> Common.Type -> CliMonad Bool
607574
areTypesDisjoint ltype rtype =
608575
case ( ltype, rtype ) of
609576
( Common.Ref _, _ ) ->
610-
( False, [ "Disjoin check for ref types not implemented yet" ] )
577+
CliMonad.succeed False
578+
|> CliMonad.withWarning "Disjoin check for ref types not implemented yet"
611579

612580
( _, Common.Ref _ ) ->
613-
( False, [ "Disjoin check for ref types not implemented yet" ] )
581+
CliMonad.succeed False
582+
|> CliMonad.withWarning "Disjoin check for ref types not implemented yet"
614583

615584
( Common.Value, _ ) ->
616-
( False, [] )
585+
CliMonad.succeed False
617586

618587
( _, Common.Value ) ->
619-
( False, [] )
588+
CliMonad.succeed False
620589

621590
( Common.Nullable _, Common.Nullable _ ) ->
622-
( False, [] )
591+
CliMonad.succeed False
623592

624593
( Common.Null, Common.Nullable _ ) ->
625-
( False, [] )
594+
CliMonad.succeed False
626595

627596
( Common.Nullable _, Common.Null ) ->
628-
( False, [] )
597+
CliMonad.succeed False
629598

630599
( Common.Nullable c, Common.Basic _ _ ) ->
631600
areTypesDisjoint c rtype
@@ -634,29 +603,27 @@ areTypesDisjoint ltype rtype =
634603
areTypesDisjoint ltype c
635604

636605
( Common.Null, Common.Null ) ->
637-
( False, [] )
606+
CliMonad.succeed False
638607

639608
( Common.Null, Common.List _ ) ->
640-
( True, [] )
609+
CliMonad.succeed True
641610

642611
( Common.List _, Common.Null ) ->
643-
( True, [] )
612+
CliMonad.succeed True
644613

645614
( Common.OneOf _ alternatives, _ ) ->
646615
alternatives
647-
|> List.map (\alternative -> areTypesDisjoint alternative.type_ rtype)
648-
|> List.unzip
649-
|> Tuple.mapBoth (List.all identity) List.concat
616+
|> CliMonad.combineMap (\alternative -> areTypesDisjoint alternative.type_ rtype)
617+
|> CliMonad.map (List.all identity)
650618

651619
( _, Common.OneOf _ alternatives ) ->
652620
alternatives
653-
|> List.map (\alternative -> areTypesDisjoint ltype alternative.type_)
654-
|> List.unzip
655-
|> Tuple.mapBoth (List.all identity) List.concat
621+
|> CliMonad.combineMap (\alternative -> areTypesDisjoint ltype alternative.type_)
622+
|> CliMonad.map (List.all identity)
656623

657624
( Common.List _, Common.List _ ) ->
658-
-- Empty lists are not distinguished
659-
( False, [] )
625+
-- Empty lists are not possible to distinguish
626+
CliMonad.succeed False
660627

661628
( Common.Basic lbasic lopt, Common.Basic rbasic ropt ) ->
662629
case
@@ -665,27 +632,29 @@ areTypesDisjoint ltype rtype =
665632
)
666633
of
667634
( Err warning, _ ) ->
668-
( False, [ warning ] )
635+
CliMonad.succeed False
636+
|> CliMonad.withWarning warning
669637

670638
( _, Err warning ) ->
671-
( False, [ warning ] )
639+
CliMonad.succeed False
640+
|> CliMonad.withWarning warning
672641

673642
( Ok (SimplifiedForDisjointBool lconst), Ok (SimplifiedForDisjointBool rconst) ) ->
674-
( lconst /= rconst, [] )
643+
CliMonad.succeed (lconst /= rconst)
675644

676645
( Ok (SimplifiedForDisjointNumber lconst), Ok (SimplifiedForDisjointNumber rconst) ) ->
677-
( lconst /= rconst, [] )
646+
CliMonad.succeed (lconst /= rconst)
678647

679648
( Ok (SimplifiedForDisjointString lconst), Ok (SimplifiedForDisjointString rconst) ) ->
680649
if lconst /= rconst then
681-
( True, [] )
650+
CliMonad.succeed True
682651

683652
else
684653
-- TODO: check for disjoint formats
685-
( False, [] )
654+
CliMonad.succeed False
686655

687656
_ ->
688-
( True, [] )
657+
CliMonad.succeed True
689658

690659
( Common.Object lfields, Common.Object rfields ) ->
691660
let
@@ -703,21 +672,20 @@ areTypesDisjoint ltype rtype =
703672
in
704673
FastDict.merge
705674
(\_ _ acc -> acc)
706-
(\_ lfield rfield ( acc, warns ) ->
707-
if acc || (not lfield.required && not rfield.required) then
708-
( acc, warns )
675+
(\_ lfield rfield ->
676+
CliMonad.andThen
677+
(\acc ->
678+
if acc || (not lfield.required && not rfield.required) then
679+
CliMonad.succeed acc
709680

710-
else
711-
let
712-
( nacc, nwarns ) =
681+
else
713682
areTypesDisjoint lfield.type_ rfield.type_
714-
in
715-
( nacc, warns ++ nwarns )
683+
)
716684
)
717685
(\_ _ acc -> acc)
718686
ldict
719687
rdict
720-
( False, [] )
688+
(CliMonad.succeed False)
721689

722690
( Common.Enum lItems, Common.Enum rItems ) ->
723691
let
@@ -733,29 +701,32 @@ areTypesDisjoint ltype rtype =
733701
|> List.map Common.unwrapUnsafe
734702
|> Set.fromList
735703
in
736-
( Set.isEmpty (Set.intersect lSet rSet), [] )
704+
CliMonad.succeed (Set.isEmpty (Set.intersect lSet rSet))
737705

738706
( Common.Enum lItems, Common.Basic Common.String rOptions ) ->
739707
case rOptions.const of
740708
Just (Common.ConstString rConst) ->
741-
( List.all (\lItem -> Common.unwrapUnsafe lItem /= rConst) lItems, [] )
709+
CliMonad.succeed (List.all (\lItem -> Common.unwrapUnsafe lItem /= rConst) lItems)
742710

743711
Just _ ->
744-
( False, [ "Wrong constant type" ] )
712+
CliMonad.succeed False
713+
|> CliMonad.withWarning "Wrong constant type"
745714

746715
Nothing ->
747716
case rOptions.format of
748717
Nothing ->
749-
( False, [] )
718+
CliMonad.succeed False
750719

751720
Just rFormat ->
752-
( False, [ "Disjoin check not implemented for types enum and string:" ++ rFormat ] )
721+
CliMonad.succeed False
722+
|> CliMonad.withWarning ("Disjoin check not implemented for types enum and string:" ++ rFormat)
753723

754724
( Common.Basic Common.String _, Common.Enum _ ) ->
755725
areTypesDisjoint rtype ltype
756726

757727
_ ->
758-
( False, [ "Disjoin check not implemented for types " ++ typeToString ltype ++ " and " ++ typeToString rtype ] )
728+
CliMonad.succeed False
729+
|> CliMonad.withWarning ("Disjoin check not implemented for types " ++ typeToString ltype ++ " and " ++ typeToString rtype)
759730

760731

761732
typeToString : Common.Type -> String

0 commit comments

Comments
 (0)