From b0bdfac5e4a0409305ac35eb7df86bb7e8333338 Mon Sep 17 00:00:00 2001
From: Max New <maxsnew@gmail.com>
Date: Thu, 17 Apr 2014 20:50:34 -0500
Subject: [PATCH] Make Strings the primitive for printing, not chars

Also more complicated test case and collect concatable requests
---
 .travis.yml   |  2 +-
 IO/IO.elm     | 10 ++++++----
 IO/Runner.elm | 25 ++++++++++++++++++++++---
 Test.elm      | 10 ++++++++--
 elm-io.cabal  |  2 +-
 5 files changed, 38 insertions(+), 11 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index e372430..26538f3 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -9,4 +9,4 @@ install:
   - echo "n" | elm-get install evancz/automaton
   - npm install jsdom
 before_script: elm-io Test.elm test.js
-script: echo "dis test" | node test.js
+script: echo "exit" | node test.js
diff --git a/IO/IO.elm b/IO/IO.elm
index 7e954ca..0675925 100644
--- a/IO/IO.elm
+++ b/IO/IO.elm
@@ -1,10 +1,12 @@
 module IO.IO where
 
+import String
+
 -- | User-facing API
 
 -- | IO Actions
 putChar : Char -> IO ()
-putChar c = Impure (PutC c (Pure ()))
+putChar c = Impure (PutS (String.cons c "") (Pure ()))
 
 getChar : IO Char
 getChar = Impure (GetC Pure)
@@ -13,7 +15,7 @@ exit : Int -> IO ()
 exit = Impure . Exit
 
 putStr : String -> IO ()
-putStr = mapIO putChar . String.toList
+putStr s = Impure (PutS s (Pure ()))
 
 putStrLn : String -> IO ()
 putStrLn s = putStr s >> putChar '\n'
@@ -66,7 +68,7 @@ seq x y = x >>= \_ -> y
 forever : IO a -> IO ()
 forever m = m >>= (\_ -> forever m)
 
-data IOF a = PutC Char a      -- ^ the a is the next computation
+data IOF a = PutS String a    -- ^ the a is the next computation
            | GetC (Char -> a) -- ^ the (Char -> a) is the continuation
            | Exit Int         -- ^ since there is no parameter, this must terminate
 
@@ -75,7 +77,7 @@ data IO a = Pure a
 
 mapF : (a -> b) -> IOF a -> IOF b
 mapF f iof = case iof of
-  PutC p x -> PutC p (f x)
+  PutS p x -> PutS p (f x)
   GetC k   -> GetC (f . k)
   Exit n   -> Exit n
 
diff --git a/IO/Runner.elm b/IO/Runner.elm
index dc9b2bc..8e15579 100644
--- a/IO/Runner.elm
+++ b/IO/Runner.elm
@@ -2,7 +2,8 @@ module IO.Runner where
 
 import Automaton as Auto
 import Either (..)
-
+import Trampoline
+    
 import IO.IO as IO
 import IO.IO (IO)
 
@@ -43,8 +44,8 @@ extractRequests io =
   case io of
     IO.Pure x -> pure ([exit 0], IO.Pure x)
     IO.Impure iof -> case iof of
-      IO.PutC c k -> extractRequests k >>= \(rs, k') ->
-                     pure (putS (String.cons c "") :: rs, k')
+      IO.PutS s k -> extractRequests k >>= \(rs, k') ->
+                     pure (flattenReqs (putS s) rs, k')
       IO.Exit n   -> pure ([exit n], io)
       IO.GetC k   ->
         ask >>= \st ->
@@ -54,6 +55,24 @@ extractRequests io =
             put ({ buffer = rest }) >>= \_ ->
             extractRequests (k c)
 
+flattenReqs : Request -> [Request] -> [Request]
+flattenReqs r rs =
+    let loop r rs n = 
+            case r.mExit of
+              Just n -> Trampoline.Done [r]
+              _ ->
+                  case (r.mPut, rs) of
+                    (Just s1, r2 :: rs') ->
+                        case r2.mPut of
+                          Just s2 ->
+                              let newS = s1 ++ s2
+                              in if n >= 100
+                                 then Trampoline.Continue (\_ -> loop (putS newS) rs' 0)
+                                 else loop (putS newS) rs' (n + 1)
+                          _ -> Trampoline.Done (r :: rs)
+                    _ -> Trampoline.Done (r :: rs)
+    in Trampoline.trampoline <| loop r rs 0
+                         
 step : Response -> (IO a, IOState) -> ((IO a, IOState), [Request])
 step resp (io, st) = 
   let newST = case resp of 
diff --git a/Test.elm b/Test.elm
index a3cbcda..6d9b7f8 100644
--- a/Test.elm
+++ b/Test.elm
@@ -9,10 +9,16 @@ import String
 echo : IO ()
 echo = forever (getLine >>= putStrLn)
 
+loop : IO ()
+loop = getLine >>= \s ->
+       if s == "exit"
+       then pure ()
+       else putStrLn s >> loop
+       
 hello : IO ()
 hello = putStrLn "Hello, Console!"       >>
-        putStrLn "I'll echo your input:" >>
-        (getLine >>= putStrLn)           >>
+        putStrLn "I'll echo your input until you say \"exit\":" >>
+        loop >>         
         putStrLn "That's all, folks!"    >>
         exit 0
 
diff --git a/elm-io.cabal b/elm-io.cabal
index 46a7737..cd00ff1 100644
--- a/elm-io.cabal
+++ b/elm-io.cabal
@@ -19,7 +19,7 @@ cabal-version:       >=1.10
 
 executable elm-io
   main-is:             mkExe.hs
-  build-depends:       base >=4.6 && <4.7
+  build-depends:       base >=4.6 && < 5
                        , Elm >= 0.11
                        , process
                        , filepath