Skip to content

Instantly share code, notes, and snippets.

@naoto-ogawa
Last active May 3, 2019 04:27
  • 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 naoto-ogawa/b2bdce69de36386593c3e5ba422b43f4 to your computer and use it in GitHub Desktop.
is-stream sample
{-# LANGUAGE OverloadedStrings #-}
module SampleStream (main) where
import Data.Foldable (forM_)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.IO (IOMode (..), withFile)
import System.IO.Streams as S
main :: IO ()
main = withFile "./test/data/warning01.txt" ReadMode $ \h -> do
is <- handleToInputStream h >>=
S.lines >>=
decodeUtf8 >>=
addBrace >>= \s ->
makeCount >>= \cnt ->
S.zip cnt s >>=
addLineNumber
os <- writeTextConsole
connect is os
writeTextConsole :: IO (OutputStream T.Text)
writeTextConsole = makeOutputStream $ \m -> forM_ m T.putStrLn
addLineNumber :: InputStream (Int, T.Text) -> IO (InputStream T.Text)
addLineNumber = S.map (\(idx, tx) -> T.pack (show idx) `T.append` ":" `T.append` tx)
addBrace :: InputStream T.Text -> IO (InputStream T.Text)
addBrace = S.map (\x -> "{" `T.append` T.strip x `T.append` "}")
makeCount :: IO (InputStream Int)
makeCount = S.fromList [1..]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment