{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Jikka.Common.Parse.JoinLines
  ( joinLinesWithParens,
    removeEmptyLines,
  )
where

import Jikka.Common.Error
import Jikka.Common.Location

joinLinesWithParens :: forall m a. (MonadError Error m, Show a) => (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> [WithLoc a] -> m [WithLoc a]
joinLinesWithParens :: (a -> Bool)
-> (a -> Bool) -> (a -> Bool) -> [WithLoc a] -> m [WithLoc a]
joinLinesWithParens a -> Bool
isOpen a -> Bool
isClose a -> Bool
isNewline = [WithLoc a] -> [WithLoc a] -> m [WithLoc a]
go []
  where
    go :: [WithLoc a] -> [WithLoc a] -> m [WithLoc a]
    go :: [WithLoc a] -> [WithLoc a] -> m [WithLoc a]
go [WithLoc a]
stk [WithLoc a]
tokens = case ([WithLoc a]
stk, [WithLoc a]
tokens) of
      ([], []) -> [WithLoc a] -> m [WithLoc a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      (WithLoc a
paren : [WithLoc a]
_, []) -> Loc -> String -> m [WithLoc a]
forall (m :: * -> *) a. MonadError Error m => Loc -> String -> m a
throwLexicalErrorAt (WithLoc a -> Loc
forall a. WithLoc a -> Loc
loc WithLoc a
paren) (String -> m [WithLoc a]) -> String -> m [WithLoc a]
forall a b. (a -> b) -> a -> b
$ String
"unmatching paren found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (WithLoc a -> a
forall a. WithLoc a -> a
value WithLoc a
paren)
      ([WithLoc a]
_, WithLoc a
token : [WithLoc a]
tokens) | a -> Bool
isOpen (WithLoc a -> a
forall a. WithLoc a -> a
value WithLoc a
token) -> (WithLoc a
token WithLoc a -> [WithLoc a] -> [WithLoc a]
forall a. a -> [a] -> [a]
:) ([WithLoc a] -> [WithLoc a]) -> m [WithLoc a] -> m [WithLoc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WithLoc a] -> [WithLoc a] -> m [WithLoc a]
go (WithLoc a
token WithLoc a -> [WithLoc a] -> [WithLoc a]
forall a. a -> [a] -> [a]
: [WithLoc a]
stk) [WithLoc a]
tokens
      ([], WithLoc a
token : [WithLoc a]
_) | a -> Bool
isClose (WithLoc a -> a
forall a. WithLoc a -> a
value WithLoc a
token) -> Loc -> String -> m [WithLoc a]
forall (m :: * -> *) a. MonadError Error m => Loc -> String -> m a
throwLexicalErrorAt (WithLoc a -> Loc
forall a. WithLoc a -> Loc
loc WithLoc a
token) (String -> m [WithLoc a]) -> String -> m [WithLoc a]
forall a b. (a -> b) -> a -> b
$ String
"unmatching paren found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (WithLoc a -> a
forall a. WithLoc a -> a
value WithLoc a
token)
      (WithLoc a
_ : [WithLoc a]
stk, WithLoc a
token : [WithLoc a]
tokens) | a -> Bool
isClose (WithLoc a -> a
forall a. WithLoc a -> a
value WithLoc a
token) -> (WithLoc a
token WithLoc a -> [WithLoc a] -> [WithLoc a]
forall a. a -> [a] -> [a]
:) ([WithLoc a] -> [WithLoc a]) -> m [WithLoc a] -> m [WithLoc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WithLoc a] -> [WithLoc a] -> m [WithLoc a]
go [WithLoc a]
stk [WithLoc a]
tokens
      (WithLoc a
_ : [WithLoc a]
_, WithLoc a
token : [WithLoc a]
tokens) | a -> Bool
isNewline (WithLoc a -> a
forall a. WithLoc a -> a
value WithLoc a
token) -> [WithLoc a] -> [WithLoc a] -> m [WithLoc a]
go [WithLoc a]
stk [WithLoc a]
tokens
      ([WithLoc a]
_, WithLoc a
token : [WithLoc a]
tokens) -> (WithLoc a
token WithLoc a -> [WithLoc a] -> [WithLoc a]
forall a. a -> [a] -> [a]
:) ([WithLoc a] -> [WithLoc a]) -> m [WithLoc a] -> m [WithLoc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WithLoc a] -> [WithLoc a] -> m [WithLoc a]
go [WithLoc a]
stk [WithLoc a]
tokens

removeEmptyLines :: forall a. (a -> Bool) -> [WithLoc a] -> [WithLoc a]
removeEmptyLines :: (a -> Bool) -> [WithLoc a] -> [WithLoc a]
removeEmptyLines a -> Bool
isNewline = Bool -> [WithLoc a] -> [WithLoc a]
go Bool
True
  where
    go :: Bool -> [WithLoc a] -> [WithLoc a]
    go :: Bool -> [WithLoc a] -> [WithLoc a]
go Bool
_ [] = []
    go Bool
lastIsNewline (WithLoc a
token : [WithLoc a]
tokens)
      | Bool
lastIsNewline Bool -> Bool -> Bool
&& a -> Bool
isNewline (WithLoc a -> a
forall a. WithLoc a -> a
value WithLoc a
token) = Bool -> [WithLoc a] -> [WithLoc a]
go Bool
True [WithLoc a]
tokens
      | Bool
otherwise = WithLoc a
token WithLoc a -> [WithLoc a] -> [WithLoc a]
forall a. a -> [a] -> [a]
: Bool -> [WithLoc a] -> [WithLoc a]
go (a -> Bool
isNewline (WithLoc a -> a
forall a. WithLoc a -> a
value WithLoc a
token)) [WithLoc a]
tokens