{-# LANGUAGE OverloadedStrings #-}
module Text.IndentToBrace
    ( i2b
    ) where

import Control.Monad.Trans.Writer (execWriter, tell, Writer)
import Data.List (isInfixOf)
import qualified Data.Text as T

i2b :: String -> String
i2b :: String -> String
i2b = ((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [])
    ((String -> String) -> String)
-> (String -> String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (String -> String) () -> String -> String
forall w a. Writer w a -> w
execWriter
    (Writer (String -> String) () -> String -> String)
-> (String -> Writer (String -> String) ())
-> String
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Nest -> Writer (String -> String) ())
-> [Nest] -> Writer (String -> String) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Nest -> Writer (String -> String) ()
unnest
    ([Nest] -> Writer (String -> String) ())
-> (String -> [Nest]) -> String -> Writer (String -> String) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Nest -> Nest) -> [Nest] -> [Nest]
forall a b. (a -> b) -> [a] -> [b]
map Nest -> Nest
addClosingCount
    ([Nest] -> [Nest]) -> (String -> [Nest]) -> String -> [Nest]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String Line] -> [Nest]
nest
    ([Either String Line] -> [Nest])
-> (String -> [Either String Line]) -> String -> [Nest]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either String Line) -> [String] -> [Either String Line]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String Line
toL
    ([String] -> [Either String Line])
-> (String -> [String]) -> String -> [Either String Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
stripComments
    ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\r')

stripComments :: [String] -> [String]
stripComments :: [String] -> [String]
stripComments =
    (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String])
-> ([String] -> [Text]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Text] -> [Text]
go Bool
False ([Text] -> [Text]) -> ([String] -> [Text]) -> [String] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack
  where
    go :: Bool -> [Text] -> [Text]
go _ [] = []

    go False (l :: Text
l:ls :: [Text]
ls) =
        let (before :: Text
before, after' :: Text
after') = Text -> Text -> (Text, Text)
T.breakOn "/*" Text
l
         in case Text -> Text -> Maybe Text
T.stripPrefix "/*" Text
after' of
                Nothing -> Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Bool -> [Text] -> [Text]
go Bool
False [Text]
ls
                Just after :: Text
after ->
                    let (x :: Text
x:xs :: [Text]
xs) = Bool -> [Text] -> [Text]
go Bool
True ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
after Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls
                     in Text
before Text -> Text -> Text
`T.append` Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs
    go True (l :: Text
l:ls :: [Text]
ls) =
        let (_, after' :: Text
after') = Text -> Text -> (Text, Text)
T.breakOn "*/" Text
l
         in case Text -> Text -> Maybe Text
T.stripPrefix "*/" Text
after' of
                Nothing -> Text
T.empty Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Bool -> [Text] -> [Text]
go Bool
True [Text]
ls
                Just after :: Text
after -> Bool -> [Text] -> [Text]
go Bool
False ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
after Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls

data Line = Line
    { Line -> Int
lineIndent  :: Int
    , Line -> String
lineContent :: String
    }
    deriving (Int -> Line -> String -> String
[Line] -> String -> String
Line -> String
(Int -> Line -> String -> String)
-> (Line -> String) -> ([Line] -> String -> String) -> Show Line
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Line] -> String -> String
$cshowList :: [Line] -> String -> String
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> String -> String
$cshowsPrec :: Int -> Line -> String -> String
Show, Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq)

data Nest = Nest Line Int [Nest]
          | Blank String
    deriving (Int -> Nest -> String -> String
[Nest] -> String -> String
Nest -> String
(Int -> Nest -> String -> String)
-> (Nest -> String) -> ([Nest] -> String -> String) -> Show Nest
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Nest] -> String -> String
$cshowList :: [Nest] -> String -> String
show :: Nest -> String
$cshow :: Nest -> String
showsPrec :: Int -> Nest -> String -> String
$cshowsPrec :: Int -> Nest -> String -> String
Show, Nest -> Nest -> Bool
(Nest -> Nest -> Bool) -> (Nest -> Nest -> Bool) -> Eq Nest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nest -> Nest -> Bool
$c/= :: Nest -> Nest -> Bool
== :: Nest -> Nest -> Bool
$c== :: Nest -> Nest -> Bool
Eq)

isBlank :: Nest -> Bool
isBlank :: Nest -> Bool
isBlank Blank{} = Bool
True
isBlank _ = Bool
False

addClosingCount :: Nest -> Nest
addClosingCount :: Nest -> Nest
addClosingCount (Blank x :: String
x) = String -> Nest
Blank String
x
addClosingCount (Nest l :: Line
l c :: Int
c children :: [Nest]
children) =
    Line -> Int -> [Nest] -> Nest
Nest Line
l Int
c ([Nest] -> Nest) -> [Nest] -> Nest
forall a b. (a -> b) -> a -> b
$ [Nest] -> [Nest]
increment ([Nest] -> [Nest]) -> [Nest] -> [Nest]
forall a b. (a -> b) -> a -> b
$ (Nest -> Nest) -> [Nest] -> [Nest]
forall a b. (a -> b) -> [a] -> [b]
map Nest -> Nest
addClosingCount [Nest]
children
  where
    increment :: [Nest] -> [Nest]
increment
        | (Nest -> Bool) -> [Nest] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Nest -> Bool) -> Nest -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nest -> Bool
isBlank) [Nest]
children = [Nest] -> [Nest]
increment'
        | Bool
otherwise = [Nest] -> [Nest]
forall a. a -> a
id

    increment' :: [Nest] -> [Nest]
increment' [] = String -> [Nest]
forall a. HasCallStack => String -> a
error "should never happen"
    increment' (Blank x :: String
x:rest :: [Nest]
rest) = String -> Nest
Blank String
x Nest -> [Nest] -> [Nest]
forall a. a -> [a] -> [a]
: [Nest] -> [Nest]
increment' [Nest]
rest
    increment' (n :: Nest
n@(Nest l' :: Line
l' c' :: Int
c' children' :: [Nest]
children'):rest :: [Nest]
rest)
        | (Nest -> Bool) -> [Nest] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Nest -> Bool) -> Nest -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nest -> Bool
isBlank) [Nest]
rest = Nest
n Nest -> [Nest] -> [Nest]
forall a. a -> [a] -> [a]
: [Nest] -> [Nest]
increment' [Nest]
rest
        | (Nest -> Bool) -> [Nest] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Nest -> Bool) -> Nest -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nest -> Bool
isBlank) [Nest]
children' = Line -> Int -> [Nest] -> Nest
Nest Line
l' Int
c' ([Nest] -> [Nest]
increment' [Nest]
children') Nest -> [Nest] -> [Nest]
forall a. a -> [a] -> [a]
: [Nest]
rest
        | Bool
otherwise = Line -> Int -> [Nest] -> Nest
Nest Line
l' (Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [Nest]
children' Nest -> [Nest] -> [Nest]
forall a. a -> [a] -> [a]
: [Nest]
rest

toL :: String -> Either String Line
toL :: String -> Either String Line
toL s :: String
s
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
y = String -> Either String Line
forall a b. a -> Either a b
Left String
s
    | Bool
otherwise = Line -> Either String Line
forall a b. b -> Either a b
Right (Line -> Either String Line) -> Line -> Either String Line
forall a b. (a -> b) -> a -> b
$ Int -> String -> Line
Line (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) String
y
  where
    (x :: String
x, y :: String
y) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') String
s

nest :: [Either String Line] -> [Nest]
nest :: [Either String Line] -> [Nest]
nest [] = []
nest (Left x :: String
x:rest :: [Either String Line]
rest) = String -> Nest
Blank String
x Nest -> [Nest] -> [Nest]
forall a. a -> [a] -> [a]
: [Either String Line] -> [Nest]
nest [Either String Line]
rest
nest (Right l :: Line
l:rest :: [Either String Line]
rest) =
    Line -> Int -> [Nest] -> Nest
Nest Line
l 0 ([Either String Line] -> [Nest]
nest [Either String Line]
inside) Nest -> [Nest] -> [Nest]
forall a. a -> [a] -> [a]
: [Either String Line] -> [Nest]
nest [Either String Line]
outside
  where
    (inside :: [Either String Line]
inside, outside :: [Either String Line]
outside) = (Either String Line -> Bool)
-> [Either String Line]
-> ([Either String Line], [Either String Line])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Either String Line -> Bool
forall a. Either a Line -> Bool
isNested [Either String Line]
rest
    isNested :: Either a Line -> Bool
isNested Left{} = Bool
True
    isNested (Right l2 :: Line
l2) = Line -> Int
lineIndent Line
l2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Line -> Int
lineIndent Line
l

tell' :: String -> Writer (String -> String) ()
tell' :: String -> Writer (String -> String) ()
tell' s :: String
s = (String -> String) -> Writer (String -> String) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++)

unnest :: Nest -> Writer (String -> String) ()
unnest :: Nest -> Writer (String -> String) ()
unnest (Blank x :: String
x) = do
    String -> Writer (String -> String) ()
tell' String
x
    String -> Writer (String -> String) ()
tell' "\n"
unnest (Nest l :: Line
l count :: Int
count inside :: [Nest]
inside) = do
    String -> Writer (String -> String) ()
tell' (String -> Writer (String -> String) ())
-> String -> Writer (String -> String) ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Line -> Int
lineIndent Line
l) ' '
    String -> Writer (String -> String) ()
tell' (String -> Writer (String -> String) ())
-> String -> Writer (String -> String) ()
forall a b. (a -> b) -> a -> b
$ Line -> String
lineContent Line
l
    String -> Writer (String -> String) ()
tell' (String -> Writer (String -> String) ())
-> String -> Writer (String -> String) ()
forall a b. (a -> b) -> a -> b
$
        case () of
            ()
                | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Nest -> Bool) -> [Nest] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Nest -> Bool
isBlank [Nest]
inside -> " {"
                | ";" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Line -> String
lineContent Line
l -> ""
                | Bool
otherwise -> ";"
    String -> Writer (String -> String) ()
tell' (String -> Writer (String -> String) ())
-> String -> Writer (String -> String) ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
count '}'
    String -> Writer (String -> String) ()
tell' "\n"
    (Nest -> Writer (String -> String) ())
-> [Nest] -> Writer (String -> String) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Nest -> Writer (String -> String) ()
unnest [Nest]
inside