Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import Control.Joint.Core (type (:=))
import Control.Joint.Composition (run)
import Control.Joint.Transformer (build, embed, type (:>))
import Control.Joint.Base.State (State, get, put, modify)
data Shape = Opened | Closed
deriving (Eq, Show)
data Style = Round | Square | Angle | Curly
deriving (Eq, Show)
data Symbol = Nevermind | Bracket Style Shape
deriving Show
data Stumble
-- Closed bracket without opened one
= Deadend (Int, Style)
-- Opened bracket without closed one
| Logjam (Int, Style)
-- Closed bracket doesn't match opened one
| Mismatch (Int, Style) (Int, Style)
deriving Show
checking :: [(Int, Symbol)] -> Either Stumble ()
checking struct = run (traverse proceed struct) [] >>= \case
(s : _, _) -> Left . Logjam $ s where
([], _) -> Right ()
proceed :: (Int, Symbol) -> State [(Int, Style)] :> Either Stumble := ()
proceed (_, Nevermind) = pure ()
proceed (n, Bracket style Opened) = build . modify . (:) $ (n, style)
procceed (n, Bracket closed Closed) = build get >>= \case
[] -> embed $ Left . Deadend $ (n, closed)
((m, opened) : ss) -> if closed /= opened
then embed mismatch else build $ put ss where
mismatch :: Either Stumble ()
mismatch = Left $ Mismatch (m, opened) (n, closed)
indexing :: [Symbol] -> [(Int, Symbol)]
indexing ss = zip [1..] ss
example_ok, example_mismatch, example_deadend, example_logjam :: [Symbol]
example_ok = Bracket Curly Opened : Nevermind : Bracket Curly Closed : [] -- {x}
example_mismatch = Bracket Curly Opened : Bracket Square Closed : [] -- {]
example_deadend = Bracket Round Closed : [] -- )
example_logjam = Bracket Angle Opened : [] -- <
main = either print print . checking . indexing $ example_logjam
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.