Free monad in Haskell, toying with Tic-Tac-Toe

Tictactoe_Free_monad.hs

{-# LANGUAGE DeriveFunctor #-}

import System.Random
import Data.List
import Data.String
import System.Console.ANSI
import Control.Monad.Free
import Prelude

initState = ["0", "1", "2", "3", "4", "5", "6", "7", "8" ]
winners = [[0,1,2], [3,4,5], [6,7,8],[0,3,6], [1,4,7], [2,5,8],[0,4,8], [2,4,6] ]

data Console next = WriteLine String next
                   | ShowMyBoard String next
                   | HumanTurn [String] (([String],Int) -> next)
                   | PcTurn [String] ([String] -> next)
                   deriving (Functor)

type Program = Free Console

humanTurn ::[String]-> Program ([String],Int)
humanTurn srr = liftF ((HumanTurn srr) id)

pcTurn ::[String]-> Program [String]
pcTurn srr = liftF (PcTurn srr id)

writeLine :: String -> Program ()
writeLine string = liftF (WriteLine string ())

showMyBoard :: String -> Program ()
showMyBoard string = liftF (ShowMyBoard string ())

game::([String],Bool) -> Program ()
game (stl,whosTurn) = do
      if (whosTurn==True) then do
             vStr <- pcTurn stl
             showMyBoard $ makeBoardString vStr
             if (isGameEnd vStr) == False then do
                 writeLine "GAME END PC wins"
                 return ()
             else game (vStr,False)
      else do
        showMyBoard $ makeBoardString stl
        (vStr,intPos) <- humanTurn stl
        if (intPos < 0 || intPos > 8)
            then do
               writeLine "Game has been stopped"
               return ()
        else
         if (isGameEnd vStr) == False then do
              showMyBoard $ makeBoardString vStr
              writeLine "GAME END Human wins"
              return ()
         else do
           writeLine $ makeBoardString vStr
           game (vStr,True)

interpret :: Program a -> IO a
interpret (Pure res)     = return res
interpret (Free program) = case program of
    WriteLine string next ->  putStrLn string >> interpret next
    ShowMyBoard string next -> clearScreen >> setCursorPosition 0 0 >> putStrLn string >> interpret next
    HumanTurn arr next -> makeHumanTurn arr >>= interpret . next
    PcTurn arr next -> makeMachineTurn arr >>= interpret . next

makeBoardString :: [String]->String
makeBoardString myBoard = res
  where
   empty = "   " ; vLine = "  |  " ;  hLine = "\n-------------------\n"
   rows = map (\x->empty ++ ( intercalate vLine $  take 3 $ drop x myBoard)) [0,3,6]
   res = (rows !!0) ++ hLine ++ (rows !!1) ++ hLine ++ (rows !!2) ++ "\n\n"

changeListElemByIndex::[String]->String->Int->[String]
changeListElemByIndex lst stVal index = take index lst ++ [stVal] ++ drop (index + 1) lst

machineTurn ::[String] -> IO Int
machineTurn myBoard = do
   let leng = length $ filter (\q-> q /= "X" && q /= "@") myBoard
   let zipped = filter (\(p,q) -> q /= "X" && q /= "@") $ zip [0..] myBoard
   if leng == 1 then return (fst $ zipped !! 0)
   else do
    randomIndex <- randomRIO (0, (length zipped)-1):: IO Int
    let boardElemIndex = fst $ zipped !! randomIndex
    if (myBoard!! 4 /="X" &&(myBoard!! 4 /="@")) then return 4 else return boardElemIndex

makeHumanTurn::[String] -> IO ([String],Int)
makeHumanTurn myBoard = do
           putStrLn "Your turn"
           myTurnPos <- getLine
           let intPos = read myTurnPos :: Int
           let vStr = changeListElemByIndex myBoard "X" intPos
           return (vStr,intPos)

makeMachineTurn::[String] -> IO [String]
makeMachineTurn myBoard = do
            intPos <- machineTurn myBoard
            let vStr = changeListElemByIndex myBoard "@" intPos
            return vStr

isGameEnd :: [String] -> Bool
isGameEnd strArr = flag
    where
     allTheSame xs = all (== head xs) (tail xs)
     isMyLineFilled= \iArr strArr  -> allTheSame (map (\x->strArr !! x) ( map (\d-> iArr !! d ) [0..2]))
     filledLinesList = filter (\xc-> xc == True) (map (\x -> isMyLineFilled x strArr ) winners)
     flag = if (length filledLinesList == 0) then True else False

main :: IO ()
main = do
   interpret (game (initState,False))