{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-}

-- Most of this module follows the Haskell report, https://www.haskell.org/onlinereport/lexemes.html
module Paren(Paren(..), parens, unparens) where

import Data.Tuple.Extra
import Lexer(Lexeme(..))

-- | A list of items which are paranthesised.
data Paren a
    = Item a -- Indiviaaul item
    | Paren a [Paren a] a -- parenthesise, open, inner, close
    deriving (Int -> Paren a -> ShowS
[Paren a] -> ShowS
Paren a -> String
(Int -> Paren a -> ShowS)
-> (Paren a -> String) -> ([Paren a] -> ShowS) -> Show (Paren a)
forall a. Show a => Int -> Paren a -> ShowS
forall a. Show a => [Paren a] -> ShowS
forall a. Show a => Paren a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Paren a] -> ShowS
$cshowList :: forall a. Show a => [Paren a] -> ShowS
show :: Paren a -> String
$cshow :: forall a. Show a => Paren a -> String
showsPrec :: Int -> Paren a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Paren a -> ShowS
Show,Paren a -> Paren a -> Bool
(Paren a -> Paren a -> Bool)
-> (Paren a -> Paren a -> Bool) -> Eq (Paren a)
forall a. Eq a => Paren a -> Paren a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Paren a -> Paren a -> Bool
$c/= :: forall a. Eq a => Paren a -> Paren a -> Bool
== :: Paren a -> Paren a -> Bool
$c== :: forall a. Eq a => Paren a -> Paren a -> Bool
Eq,a -> Paren b -> Paren a
(a -> b) -> Paren a -> Paren b
(forall a b. (a -> b) -> Paren a -> Paren b)
-> (forall a b. a -> Paren b -> Paren a) -> Functor Paren
forall a b. a -> Paren b -> Paren a
forall a b. (a -> b) -> Paren a -> Paren b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Paren b -> Paren a
$c<$ :: forall a b. a -> Paren b -> Paren a
fmap :: (a -> b) -> Paren a -> Paren b
$cfmap :: forall a b. (a -> b) -> Paren a -> Paren b
Functor)

parenOn :: forall a b . Eq b => (a -> b) -> [(b, b)] -> [a] -> [Paren a]
parenOn :: (a -> b) -> [(b, b)] -> [a] -> [Paren a]
parenOn a -> b
proj [(b, b)]
pairs = ([Paren a], Maybe (a, [a])) -> [Paren a]
forall a b. (a, b) -> a
fst (([Paren a], Maybe (a, [a])) -> [Paren a])
-> ([a] -> ([Paren a], Maybe (a, [a]))) -> [a] -> [Paren a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> [a] -> ([Paren a], Maybe (a, [a]))
go Maybe b
forall a. Maybe a
Nothing
    where
        -- invariant: if first argument is Nothing, second component of result will be Nothing
        go :: Maybe b -> [a] -> ([Paren a], Maybe (a, [a]))
        go :: Maybe b -> [a] -> ([Paren a], Maybe (a, [a]))
go (Just b
close) (a
x:[a]
xs) | b
close b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== a -> b
proj a
x = ([], (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a]
xs))
        go Maybe b
close (a
start:[a]
xs)
            | Just b
end <- b -> [(b, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (a -> b
proj a
start) [(b, b)]
pairs
            , ([Paren a]
inner, Maybe (a, [a])
res) <- Maybe b -> [a] -> ([Paren a], Maybe (a, [a]))
go (b -> Maybe b
forall a. a -> Maybe a
Just b
end) [a]
xs
            = case Maybe (a, [a])
res of
                Maybe (a, [a])
Nothing -> (a -> Paren a
forall a. a -> Paren a
Item a
start Paren a -> [Paren a] -> [Paren a]
forall a. a -> [a] -> [a]
: [Paren a]
inner, Maybe (a, [a])
forall a. Maybe a
Nothing)
                Just (a
end, [a]
xs) -> ([Paren a] -> [Paren a])
-> ([Paren a], Maybe (a, [a])) -> ([Paren a], Maybe (a, [a]))
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (a -> [Paren a] -> a -> Paren a
forall a. a -> [Paren a] -> a -> Paren a
Paren a
start [Paren a]
inner a
end Paren a -> [Paren a] -> [Paren a]
forall a. a -> [a] -> [a]
:) (([Paren a], Maybe (a, [a])) -> ([Paren a], Maybe (a, [a])))
-> ([Paren a], Maybe (a, [a])) -> ([Paren a], Maybe (a, [a]))
forall a b. (a -> b) -> a -> b
$ Maybe b -> [a] -> ([Paren a], Maybe (a, [a]))
go Maybe b
close [a]
xs
        go Maybe b
close (a
x:[a]
xs) = ([Paren a] -> [Paren a])
-> ([Paren a], Maybe (a, [a])) -> ([Paren a], Maybe (a, [a]))
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (a -> Paren a
forall a. a -> Paren a
Item a
x Paren a -> [Paren a] -> [Paren a]
forall a. a -> [a] -> [a]
:) (([Paren a], Maybe (a, [a])) -> ([Paren a], Maybe (a, [a])))
-> ([Paren a], Maybe (a, [a])) -> ([Paren a], Maybe (a, [a]))
forall a b. (a -> b) -> a -> b
$ Maybe b -> [a] -> ([Paren a], Maybe (a, [a]))
go Maybe b
close [a]
xs
        go Maybe b
close [] = ([], Maybe (a, [a])
forall a. Maybe a
Nothing)

parens :: [Lexeme] -> [Paren Lexeme]
parens :: [Lexeme] -> [Paren Lexeme]
parens = (Lexeme -> String)
-> [(String, String)] -> [Lexeme] -> [Paren Lexeme]
forall a b. Eq b => (a -> b) -> [(b, b)] -> [a] -> [Paren a]
parenOn Lexeme -> String
lexeme [(String
"(",String
")"),(String
"[",String
"]"),(String
"{",String
"}"),(String
"`",String
"`")]

unparens :: [Paren a] -> [a]
unparens :: [Paren a] -> [a]
unparens = (Paren a -> [a]) -> [Paren a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Paren a -> [a]
forall a. Paren a -> [a]
unparen

unparen :: Paren a -> [a]
unparen :: Paren a -> [a]
unparen (Item a
x) = [a
x]
unparen (Paren a
a [Paren a]
b a
c) = [a
a] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [Paren a] -> [a]
forall a. [Paren a] -> [a]
unparens [Paren a]
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
c]