Skip to content

Commit

Permalink
Make Strings the primitive for printing, not chars
Browse files Browse the repository at this point in the history
Also more complicated test case and collect concatable requests
  • Loading branch information
maxsnew committed Apr 18, 2014
1 parent 42ce210 commit b0bdfac
Show file tree
Hide file tree
Showing 5 changed files with 38 additions and 11 deletions.
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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
10 changes: 6 additions & 4 deletions IO/IO.elm
Original file line number Diff line number Diff line change
@@ -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)
Expand All @@ -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'
Expand Down Expand Up @@ -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

Expand All @@ -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

Expand Down
25 changes: 22 additions & 3 deletions IO/Runner.elm
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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 ->
Expand All @@ -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
Expand Down
10 changes: 8 additions & 2 deletions Test.elm
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion elm-io.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit b0bdfac

Please sign in to comment.