{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BlockArguments #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Main1 (main) where

import Data.List
import Control.Applicative

main :: IO ()
main = putStrLn "hello"

newtype Parser a = Parser
  { runParser :: String -> Maybe (a, String)
  }
  
string t = Parser \s ->
  case stripPrefix t s of
    Just rest -> Just (t, rest)
    Nothing -> Nothing
    
parseNull = string "null"
parseTrue1 = string "true"
parseFalse1 = string "false"
parseComma = string ","

-- >>> runParser parseNull "null"
-- Just ("null","")

-- >>> runParser parseNull "null,"
-- Just ("null",",")

combine pa pb = Parser \s ->
  case runParser pa s of
    Nothing -> Nothing
    Just (vala, resta) ->
      case runParser pb resta of
        Nothing -> Nothing
        Just (valb, restb) ->
          Just ((vala, valb), restb)


alt pa pb = Parser \s ->
  case runParser pa s of
    Just output -> Just output
    Nothing -> runParser pb s

parseBool' = alt parseTrue parseFalse

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
  fmap f p = Parser \s ->
    case runParser p s of
      Just (x, rest) -> Just (f x, rest)
      Nothing -> Nothing
      
parseTrue, parseFalse, parseBool :: Parser Bool
parseTrue = fmap (\_ -> True) $ string "true"
parseFalse = fmap (\_ -> False) $ string "false"
parseBool = alt parseTrue parseFalse

-- >>> runParser parseBool "true123"
-- Just (True,"123")

-- bunday yozsa ham bo'ladi:
parseTrue' = True <$ string "true"

-- shunchaki combine qilsa Parser (Bool, ()) bo'lib qoladi
parseBoolComma = fmap fst $ combine parseBool parseComma

-- >>> runParser (combine parseBool parseBool) "truefalse"
-- Just ((True,False),"")

instance Applicative Parser where
  -- doim muvaffaqiyatli natija qaytaradigan parser
  pure :: a -> Parser a
  pure x = Parser \s -> Just (x, s)
  
  liftA2 :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
  liftA2 f pa pb = fmap (\(a, b) -> f a b) $ combine pa pb

parseNullComma = liftA2 (\_ _ -> ()) parseNull parseComma

many' p =
  alt
    (liftA2 (:) p $ many' p)
    (pure [])
some' p =
  liftA2 (:) p $
    alt
      (some' p)
      (pure [])

instance Alternative Parser where
  -- doim muvaffaqiyatsiz qaytadigan parser
  empty = Parser \_ -> Nothing
  
  (<|>) = alt

-- >>> runParser (many parseBoolComma) "true,false,false,123"
-- Just ([True,False,False],"123")

charP :: (Char -> Bool) -> Parser Char
charP f = Parser \case
  [] -> Nothing
  (c : rest) | f c -> Just (c, rest)
  _ -> Nothing

-- convention bo'yicha sc deb nomlanadi
sc = many $ charP \c -> c `elem` " \n\r\t"

-- p ni ishga tushiradi va orqasidan barcha whitespaceni olib tashlaydi
lexeme :: Parser a -> Parser a
lexeme p = liftA2 (\a b -> a) p sc

symbol = lexeme . string

parseBoolComma2 = liftA2 (\x _ -> x) (lexeme parseBool) (lexeme parseComma)

lexeme' p = p <* sc
parseBoolComma3 = lexeme parseBool <* lexeme parseComma

-- >>> runParser parseBoolComma3 "true ,  false, true,"
-- Just (True,"false, true,")

data Ast = Atom String | Cell [Ast]
  deriving (Show)

parseAlpha = charP \c -> 'a' <= c && c <= 'z' || 'A' <= c && c <= 'Z'

parseAtom = do
  name <- lexeme $ some parseAlpha
  pure $ Atom name

parseCell = do
  symbol "("
  body <- many parseAst
  symbol ")"
  pure $ Cell body

parseAst = parseAtom <|> parseCell

-- >>> runParser parseAst "(a b (c d))"
-- Just (Cell [Atom "a",Atom "b",Cell [Atom "c",Atom "d"]],"")

parseAtom' = Atom <$> lexeme (many parseAlpha)
parseCell' = Cell <$> (symbol "(" *> many parseAst <* symbol ")")
parseAst' = parseAtom <|> parseCell

data Lv
  = Var String
  | LInt Int
  | Add Lv Lv
  | Sub Lv Lv
  | Mul Lv Lv
  | Let String Lv Lv
  deriving (Show)

parseLv =
  parseVar
  <|> parseLInt
  <|> parseAdd
  <|> parseSub
  <|> parseMul
  <|> parseLet

parseVar = Var <$> lexeme (some parseAlpha)

parseDigit = charP \c -> '0' <= c && c <= '9'
parseLInt = do
  digits <- lexeme $ some parseDigit
  pure $ LInt $ read digits

-- >>> runParser parseLInt "123"
-- Just (LInt 123,"")

option x p = p <|> pure x
parseSignedInt :: Parser Int
parseSignedInt = do
  sign <- option "" (string "-")
  digits <- some parseDigit
  pure $ read $ sign ++ digits

-- >>> runParser parseSignedInt "-123"
-- Just (-123,"")

parseBinary op f = do
  symbol "("
  symbol op
  lhs <- parseLv
  rhs <- parseLv
  symbol ")"
  pure $ f lhs rhs

parseAdd = parseBinary "+" Add
parseSub = parseBinary "-" Sub
parseMul = parseBinary "*" Mul

parseLet = do
  symbol "("
  symbol "let"
  symbol "["
  name <- lexeme $ some parseAlpha
  value <- parseLv
  symbol "]"
  body <- parseLv
  symbol ")"
  pure $ Let name value body

parseLet' = 
  Let
    <$> (symbol "(" *> symbol "let" *> symbol "[" *> lexeme (some parseAlpha))
    <*> parseLv
    <*> (symbol "]" *> parseLv <* symbol ")")

-- >>> s = "(let [x (+ 1 2)] (let [y x] (- x y)))"
-- >>> runParser parseLv s
-- Just (Let "x" (Add (LInt 1) (LInt 2)) (Let "y" (Var "x") (Sub (Var "x") (Var "y"))),"")

-- bu bugmi yoki featuremi hali qaror qilmadim
-- >>> runParser parseLv "(+1x)"
-- Just (Add (LInt 1) (Var "x"),"")


pBacktracks = p1 <|> p2
 where
  p1 = string "a" *> string "b"
  p2 = string "a" *> string "a"

-- >>> runParser pBacktracks "aa"
-- Just ("a","")