Let me deal with outQ. I see 3 problems there:
- stateful computation without a monad (passing the generator state around)
- recursion instead of library function (
forever from Control.Monad is appropriate)
- using
!! to repeatedly access lists which is O(N) and thus not a good idea in most cases.
Let's clean up recursive calls so only the changing parts are passed around and constant parts are kept in a closure:
outQ list l sec = foo where
foo g = do
clearScreen
setCursorPosition 0 0 -- row col
let (index, gen') = randomR (0, l) g
putStrLn $ list !! index
threadDelay $ sec * oneSecond
foo gen' -- works
It's a good practice to split recursive parts from non-recursive, so you more easier can see which library function to use for recursion:
forever1 f = f >=> forever1 f
outQ list l sec = forever1 foo where
foo g = do
clearScreen
setCursorPosition 0 0 -- row col
let (index, gen') = randomR (0, l) g
putStrLn $ list !! index
threadDelay $ sec * oneSecond
return gen'
Now we can load ghci Quotes.hs and check :t forever1. It tells us that
forever1 :: Monad m => (b -> m b) -> b -> m c
Using Hoogle we check that there's no standard function with such type, so we have to stick
with our own. Now we can get rid of foo:
outQ list l sec = forever1 $ \g -> do
clearScreen
setCursorPosition 0 0 -- row col
let (index, gen') = randomR (0, l) g
putStrLn $ list !! index
threadDelay $ sec * oneSecond
return gen'
As for getting rid of generator passing, there are two options:
- To use
RandT monad transformer from Control.Monad.Random
- To use
randomRs function to generate all random numbers outside of outQ
For such simple case it's better to stick with option 2. Note as we don't need to pass anything from previous iteration call to next one, we can now use library function mapM_:
outQ list l sec = mapM_ $ \index -> do
clearScreen
setCursorPosition 0 0 -- row col
putStrLn $ list !! index
threadDelay $ sec * oneSecond
main :: IO ()
main = do
setTitle "Quotes"
hideCursor -- catch ctrl+c for showCursor
gen <- newStdGen
str <- readFile fileName
let qlist = splitStr '~' str
let len = length qlist -1
let rand = randomRs (0, len) gen
outQ qlist len delay rand
At this point we can convert our list to an immutable array:
outQ array sec = mapM_ $ \index -> do
clearScreen
setCursorPosition 0 0 -- row col
putStrLn $ array ! index
threadDelay $ sec * oneSecond
listArray' l = listArray (1, length l) l
main :: IO ()
main = do
setTitle "Quotes"
hideCursor -- catch ctrl+c for showCursor
gen <- newStdGen
str <- readFile fileName
let qlist = splitStr '~' str
let qarray = listArray' qlist
let rand = randomRs (bounds qarray) gen
outQ qarray delay rand
At this point I see there's no need in passing both array and rand to outQ:
outQ sec = mapM_ $ \s -> do
clearScreen
setCursorPosition 0 0 -- row col
putStrLn s
threadDelay $ sec * oneSecond
listArray' l = listArray (1, length l) l
main :: IO ()
main = do
setTitle "Quotes"
hideCursor -- catch ctrl+c for showCursor
gen <- newStdGen
str <- readFile fileName
let qlist = splitStr '~' str
let qarray = listArray' qlist
let rand = randomRs (bounds qarray) gen
let stringsToDisplay = map (qarray !) rand
outQ delay stringsToDisplay
Now outQ is crystal clear, so we can condense main:
main :: IO ()
main = do
setTitle "Quotes"
hideCursor -- catch ctrl+c for showCursor
qarray <- listArray' <$> splitStr '~' <$> readFile fileName
map (qarray !) <$> randomRs (bounds qarray) <$> newStdGen >>= outQ delay
Finally, to make code more readable, we can extract two general functions which may become useful elsewhere:
mapM_interval sec f = mapM_ $ \s -> do
f s
threadDelay $ sec * oneSecond
randomElemsFrom qarray = map (qarray !) . randomRs (bounds qarray)
main :: IO ()
main = do
setTitle "Quotes"
hideCursor -- catch ctrl+c for showCursor
qarray <- listArray' <$> splitStr '~' <$> readFile fileName
randomElemsFrom qarray <$> newStdGen >>= mapM_interval delay outQ
As the delay may be applied to other functions such as forever, mapM without underscore and, forM_ etc, you may want to generalize mapM_interval further:
withInterval sec mapFn innerFn = mapFn $ \s -> innerFn s >> threadDelay (sec * oneSecond)
main :: IO ()
main = do
setTitle "Quotes"
hideCursor -- catch ctrl+c for showCursor
qarray <- listArray' <$> splitStr '~' <$> readFile fileName
randomElemsFrom qarray <$> newStdGen >>= withInterval delay mapM_ outQ
So the final version is:
import System.Random (randomRs, newStdGen)
import Control.Concurrent (threadDelay) -- microseconds
import System.Console.ANSI (clearScreen, setCursorPosition, setTitle, hideCursor)
import Control.Applicative ((<$>))
import Data.Array (listArray, bounds, (!))
import Data.List.Split (splitOn)
fileName = "quotes.txt"
oneSecond = 1000000
delay = 1 -- sec
--clear = putStr "\ESC[2J" -- not working on windows
outQ s = do
clearScreen
setCursorPosition 0 0 -- row col
putStrLn s
listArray' l = listArray (1, length l) l
randomElemsFrom qarray = map (qarray !) . randomRs (bounds qarray)
withInterval sec mapFn innerFn = mapFn $ \s -> innerFn s >> threadDelay (sec * oneSecond)
main :: IO ()
main = do
setTitle "Quotes"
hideCursor -- catch ctrl+c for showCursor
qarray <- listArray' <$> splitOn "~" <$> readFile fileName
randomElemsFrom qarray <$> newStdGen >>= withInterval delay mapM_ outQ
Found yet another improvement:
randomElemsFrom x = map (qarray !) . randomRs (bounds qarray) where
qarray = listArray' $ splitOn "~" x
main :: IO ()
main = do
setTitle "Quotes"
hideCursor -- catch ctrl+c for showCursor
liftM2 randomElemsFrom (readFile fileName) newStdGen >>= withInterval delay mapM_ outQ
This version has more separation between monadic and non-monadic code (which is good) but randomElemsFrom was a generally useful function before but now it is tied to the task at hand (which is bad).
(c/=)-v-(/=c): did you compile using optimisation (-Oswitch to ghc)? – dave4420 Jul 25 '12 at 8:47