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

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

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

putTrailingNewline :: Eq a => a -> [a] -> [a]
putTrailingNewline :: a -> [a] -> [a]
putTrailingNewline a
newline [a]
tokens =
  if Bool -> Bool
not ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
tokens) Bool -> Bool -> Bool
&& [a] -> a
forall a. [a] -> a
last [a]
tokens a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
newline
    then [a]
tokens [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
newline]
    else [a]
tokens

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