{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QualifiedDo #-}
{-# OPTIONS_GHC -Wno-x-partial #-}

module Test.Simple.Combinators where

import Control.Additive ((<|>))
import Control.Monad
import Control.Monad.Indexed ((<*))
import Control.Monad.Indexed qualified as Indexed
import Control.Monad.Indexed.Cont2 qualified as Cont2
import Data.Char qualified as Char
import Test.Simple.Parse (Parse (..))
import Test.Simple.Parse qualified as Parse
import Test.Simple.Print (Print)
import Test.Simple.Print qualified as Print
import Prelude hiding (Applicative (..), Monad (..))

type PUP = Print Indexed.:*: Indexed.IgnoreIndices Parse

parse :: PUP r r' a -> String -> Maybe (a, String)
parse (_ Indexed.:*: Indexed.IgnoreIndices prse) = Parse.runParse prse

print :: PUP (a -> Maybe String) (Maybe String) b -> a -> Maybe String
print (prnt Indexed.:*: _) = Print.print prnt

once :: (r -> r') -> PUP r r' a -> PUP r r' a
once unr (prnt Indexed.:*: Indexed.IgnoreIndices prse) = (Print.once unr prnt) Indexed.:*: Indexed.IgnoreIndices prse

anyChar :: PUP (Char -> r) r Char
anyChar = Print.anyChar Indexed.:*: Indexed.IgnoreIndices Parse.anyChar

char :: Char -> PUP r r ()
char c = Indexed.do
  c' <- anyChar Cont2.@ c
  guard $ c == c'

space :: PUP r r ()
space = char ' '

string :: String -> PUP r r ()
string = mapM_ char

digit :: PUP (Int -> r) r Int
digit = Indexed.do
  Cont2.stack (\_fl k i -> k (head (show i))) (\k _ -> k 0)
  c <- anyChar
  guard $ Char.isDigit c
  Indexed.pure $ read [c]

int :: PUP (Int -> r) r Int
int = Indexed.do
  Cont2.stack digitise (\k -> k . head)
  undigitise <$> Cont2.some digit
  where
    digitise _fl k n = k (digitise' n)
    digitise' n
      | n < 10 = [n]
      | otherwise = let (q, r) = quotRem n 10 in (digitise' q) ++ [r]
    undigitise = foldl (\n d -> 10 * n + d) 0

bool :: PUP (Bool -> r) r Bool
bool =
  trueLead <* string "True"
    <|> falseLead <* string "False"
  where
    trueLead = Indexed.do
      Cont2.stack (\cases _ k True -> k; fl _ b -> fl b) (\k -> k True)
      Indexed.pure True

    falseLead = Indexed.do
      Cont2.stack (\cases _ k False -> k; fl _ b -> fl b) (\k -> k False)
      Indexed.pure False