File: IndentToBrace.hs

package info (click to toggle)
haskell-shakespeare 2.1.1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 536 kB
  • sloc: haskell: 6,485; makefile: 2
file content (105 lines) | stat: -rw-r--r-- 2,835 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
{-# 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 = ($ [])
    . execWriter
    . mapM_ unnest
    . map addClosingCount
    . nest
    . map toL
    . stripComments
    . lines
    . filter (/= '\r')

stripComments :: [String] -> [String]
stripComments =
    map T.unpack . go False . map T.pack
  where
    go _ [] = []

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

data Line = Line
    { lineIndent  :: Int
    , lineContent :: String
    }
    deriving (Show, Eq)

data Nest = Nest Line Int [Nest]
          | Blank String
    deriving (Show, Eq)

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

addClosingCount :: Nest -> Nest
addClosingCount (Blank x) = Blank x
addClosingCount (Nest l c children) =
    Nest l c $ increment $ map addClosingCount children
  where
    increment
        | any (not . isBlank) children = increment'
        | otherwise = id

    increment' [] = error "should never happen"
    increment' (Blank x:rest) = Blank x : increment' rest
    increment' (n@(Nest l' c' children'):rest)
        | any (not . isBlank) rest = n : increment' rest
        | any (not . isBlank) children' = Nest l' c' (increment' children') : rest
        | otherwise = Nest l' (c' + 1) children' : rest

toL :: String -> Either String Line
toL s
    | null y = Left s
    | otherwise = Right $ Line (length x) y
  where
    (x, y) = span (== ' ') s

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

tell' :: String -> Writer (String -> String) ()
tell' s = tell (s ++)

unnest :: Nest -> Writer (String -> String) ()
unnest (Blank x) = do
    tell' x
    tell' "\n"
unnest (Nest l count inside) = do
    tell' $ replicate (lineIndent l) ' '
    tell' $ lineContent l
    tell' $
        case () of
            ()
                | not $ all isBlank inside -> " {"
                | ";" `isInfixOf` lineContent l -> ""
                | otherwise -> ";"
    tell' $ replicate count '}'
    tell' "\n"
    mapM_ unnest inside