module AlignP where
--import Alignment(Alignment(..))
--import Geometry(Line(..), Point(..), Rect(..), Size(..), padd, psub, rR)
--import LayoutDir(LayoutDir)
import LayoutRequest
import Utils(mapPair, number, swap)
import HbcUtils(apSnd)
import List2(sort)
--import Spacers

-- placer operations

idP :: Placer
idP :: Placer
idP = Placer1 -> Placer
P (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest
req] -> (LayoutRequest
req, (Rect -> [Rect] -> [Rect]
forall a. a -> [a] -> [a]
: []))

--revP :: Placer -> Placer
revP :: Placer -> Placer
revP = (Placer1 -> Placer1) -> Placer -> Placer
mapP Placer1 -> Placer1
forall a a a a. ([a] -> (a, a -> [a])) -> [a] -> (a, a -> [a])
revP'
  where revP' :: ([a] -> (a, a -> [a])) -> [a] -> (a, a -> [a])
revP' [a] -> (a, a -> [a])
placer = ((a -> [a]) -> a -> [a]) -> (a, a -> [a]) -> (a, a -> [a])
forall t b a. (t -> b) -> (a, t) -> (a, b)
apSnd ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a, a -> [a]) -> (a, a -> [a]))
-> ([a] -> (a, a -> [a])) -> [a] -> (a, a -> [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> (a, a -> [a])
placer ([a] -> (a, a -> [a])) -> ([a] -> [a]) -> [a] -> (a, a -> [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

mapP :: (Placer1 -> Placer1) -> Placer -> Placer
mapP Placer1 -> Placer1
f (P Placer1
p) = Placer1 -> Placer
P (Placer1 -> Placer1
f Placer1
p)

flipP :: Placer -> Placer
flipP :: Placer -> Placer
flipP = (Placer1 -> Placer1) -> Placer -> Placer
mapP Placer1 -> Placer1
flipP'
  where
    flipP' :: Placer1 -> Placer1
flipP' Placer1
placer = (LayoutRequest -> LayoutRequest,
 (Rect -> [Rect]) -> Rect -> [Rect])
-> (LayoutRequest, Rect -> [Rect])
-> (LayoutRequest, Rect -> [Rect])
forall t1 a t2 b. (t1 -> a, t2 -> b) -> (t1, t2) -> (a, b)
mapPair (LayoutRequest -> LayoutRequest
flipReq,(Rect -> [Rect]) -> Rect -> [Rect]
flipP2) ((LayoutRequest, Rect -> [Rect])
 -> (LayoutRequest, Rect -> [Rect]))
-> Placer1 -> Placer1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Placer1
placer Placer1 -> ([LayoutRequest] -> [LayoutRequest]) -> Placer1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> LayoutRequest)
-> [LayoutRequest] -> [LayoutRequest]
forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> LayoutRequest
flipReq
    flipP2 :: (Rect -> [Rect]) -> Rect -> [Rect]
flipP2 Rect -> [Rect]
p2 = (Rect -> Rect) -> [Rect] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
map Rect -> Rect
flipRect([Rect] -> [Rect]) -> (Rect -> [Rect]) -> Rect -> [Rect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> [Rect]
p2(Rect -> [Rect]) -> (Rect -> Rect) -> Rect -> [Rect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> Rect
flipRect

permuteP :: [Int] -> Placer -> Placer
permuteP :: [Int] -> Placer -> Placer
permuteP [Int]
perm = (Placer1 -> Placer1) -> Placer -> Placer
mapP Placer1 -> Placer1
forall a a a a. ([a] -> (a, a -> [a])) -> [a] -> (a, a -> [a])
permuteP'
  where
    permuteP' :: ([b] -> (a, a -> [b])) -> [b] -> (a, a -> [b])
permuteP' [b] -> (a, a -> [b])
placer = ((a -> [b]) -> a -> [b]) -> (a, a -> [b]) -> (a, a -> [b])
forall t b a. (t -> b) -> (a, t) -> (a, b)
apSnd ([b] -> [b]
forall a. [a] -> [a]
rpermf ([b] -> [b]) -> (a -> [b]) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a, a -> [b]) -> (a, a -> [b]))
-> ([b] -> (a, a -> [b])) -> [b] -> (a, a -> [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> (a, a -> [b])
placer ([b] -> (a, a -> [b])) -> ([b] -> [b]) -> [b] -> (a, a -> [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> [b]
forall a. [a] -> [a]
fpermf
    rperm :: [Int]
rperm = (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)] -> [Int])
-> ([Int] -> [(Int, Int)]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> [(Int, Int)]
forall a. Ord a => [a] -> [a]
sort ([(Int, Int)] -> [(Int, Int)])
-> ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> (Int, Int)
forall b a. (b, a) -> (a, b)
swap ([(Int, Int)] -> [(Int, Int)])
-> ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [(Int, Int)]
forall a. Int -> [a] -> [(Int, a)]
number Int
0) [Int]
perm
    fpermf :: [b] -> [b]
fpermf = [Int] -> [b] -> [b]
forall b. [Int] -> [b] -> [b]
permf [Int]
perm
    rpermf :: [b] -> [b]
rpermf = [Int] -> [b] -> [b]
forall b. [Int] -> [b] -> [b]
permf [Int]
rperm
    permf :: [Int] -> [b] -> [b]
permf [Int]
perm [b]
xs = (Int -> b) -> [Int] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ([b]
xs[b] -> Int -> b
forall a. [a] -> Int -> a
!!) [Int]
perm