10 import Control.Monad => qualified join
11 import Control.Monad.RWST
12 import Control.Applicative
27 :: Coord = {x :: !Int , y :: !Int}
28 :: Move = {c :: !Coord, d :: !Direction}
29 :: PegBoard :== {#{#Position}}
33 {{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
34 ,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
35 ,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
36 ,{Peg, Peg, Peg, Emp, Peg, Peg, Peg}
37 ,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
38 ,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
39 ,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
44 {{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
45 ,{Inv, Peg, Peg, Peg, Peg, Peg, Inv}
46 ,{Peg, Peg, Peg, Emp, Peg, Peg, Peg}
47 ,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
48 ,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
49 ,{Inv, Peg, Peg, Peg, Peg, Peg, Inv}
50 ,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
55 {{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
56 ,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
57 ,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
58 ,{Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg}
59 ,{Peg, Peg, Peg, Peg, Emp, Peg, Peg, Peg, Peg}
60 ,{Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg}
61 ,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
62 ,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
63 ,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
68 {{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
69 ,{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
70 ,{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
71 ,{Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg}
72 ,{Peg, Peg, Peg, Emp, Peg, Peg, Peg, Peg}
73 ,{Peg, Peg, Peg, Peg, Peg, Peg, Peg, Peg}
74 ,{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
75 ,{Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
80 {{Inv, Inv, Inv, Inv, Peg, Inv, Inv, Inv, Inv}
81 ,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
82 ,{Inv, Inv, Peg, Peg, Peg, Peg, Peg, Inv, Inv}
83 ,{Inv, Peg, Peg, Peg, Peg, Peg, Peg, Peg, Inv}
84 ,{Peg, Peg, Peg, Peg, Emp, Peg, Peg, Peg, Peg}
85 ,{Inv, Peg, Peg, Peg, Peg, Peg, Peg, Peg, Inv}
86 ,{Inv, Inv, Peg, Peg, Peg, Peg, Peg, Inv, Inv}
87 ,{Inv, Inv, Inv, Peg, Peg, Peg, Inv, Inv, Inv}
88 ,{Inv, Inv, Inv, Inv, Peg, Inv, Inv, Inv, Inv}
91 getPos :: !Coord !.PegBoard -> Maybe Position
92 getPos {x,y} b = if (valid b) Nothing (Just (b.[y].[x]))
94 valid b = y<0 || x<0 || y >= size b || x >= size b.[0] || b.[y].[x] == Inv
96 move :: !PegBoard !Move -> Maybe PegBoard
97 move b {c=cc=:{x=tx,y=ty}, d}
98 # sc=:{x=sx,y=sy} = transform cc d
99 # fc=:{x=fx,y=fy} = transform sc d
100 = case getPos fc b of
101 Just Peg = case getPos sc b of
102 Just Peg = case getPos cc b of
103 Just Emp = Just {{{c\\c<-:r}\\r<-:b} & [fy,fx]=Emp, [sy,sx]=Emp, [ty,tx]=Peg}
108 transform :: !Coord !Direction -> Coord
109 transform c=:{x,y} d = case d of
115 getCoords :: (Char -> Bool) !PegBoard -> [Coord]
116 getCoords f b = [{x=x,y=y}\\r<-:b & y<-[0..] , c<-:r & x<-[0..] | f c]
118 printPegBoard :: !PegBoard -> String
119 printPegBoard b = join "\n" (["\n":[r\\r <-: b]] ++ ["\n"])
121 solve :: !PegBoard -> Maybe [PegBoard]
123 | 1 == length (getCoords ((==)Peg) b) = pure [b]
124 = (\xs->[b:xs]) <$> foldr (<|>) empty [move b m >>= solve\\m<-moves]
126 moves = [{c=c,d=d}\\c<-getCoords ((==)Emp) b, d<-[N,E,S,W]]
128 //Start = [map printPegBoard <$> solve b\\b<-[english,german,french,bell, diamond]]
129 Start = map printPegBoard <$> solve english