(* TEST
 expect;
*)

module type Endpoint_intf = sig
  type t
end
;;
[%%expect{|
module type Endpoint_intf = sig type t end
|}]

module type S = sig
  module Endpoint : Endpoint_intf

  type finite = [ `Before of Endpoint.t ]
  type infinite = [ `Until_infinity ]

  type +'a range = private { until : 'a } constraint 'a = [< finite | infinite ]

  val until : 'a range -> 'a
end
;;
[%%expect{|
module type S =
  sig
    module Endpoint : Endpoint_intf
    type finite = [ `Before of Endpoint.t ]
    type infinite = [ `Until_infinity ]
    type +'a range = private { until : 'a; }
      constraint 'a = [< `Before of Endpoint.t | `Until_infinity ]
    val until :
      ([< `Before of Endpoint.t | `Until_infinity ] as 'a) range -> 'a
  end
|}]

module type Ranged = sig
  module Endpoint : Endpoint_intf
  module Range : S with type Endpoint.t = Endpoint.t
end
;;
[%%expect{|
module type Ranged =
  sig
    module Endpoint : Endpoint_intf
    module Range :
      sig
        module Endpoint : sig type t = Endpoint.t end
        type finite = [ `Before of Endpoint.t ]
        type infinite = [ `Until_infinity ]
        type +'a range = private { until : 'a; }
          constraint 'a = [< `Before of Endpoint.t | `Until_infinity ]
        val until :
          ([< `Before of Endpoint.t | `Until_infinity ] as 'a) range -> 'a
      end
  end
|}]

module Assume (Given : sig
    module Make_range (Endpoint : Endpoint_intf) :
      S with module Endpoint = Endpoint

    module Make_ranged (Range : S) :
      Ranged with module Endpoint = Range.Endpoint
              and module Range = Range
  end) =
struct
  module Point = struct
    type t
  end

  open Given

  module Test_range = Make_range(Point)
  module Test_ranged = Make_ranged(Test_range)
end
;;
[%%expect{|
module Assume :
  (Given : sig
             module Make_range :
               (Endpoint : Endpoint_intf) ->
                 sig
                   module Endpoint : sig type t = Endpoint.t end
                   type finite = [ `Before of Endpoint.t ]
                   type infinite = [ `Until_infinity ]
                   type +'a range = private { until : 'a; }
                     constraint 'a =
                       [< `Before of Endpoint.t | `Until_infinity ]
                   val until :
                     ([< `Before of Endpoint.t | `Until_infinity ] as 'a)
                     range -> 'a
                 end
             module Make_ranged :
               (Range : S) ->
                 sig
                   module Endpoint : sig type t = Range.Endpoint.t end
                   module Range :
                     sig
                       module Endpoint : sig type t = Range.Endpoint.t end
                       type finite = [ `Before of Endpoint.t ]
                       type infinite = [ `Until_infinity ]
                       type +'a range =
                         'a Range.range = private {
                         until : 'a;
                       }
                         constraint 'a =
                           [< `Before of Endpoint.t | `Until_infinity ]
                       val until :
                         ([< `Before of Endpoint.t | `Until_infinity ] as 'a)
                         range -> 'a
                     end
                 end
           end)
    ->
    sig
      module Point : sig type t end
      module Test_range :
        sig
          module Endpoint : sig type t = Point.t end
          type finite = [ `Before of Endpoint.t ]
          type infinite = [ `Until_infinity ]
          type +'a range =
            'a Given.Make_range(Point).range = private {
            until : 'a;
          } constraint 'a = [< `Before of Endpoint.t | `Until_infinity ]
          val until :
            ([< `Before of Endpoint.t | `Until_infinity ] as 'a) range -> 'a
        end
      module Test_ranged :
        sig
          module Endpoint : sig type t = Test_range.Endpoint.t end
          module Range :
            sig
              module Endpoint : sig type t = Test_range.Endpoint.t end
              type finite = [ `Before of Endpoint.t ]
              type infinite = [ `Until_infinity ]
              type +'a range = 'a Test_range.range = private { until : 'a; }
                constraint 'a = [< `Before of Endpoint.t | `Until_infinity ]
              val until :
                ([< `Before of Endpoint.t | `Until_infinity ] as 'a) range ->
                'a
            end
        end
    end
|}]
