-
Notifications
You must be signed in to change notification settings - Fork 0
/
latex-tree.hs
48 lines (38 loc) · 2.04 KB
/
latex-tree.hs
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
#!/usr/bin/runhaskell
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
import Data.Attoparsec.ByteString.Lazy hiding (take)
import Data.Attoparsec.Combinator
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString as BSS
import Data.Foldable (traverse_)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text (unpack, pack)
import Data.Text.IO (putStrLn, putStr)
import Data.Maybe
import Options.Applicative hiding (option)
import Prelude hiding (takeWhile, putStrLn, putStr)
import System.FilePath.Posix ((<.>))
import Data.Monoid ((<>))
data Arguments = Arguments { inputfile :: String }
argParser = Arguments <$> argument str (metavar "INPUT")
fileParser = manyTill (choice [ Just . BSS.copy . (<> ".tex") <$> (string "input{" *> takeTill (125 ==))
, takeTill (92 ==) *> pure Nothing <* skip (92 ==) ]) (takeTill (92 ==) *> endOfInput)
data Tree = Tree { nodeVal :: !BSS.ByteString
, children :: [Tree]} deriving Show
parseTree :: BSS.ByteString -> IO [Tree]
parseTree foo = let !i = doParsing $ BSL.fromStrict foo in
zipWith Tree i <$> (mapM (BSS.readFile . unpack . decodeUtf8) i >>= mapM (parseTree))
where doParsing = fromMaybe [] . fmap catMaybes . maybeResult . parse fileParser
fancyPrint = fancyPrint' 0 ""
where fancyPrint' num prefix node = do traverse_ putStr $ reverse $ take num (prefix : genList num)
putStrLn $ decodeUtf8 $ nodeVal node
traverse_ (uncurry (fancyPrint' (num + 1))) $ zip (reverse $ take (length $ children node) childOrder) $ children node
childOrder = "└──" : repeat "├──"
genList 0 = []
genList 1 = []
genList 2 = ["│ "]
genList n = take (n-2) (repeat " ") <> genList 2
main = execParser opts >>= fromArgs parseTree >>= fancyPrint
where opts = info (helper <*> argParser) (fullDesc)
fromArgs fn args = Tree (encodeUtf8 $ pack $ inputfile args) <$> (BSS.readFile (inputfile args) >>= fn)