Skip to content

Instantly share code, notes, and snippets.

@unhammer
Created March 12, 2019 14:00
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save unhammer/e68403fb22af231204f8d53c7b686577 to your computer and use it in GitHub Desktop.
put every line in a superblank before the (escaped) line itself
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative
import Data.Attoparsec.ByteString
import qualified Data.ByteString as S
import Data.Char (ord)
import GHC.Word (Word8)
import Prelude hiding (takeWhile)
import System.IO.Streams
import System.IO.Streams.Attoparsec.ByteString
main :: IO ()
main = go "" ""
where
go comment line = do
parsed <- parseFromStream (escape <|> newline <|> tilde <|> eof <|> keepAsIs) stdin
case parsed of
Tilde ->
go (comment <> "~") (line <> "[~]")
EOF ->
S.putStr $ "[" <> comment <> "]\n" <> line
NL -> do
S.putStr $ "[" <> comment <> "]\n" <> line <> "[][\n]"
go "" ""
Plain p ->
go (comment <> p) (line <> p)
data R = EOF | Plain S.ByteString | NL | Tilde
eof :: Parser R
eof = do
endOfInput
pure EOF
newline :: Parser R
newline = do
_ <- string "\n"
pure NL
tilde :: Parser R
tilde = do
_ <- string "~"
pure Tilde
needsEscape :: String
needsEscape = "\\[]^$@/{}<>"
special :: String
special = needsEscape <> "~\n"
keepAsIs :: Parser R
keepAsIs = Plain <$> takeWhile1 (notInClass special)
escape :: Parser R
escape = do
b <- satisfy (inClass needsEscape)
pure $ Plain $ S.pack [w8 '\\', b]
char :: Char -> Parser Word8
char = word8 . w8
w8 :: Char -> Word8
w8 = fromIntegral . ord
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment