Проверка правильности расстановки скобок в строке

pCheck' :: String -> Int -> Bool
pCheck' "" n = (n==0)
pCheck' (s:ss) n | (s == '(') = pCheck' ss (n+1)
                 | (s == ')') && (n==0) = False
                 | (s == ')') = pCheck' ss (n-1)
                 | otherwise = pCheck' ss n
                 
pCheck :: String -> Bool
pCheck s = pCheck' s 0

bracketsCheck:: String -> Bool
bracketsCheck = go 0
  where go i [] = i == 0
        go i ('(':xs) = go (i+1) xs
        go i (')':xs)
            | i == 0 = False
            | otherwise = go (i-1) xs
        go i (_:xs) = go i xs

bracketsCheck:: String -> Bool
bracketsCheck = go 0
  where go i [] = i == 0
        go i ('(':xs) = go (i+1) xs
        go 0 (')':xs) = False
        go i (')':xs) = go (i-1) xs
        go i (_:xs) = go i xs

test = 0==sum $ map (\x -> (if x=='(' then 1 else if x==')' then (-1) else 0))

test s = 0==foldl (\a x -> if a<0 then minBound::Int else if x=='(' then a+1 else if x==')' then a-1 else a) 0

Prelude> let test s = 0==sum (map (\x -> (if x=='(' then 1 else if x==')' then (-1) else 0)) s)
Prelude> test ")("
True
Prelude>

pCheck'' :: String -> String -> Bool
pCheck'' "" [] = True
pCheck'' "" _  = False
pCheck'' (s:ss) q | (s == '(') = pCheck'' ss ('(' : q)
                  | (s == '[') = pCheck'' ss ('[' : q)
                  | (s == '{') = pCheck'' ss ('{' : q)
                  | (s == ')') && (q == []) = False
                  | (s == ']') && (q == []) = False
                  | (s == '}') && (q == []) = False
                  | (s == ')') = if (head q)=='(' then pCheck'' ss $ tail q else False
                  | (s == ']') = if (head q)=='[' then pCheck'' ss $ tail q else False
                  | (s == '}') = if (head q)=='{' then pCheck'' ss $ tail q else False
                  | otherwise = pCheck'' ss q
                  
pCheck :: String -> Bool
pCheck s = pCheck'' s ""

forward  = [('(',')'),('[',']'),('{','}')]
backward = map (\(a,b) -> (b,a)) forward 
loop acc [] = null acc
loop acc (sym:tail)
    | Just _ <- lookup sym forward = loop (sym:acc) tail
    | (Just c, c':acc') <- (lookup sym backward, acc) = (c == c') && loop acc' tail
    | Just c <- lookup sym backward = False
    | otherwise = loop acc tail
 
check = loop []

forward  = [('(',')'),('[',']'),('{','}')]
backward = map (\(a,b) -> (b,a)) forward 
loop sym stack
    | Just _ <- lookup sym forward = Just (sym:stack)
    | (Just c, c':stack') <- (lookup sym backward, stack), c == c' = Just stack'
    | Just c <- lookup sym backward = Nothing
    | otherwise = Just stack
 
check line = foldl (\a s -> a >>= (loop s)) (Just []) line == Just []

import Data.Text as T
 
test s = txr $ T.filter (flip elem "()[]{}").T.pack $ s where
    txr t = let re sr = T.replace (T.pack sr) (T.pack "")
                t' = re "()".re "[]".re "{}" $ t
                lt' = T.length t' in case lt' of
        0 -> True
        _|(lt' == T.length t) -> False
        _ -> txr t'

import Data.Maybe(isJust)
 
bracketsCheck:: String -> Bool
bracketsCheck = isJust . (go Nothing)
  where go Nothing [] = Just []
        go _       [] = Nothing 
        go c ('(':sx) = br c (Just ')') sx
        go c ('[':sx) = br c (Just ']') sx
        go c ('{':sx) = br c (Just '}') sx
        go c (s:sx) 
            | c == (Just s) = Just sx
            | s `elem` ")]}" = Nothing
            | otherwise = go c sx
        br o n sx = case go n sx of
                      (Just s) -> go o s
                      Nothing  -> Nothing

test s = txr $ filter (flip elem "()[]{}") s where
    txr s = let re _ []  = []
                re _ [c] = [c]
                re r (c1:c2:cs) = if [c1,c2]==r then re r cs else (c1:(re r (c2:cs)))
                s' = re "()".re "[]".re "{}" $ s
                ls' = length s'
        in case ls' of
            0 -> True
            _|(ls' == length s) -> False
            _ -> txr s'

open FParsec
 
let body, bodyImpl = createParserForwardedToRef ()
let innerbody = many1 (noneOf "([{)]}")
let bracker (b : string) = pchar b.[0] >>. (body |>> (List.collect id)) .>> pchar b.[1]
let brack     = bracker "()" <|> bracker "[]" <|> bracker "{}"
do bodyImpl  := many (brack <|> innerbody)
 
do
    let test x = 
        match run (body .>> eof) x with
        | Success (r,_,_) -> printfn "%A\t%A" x r
        | Failure (a,b,c) -> printfn "%A\t--- > Fail at %A" x b.Position
    test "()"       // "()"    [[]]
    test "a(a)a"    // "a(a)a" [['a']; ['a']; ['a']]
    test "a(a]a"    // "a(a]a" --- > Fail at (Ln: 1, Col: 4)
    test "(o)"      // "(o)"   [['o']]
    test "(("       // "(("    --- > Fail at (Ln: 1, Col: 3)
    test "))"       // "))"    --- > Fail at (Ln: 1, Col: 1)
    test "a)a(a"    // "a)a(a" --- > Fail at (Ln: 1, Col: 2)

import Text.ParserCombinators.Parsec
import Data.Either(isRight)
 
innerbody = many1 (noneOf "([{)]}") 
 
bracker [l,r] = char l >> bodyImpl >> char r >> return ""
 
brack = bracker "()" <|> bracker "[]" <|> bracker "{}"
 
bodyImpl  = many (brack <|> innerbody)
 
test:: String -> Bool  
test = isRight . parse (bodyImpl >> eof) ""

pCheck' :: String -> Int -> Bool   --  задаем тип вспомогательной функции
pCheck' "" n = (n==0)                 -- определяем ее значение при первом параметре, равном ""
-- определяем ее значение или параметры (! если осуществляем рекурсивный вызов)
-- в остальных случаях по условиям
pCheck' (s:ss) n | (s == '(') = pCheck' ss (n+1) -- рекурсивный вызов с хвостом строки и измененным параметром
                       | (s == ')') && (n==0) = False -- сразу возвращаем фалс не разбирая дальше строку
                       | (s == ')') = pCheck' ss (n-1) -- рекурсивный вызов с хвостом строки и измененным параметром
                       | otherwise = pCheck' ss n -- рекурсивный вызов с хвостом строки и неизмененным параметром
pCheck :: String -> Bool -- задаем тип основной функции
pCheck s = pCheck' s 0  -- вызываем вспомогательную функцию

pCheck' :: String -> Int -> Bool
pCheck' str n = if str == "" then (n == 0) else
    if s == '(' then pCheck' ss (n+1) else
    if s == ')' && (n==0) then False else
    if s == ')' then pCheck' ss (n-1)
    else pCheck' ss n
    where
        ss = tail str
        s = head str
pCheck :: String -> Bool -- задаем тип основной функции
pCheck s = pCheck' s 0  -- вызываем вспомогательную функцию