module OldLayoutOps((>==#<), (>+#<)) where
--import Fudget
import LayoutDir(Orientation(..))
import Placers(horizontalP',verticalP')
import Placer(placerF)
import AlignP(revP)
--import LayoutRequest
--import Geometry
import CompF(compF)
import SerCompF(serCompF)

infixl >+#<, >==#<

-- Old version of infix operators for common layout combinators.
-- Provided for backwards compatibility only.

F a b
f1 >+#< :: F a b
-> (Distance, Orientation, F c d) -> F (Either a c) (Either b d)
>+#<  (Distance, Orientation, F c d)
of2 = (F a b -> F c d -> F (Either a c) (Either b d))
-> F a b
-> (Distance, Orientation, F c d)
-> F (Either a c) (Either b d)
forall t t a b.
(t -> t -> F a b) -> t -> (Distance, Orientation, t) -> F a b
cLF F a b -> F c d -> F (Either a c) (Either b d)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
compF F a b
f1 (Distance, Orientation, F c d)
of2
F a1 b
f1 >==#< :: F a1 b -> (Distance, Orientation, F a a1) -> F a b
>==#< (Distance, Orientation, F a a1)
of2 = (F a1 b -> F a a1 -> F a b)
-> F a1 b -> (Distance, Orientation, F a a1) -> F a b
forall t t a b.
(t -> t -> F a b) -> t -> (Distance, Orientation, t) -> F a b
cLF F a1 b -> F a a1 -> F a b
forall a1 b a2. F a1 b -> F a2 a1 -> F a2 b
serCompF F a1 b
f1 (Distance, Orientation, F a a1)
of2

cLF :: (t -> t -> F a b) -> t -> (Distance, Orientation, t) -> F a b
cLF t -> t -> F a b
cF t
f1 (Distance
dist,Orientation
ori,t
f2) =
    let placer :: Distance -> Placer
placer =
            case Orientation
ori of
              Orientation
Above -> Distance -> Placer
verticalP'
              Orientation
Below -> Placer -> Placer
revP (Placer -> Placer) -> (Distance -> Placer) -> Distance -> Placer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Distance -> Placer
verticalP'
              Orientation
LeftOf -> Distance -> Placer
horizontalP'
              Orientation
RightOf -> Placer -> Placer
revP (Placer -> Placer) -> (Distance -> Placer) -> Distance -> Placer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Distance -> Placer
horizontalP'
    in Placer -> F a b -> F a b
forall a b. Placer -> F a b -> F a b
placerF (Distance -> Placer
placer Distance
dist) (t -> t -> F a b
cF t
f1 t
f2)