brackets.hs

import Control.Applicative
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Lazy
import Data.Bool
import Data.Function
import Data.Peano
import Control.Monad
import Control.Comonad
import Control.Comonad.Cofree

data Shape = Opened | Closed deriving Eq
data Style = Round | Square | Angle | Curly deriving Eq
data Symbol = Bracket Style Shape | Character

instance Show Symbol where
	show Character = "_"
	show (Bracket Round Opened) = "("
	show (Bracket Round Closed) = ")"
	show (Bracket Square Opened) = "["
	show (Bracket Square Closed) = "]"
	show (Bracket Angle Opened) = "<"
	show (Bracket Angle Closed) = ">"
	show (Bracket Curly Opened) = "{"
	show (Bracket Curly Closed) = "}"

recognize :: Char -> Symbol
recognize '(' = Bracket Round Opened
recognize ')' = Bracket Round Closed
recognize '[' = Bracket Square Opened
recognize ']' = Bracket Square Closed
recognize '<' = Bracket Angle Opened
recognize '>' = Bracket Angle Closed
recognize '{' = Bracket Curly Opened
recognize '}' = Bracket Curly Closed
recognize char = Character

data Stumble
	= Deadend (Indexed Style) -- Closed bracket without opened one
	| Logjam (Indexed Style) -- Opened bracket without closed one
	| Mismatch (Indexed Style) (Indexed Style) -- Closing bracket doesn't match opened one

instance Show Stumble where
	show (Deadend (Indexed n closed)) = "Unexpectedly closed: " <>
		"#" <> show (fromEnum n) <> " " <> show (Bracket closed Closed)
	show (Logjam (Indexed n closed)) = "Unexpectedly opened: " <>
		"#" <> show (fromEnum n) <> " " <> show (Bracket closed Opened)
	show (Mismatch (Indexed n opened) (Indexed m closed)) = "Mismatching brackets: " <>
		"#" <> show (fromEnum n) <> " " <> show (Bracket opened Opened) <> " and " <>
		"#" <> show (fromEnum m) <> " " <> show (Bracket closed Closed)

-----------------------------------------------------------------------------------------------------------

data Indexed a = Indexed Peano a deriving Show

index :: a -> State Peano (Indexed a)
index x = modify succ *> (flip Indexed x <$> get) where

-----------------------------------------------------------------------------------------------------------

type Stack a = Maybe (Cofree Maybe a)

push :: a -> Stack a -> Stack a
push x stack = ((:<) x . Just <$> stack) <|> (pure . pure) x

top :: Stack a -> Maybe a
top stack = extract <$> stack

pop :: Stack a -> Stack a
pop stack = stack >>= unwrap

-----------------------------------------------------------------------------------------------------------

proceed :: Indexed Symbol -> StateT (Stack (Indexed Style)) (Either Stumble) ()
proceed (Indexed _ Character) = pure ()
proceed (Indexed n (Bracket opened Opened)) = modify (push $ Indexed n opened)
proceed (Indexed n (Bracket closed Closed)) = top <$> get >>=
	maybe (lift . Left . Deadend $ Indexed n closed) matching where

		matching :: Indexed Style -> StateT (Stack (Indexed Style)) (Either Stumble) ()
		matching (Indexed m opened) = closed == opened & bool
			(lift . Left $ Mismatch (Indexed m opened) (Indexed n closed)) (modify pop)

checking :: Traversable t => t (Indexed Symbol) -> Either Stumble ()
checking struct = (flip execStateT empty . traverse proceed $ struct)
	>>= maybe (Right ()) (Left . Logjam . extract)

preparing :: Traversable t => t Char -> t (Indexed Symbol)
preparing = flip evalState Zero . traverse (index . recognize)

example :: String
example = "(" -- Unexpectedly opened: ( at 1 position
-- example = "adr}" -- Unexpectedly closed: } at 4 position
-- example = "()[]}" -- Unexpectedly closed: } at 4 position
-- example = "([](){([])})" -- All brackets converged!
-- example = "foo(bar[i);" -- Mismatching brackets: [ at 7 and ) at 9
-- example = "{{[()]]" -- Mismatching brackets: { at 1 and ] at 6

main = print . either show (const "Converged!") . checking . preparing $ example