module RubikLogic where 

data Rubik a
 = Rubik (Front a) (Top a) (Back a) (Bottom a) (Left a) (Right a)

type Front a  = Area a
type Top a    = Area a
type Back a   = Area a
type Bottom a = Area a
type Left a   = Area a
type Right a  = Area a

type Area a = [Row a]
type Row a  = [a]

data AreaPosition =  Front |Top| Back| Bottom| Left| Right

data RubikColor = Red|Blue|Yellow|Green|Orange|White|Black
instance Functor Rubik where
  fmap f (Rubik front top back bottom left right) 
    = Rubik (mf front) (mf top) (mf back) 
            (mf bottom) (mf left) (mf right)
   where
     mf = map (map f)
initCube  = Rubik (area Red)  (area Blue)  (area Yellow)
                  (area Green)(area Orange)(area White)

area c  = [[c,c,c],[c,c,c],[c,c,c]]
rotateArea RubikLogic.Front 
 (Rubik front top back bottom left right) =   
  Rubik front' top' back bottom' left' right'
   where 
     top'    = newRow 3 (reverse$column 3 left) top 
     bottom' = newRow 1 (reverse$column 1 right) bottom 
     left'   = newColumn 3 (row 1 bottom) left
     right'  = newColumn 1 (row 3 top) right
     front'  = rotateBy3 front

rotateArea RubikLogic.Back
 (Rubik front top back bottom left right) =   
   Rubik front' top' back' bottom' 
         (rotateBy2 left') (rotateBy2 right')
   where
    (Rubik back' bottom' front' top' left' right') =
      rotateArea RubikLogic.Front 
       (Rubik back bottom front top 
              (rotateBy2 left) (rotateBy2 right))

rotateArea RubikLogic.Bottom
 (Rubik front top back bottom left right) =   
  Rubik front' top back' bottom' left' right'
   where 
     back'   = newRow 1 (reverse$row 3 left) back 
     front'  = newRow 3 (row 3 right) front 
     left'   = newRow 3 (row 3 front) left
     right'  = newRow 3 (reverse$row 1 back) right
     bottom'  = rotateBy1 bottom


rotateArea RubikLogic.Top
 (Rubik front top back bottom left right) =   
  Rubik front' top' back' bottom left' right'
   where 
     back'   = newRow 3 (reverse$row 1 right) back 
     front'  = newRow 1 (row 1 left) front 
     left'   = newRow 1 (reverse$row 3 back) left
     right'  = newRow 1 (row 1 front) right
     top'  = rotateBy1 top

rotateArea RubikLogic.Left 
 (Rubik front top back bottom left right) =   
  Rubik front' top' back' bottom' left' right
   where 
     top'    = newColumn 1 (column 1 front) top 
     bottom' = newColumn 1 (column 1 back) bottom  
     left'   = rotateBy3 left
     back'   = newColumn 1 (column 1 top) back  
     front'  = newColumn 1 (column 1 bottom) front 

rotateArea RubikLogic.Right 
 (Rubik front top back bottom left right) =   
  Rubik front' top' back' bottom' left right'
   where 
     top'    = newColumn 3 (column 3 back) top 
     bottom' = newColumn 3 (column 3 front) bottom  
     right'  = rotateBy3 right
     back'   = newColumn 3 (column 3 bottom) back  
     front'  = newColumn 3 (column 3 top) front 

rotateBy1
  [[x1,x2,x3]
  ,[x8,x,x4]
  ,[x7,x6,x5]] =
  [[x3,x4,x5]
  ,[x2,x,x6]
  ,[x1,x8,x7]]

rotateBy2 =  rotateBy1 .rotateBy1
rotateBy3 =  rotateBy2 .rotateBy1
column n  = map (\row->row !! (n-1))

row n area = area !!(n-1)

newRow 1 row [a,r,ea] = [row,r,ea]
newRow 2 row [a,r,ea] = [a,row,ea]
newRow 3 row [a,r,ea] = [a,r,row]
 
newColumn n column area = map (doIt n) areaC
  where
    areaC =  zip area column
    doIt 1 ((r:ow),c) = c:ow 
    doIt 2 ((r:o:w),c) = r:c:w 
    doIt 3 ((r:o:w:xs),c) = r:o:c:xs