scroll 1.20180421 → 1.20250228

raw patch · 20 files changed

+274/−201 lines, 20 filesdep +base-compat

Dependencies added: base-compat

Files

• CHANGELOG +15/−0
• Control.hs +23/−20
• Curses.hs +0/−147
• Level.hs +7/−5
• Main.hs +4/−4
• Makefile +1/−2
• Peruser.hs +2/−0
• Player.hs +1/−0
• Player/Consume.hs +1/−0
• Player/Move.hs +1/−0
• Poison.hs +1/−0
• Spell.hs +15/−12
• TODO +21/−0
• Term.hs +9/−0
• Term/Curses.hs +154/−0
• Types.hs +3/−2
• Unicode.hs +8/−4
• World.hs +1/−0
• scroll.cabal +6/−4
• unix/Pager.hs +1/−1

@@ -1,3 +1,18 @@+scroll (1.20250228.1) unstable; urgency=medium++  * Adjust scroll.cabal so hackage will accept it.++ -- Joey Hess <id@joeyh.name>  Fri, 28 Feb 2025 15:26:57 -0400++scroll (1.20250228) unstable; urgency=medium++  * Updates for compatibility with modern base.+    Thanks, Xavier Dectot+  * Added note to TODO about haskell ncurses library installation issue on+    Debian++ -- Joey Hess <id@joeyh.name>  Fri, 28 Feb 2025 15:25:19 -0400+ scroll (1.20180421) unstable; urgency=medium    * Added stack.yaml.

@@ -1,7 +1,7 @@ module Control where +import Control.Monad (when) import Control.Monad.State.Strict-import UI.NCurses (Event(..), Key(..)) import qualified Data.Map as M import Data.Maybe import Control.Applicative@@ -18,20 +18,22 @@ import Poison import Help import View-import Curses+import Term+import Term.Curses  mainLoop :: Step-mainLoop (EventCharacter '\t') = forceRedraw-mainLoop (EventCharacter c) = case M.lookup c charMap of-	Just (CharControl (Movement d)) -> move d-	Just (CharControl Inventory) -> inventory-	Just (CharControl Help) -> showHelp-	Just (CharControl Quit) -> checkQuit-	Just (CharControl Wait) -> wait-	Just (IngredientFor _ _) -> invokeSwallowed c-	Just (Poison _) -> ignore-	Nothing -> invokeSwallowed c-mainLoop e = maybe ignore move (arrowDirection e)+mainLoop i = case inputCharacter i of+	Just '\t' -> forceRedraw+	Just c -> case M.lookup c charMap of+		Just (CharControl (Movement d)) -> move d+		Just (CharControl Inventory) -> inventory+		Just (CharControl Help) -> showHelp+		Just (CharControl Quit) -> checkQuit+		Just (CharControl Wait) -> wait+		Just (IngredientFor _ _) -> invokeSwallowed c+		Just (Poison _) -> ignore+		Nothing -> invokeSwallowed c+	Nothing -> maybe ignore move (arrowDirection i)  -- Does not step time ignore :: M NextStep@@ -99,8 +101,8 @@ 	next $ \_ -> clearWindows >> ignore  checkQuit :: M NextStep-checkQuit = prompt "Are you sure you want to quit? [yn]" $ \i -> case i of-	EventCharacter 'y' -> do+checkQuit = prompt "Are you sure you want to quit? [yn]" $ \i -> case inputCharacter i of+	Just 'y' -> do 		showMessage "Bye!" 		endThread 	_ -> do@@ -120,14 +122,15 @@   where 	victorydance 0 _ = endThread 	victorydance n e = do-		let dir = case e of-			(EventCharacter c) -> case M.lookup c charMap of+		let dir = case inputCharacter e of+			(Just c) -> case M.lookup c charMap of 				Just (CharControl (Movement d)) 					| d /= DUp && d /= DDive -> d 				_ -> DDown-			(EventSpecialKey KeyLeftArrow) -> DLeft-			(EventSpecialKey KeyRightArrow) -> DRight-			_ -> DDown+			Nothing -> case arrowDirection e of+				Just DLeft -> DLeft+				Just DRight -> DRight+				_ -> DDown 		moveaway DDown 		when (dir /= DDown) $ 			moveaway dir

@@ -1,147 +0,0 @@-module Curses where--import UI.NCurses hiding (Window)-import Control.Monad.State.Strict-import qualified Data.Vector as V-import Data.Vector ((!))-import Control.Applicative-import Prelude--import Types-import View--inCurses :: (Palette -> Curses a) -> IO a-inCurses a = runCurses $ do-	void $ setCursorMode CursorInvisible-	setEcho False-	palette <- assignColors-	a palette--data Palette = Palette-	{ swallowedColor :: ColorID-	, invokedColor :: ColorID-	}--assignColors :: Curses Palette-assignColors = Palette-	<$> newColorID ColorYellow ColorBlack 1-	<*> newColorID ColorGreen ColorBlack 2--paint :: Palette -> (Palette -> ColorID) -> Update a -> Update a-paint palette selectcolor a = do-	setColor (selectcolor palette)-	r <- a-	setColor defaultColorID-	return r---- Checks window bounds.-putGlyph :: ViewOffset -> MaxPos -> Pos -> Glyph -> Update ()-putGlyph (xoff, yoff) (xmax, ymax) (x,y) g-	| x' < xmax && x' > 0 && y' < ymax && y' > 0 = do-		moveCursor (fromIntegral y') (fromIntegral x')-		drawLineH (Just g) 1-	| otherwise = return ()-  where-	x' = x + xoff-	y' = y + yoff--headGlyph :: Glyph-headGlyph = bodyGlyph '@'--bodyGlyph :: Char -> Glyph-bodyGlyph c = Glyph c [AttributeStandout]--swallowedGlyph :: Char -> Glyph-swallowedGlyph c = Glyph c [AttributeStandout]--stomachColor :: Segment -> (Palette -> ColorID)-stomachColor s-	| segmentInvoked s = invokedColor-	| otherwise = swallowedColor--drawPlayer :: ViewOffset -> MaxPos -> Palette -> Player -> Update ()-drawPlayer offset maxpos palette p = do-	-- draw the body from the last segment to first, since-	-- segments sometimes sit on top of other segments.-	forM_ (reverse (playerBody p)) $-		drawSegment offset maxpos palette--	-- draw head last so the cursor is over it-	putGlyph offset maxpos (playerHead p) headGlyph--drawSegment :: ViewOffset -> MaxPos -> Palette -> Segment -> Update ()-drawSegment offset maxpos palette s-	| segmentSide s == CurrentSide =-		case segmentSwallowed s of-			Nothing -> putGlyph offset maxpos (segmentPos s) $ bodyGlyph $-				bodyChar $ segmentDirection s-			Just c -> paint palette (stomachColor s) $-				putGlyph offset maxpos (segmentPos s) $ swallowedGlyph c-	| otherwise = return ()--drawWindow :: Integer -> Int -> Window -> Update ()-drawWindow ymax xmax (Window (x,y) l) =-	when (x < xmax) $ do-		let xI = fromIntegral x-		let yI = fromIntegral y-		forM_ [0..length l - 1] $ \n -> do-			let yp = yI+fromIntegral n-			when (yp < ymax) $ do-				moveCursor yp xI-				drawString $ trim (l !! n)-  where-	trim = take (xmax - x - 1)--displayView :: View -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe Event, ViewOffset)-displayView view palette timeoutms oldoffset = loop -  where-	yv = viewVisible view-	loop = do-		w <- defaultWindow-		(ymaxI, xmaxI) <- screenSize-		let ymax = fromIntegral ymaxI-		let xmax = fromIntegral xmaxI--		let maxpos = (xmax, ymax)-		let newoffset@(xdelta, ydelta) = adjustOffset view oldoffset maxpos--		let (ytrimmer, yoff) = viewPort ydelta ymax (V.length yv)-		let yvtrimmed = ytrimmer yv--		let xsample = V.head yv-		let (xtrimmer, xoff) = viewPort xdelta xmax (V.length xsample)-		let xoffI = fromIntegral xoff--		updateWindow w $ do-			let clearline = drawLineH (Just (Glyph ' ' [])) xmaxI-			forM_ [0..ymax-2] $ \y -> do-				let yI = fromIntegral y-				let y' = y - yoff-				moveCursor yI 0-				void clearline-				when (y' < V.length yvtrimmed && y' >= 0) $ do-					let cs = V.toList $ xtrimmer $-						yvtrimmed ! y'-					unless (null cs) $ do-						moveCursor yI xoffI-						drawString cs--			drawPlayer newoffset maxpos palette (viewPlayer view)-			mapM_ (drawWindow ymaxI xmax) (viewWindows view)-		render--		mev <- getEvent w timeoutms-		case mev of-			Just (EventMouse _ _) -> loop-			Just (EventUnknown _) -> loop-			Just EventResized -> loop-			Just ev -> return (Just ev, newoffset)-			Nothing -> return (Nothing, newoffset)--arrowDirection :: Event -> Maybe Direction-arrowDirection (EventSpecialKey KeyLeftArrow) = Just DLeft-arrowDirection (EventSpecialKey KeyDownArrow) = Just DDown-arrowDirection (EventSpecialKey KeyUpArrow) = Just DUp-arrowDirection (EventSpecialKey KeyRightArrow) = Just DRight-arrowDirection (EventSpecialKey KeyEnter) = Just DDive-arrowDirection _ = Nothing

@@ -19,7 +19,8 @@ import qualified Level.Beowulf import qualified Level.Joyce import View-import Curses+import Term+import Term.Curses import Player import CharMap @@ -96,10 +97,11 @@ 					} 				go w off' pl' -	input (EventCharacter c) = case M.lookup c charMap of-		Just (CharControl (Movement d)) -> Just d-		_ -> Nothing-	input e = arrowDirection e+	input e = case inputCharacter e of+		Just c -> case M.lookup c charMap of+			Just (CharControl (Movement d)) -> Just d+			_ -> Nothing+		Nothing -> arrowDirection e  levelSelectionWorld :: IO World levelSelectionWorld = 

@@ -2,14 +2,14 @@ import Control.Monad.State.Strict import UI.NCurses (Curses, screenSize, Event(..)) import Options.Applicative-import Data.Monoid ((<>)) import Data.Maybe  import Types import WorldSetup import Control import View-import Curses+import Term+import Term.Curses import Rand import Unicode import Level@@ -66,13 +66,13 @@ 			else do 				(ymax, _) <- screenSize 				s <- liftIO $ stToIO $ makeWorld level ymax rand-				run s mainLoop EventResized palette timeoutms+				run s mainLoop (InputEvent EventResized) palette timeoutms 					initialViewOffset 	maybe (return ()) putStrLn finalmsg   where 	timeoutms = (* 1000) . read <$> timeoutOpt opts -run :: S -> Step -> Event -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe String)+run :: S -> Step -> InputEvent -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe String) run s step input palette timeoutms offset = do 	(NextStep view n, s') <- liftIO $ stToIO $ flip runStateT s $ 		step input

@@ -1,7 +1,6 @@ all:-	@find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags 2>/dev/null | sort > tags 	cabal build-	ln -sf dist/build/scroll/scroll+	cabal install --installdir=. --overwrite-policy=always  hackage: 	@cabal sdist

@@ -1,6 +1,8 @@ module Peruser where  import Control.Monad.State.Strict+import Control.Monad (when)+import Data.Foldable (forM_) import qualified Data.Vector.Mutable as MV import qualified Data.Vector as V import Control.Monad.IfElse

@@ -1,6 +1,7 @@ module Player where  import Control.Monad.State.Strict+import Control.Monad (forM) import qualified Data.Vector.Mutable as MV import Control.Applicative import Data.Maybe

@@ -1,6 +1,7 @@ module Player.Consume where  import Control.Monad.State.Strict+import Control.Monad (unless, when) import Data.Char import qualified Data.CaseInsensitive as CI import qualified Data.Map as M

@@ -3,6 +3,7 @@ module Player.Move where  import Control.Monad.State.Strict+import Control.Monad (when) import Data.Char import Data.Maybe import Control.Applicative

@@ -1,6 +1,7 @@ module Poison where  import Control.Monad.State.Strict+import Control.Monad (when) import qualified Data.CaseInsensitive as CI import qualified Data.Map as M import Data.Char

@@ -1,6 +1,9 @@ module Spell where  import Control.Monad.State.Strict+import Control.Monad (when)+import Control.Monad.Compat ((<=<))+import Data.Foldable (forM_) import qualified Data.Set as S import qualified Data.Map as M import qualified Data.CaseInsensitive as CI@@ -8,7 +11,6 @@ import Data.Char import Data.Maybe import Control.Monad.IfElse-import UI.NCurses (Event(..)) import Control.Applicative import Prelude @@ -24,6 +26,7 @@ import Rand import DeepCopy import Invert+import Term  type SpellAction = M NextStep -> M NextStep @@ -95,8 +98,8 @@ 		if null swallowed  			then noingredients cont 			else prompt ("Pick the new spell's ingredient: [" ++ swallowed ++ "]") $ \i ->-				case i of-					(EventCharacter c) | (CI.mk c `elem` map CI.mk swallowed) -> do+				case inputCharacter i of+					Just c | (CI.mk c `elem` map CI.mk swallowed) -> do 						removeIngredients' (S.singleton (CI.mk c)) 						possibilities <- checkSpells (const True) <$> gets player 						case possibilities of@@ -114,8 +117,8 @@ 	promptknownspell cont ingredient = do 		let retry = promptknownspell cont ingredient 		prompt ("What spell should " ++ invokeString [ingredient] ++ " invoke?") $ \i ->-			case i of-				(EventCharacter c) -> do+			case inputCharacter i of+				Just c -> do 					p <- gets player 					case toggleInvoke c p of 						(InvokedChar, p') -> do@@ -129,7 +132,7 @@ 							change p' 							retry 						(NoInvoke, _) -> retry-				_ -> retry+				Nothing -> retry 	change p' = modifyPlayer (const p')  	addnewspell ingredient basespell = do@@ -190,13 +193,13 @@ genocide :: SpellAction genocide = promptletter   where-	promptletter cont = prompt "Genocide which letter?" $ \i -> case i of-		(EventCharacter c)+	promptletter cont = prompt "Genocide which letter?" $ \i -> case inputCharacter i of+		Just c 			| isBoundry c || isSpace c -> do 				showMessage "The spell fizzles and dies. Nice try." 				cont 			| otherwise -> removeall c cont-		_ -> promptletter cont+		Nothing -> promptletter cont  	removeall c cont = do 		let toremove = CI.mk c@@ -317,8 +320,8 @@ 		cont  wish :: SpellAction-wish cont = prompt ("What letter do you wish for?") $ \ev -> case ev of-	(EventCharacter want) -> do+wish cont = prompt ("What letter do you wish for?") $ \ev -> case inputCharacter ev of+	Just want -> do 		result <- if isSpace want 			then do 				roll <-randM $ randomR (1,10 :: Int)@@ -338,7 +341,7 @@ 						then Just result 						else Nothing 		cont-	_ -> wish cont+	Nothing -> wish cont  data ToggleInvokeResult 	= InvokedChar

@@ -1,3 +1,24 @@+scroll fails to build from source on Debian because+https://hackage.haskell.org/package/ncurses fails to +build. The workaround is to patch that library with+this patch:++--- ncurses-0.2.16.orig/lib/UI/NCurses/Enums.chs	2016-08-28 21:09:37.000000000 -0400++++ ncurses-0.2.16/lib/UI/NCurses/Enums.chs	2025-02-28 15:18:09.215809399 -0400+@@ -195,7 +195,6 @@+ , hsncurses_KEY_UNDO = KEY_UNDO+ , hsncurses_KEY_MOUSE = KEY_MOUSE+ , hsncurses_KEY_RESIZE = KEY_RESIZE+-, hsncurses_KEY_EVENT = KEY_EVENT+ };+ #endc++I have informed its author about the problem and he did not want to fix it.+So, it would probably be best to migrate away from ncurses. A start has+been made in commit 4b5a597a5de090d1418b96aedd37bf044e3c05e9. Another+reason to do this is to get scroll running compiled to WASM in a web+browser.+ Add a bonus level with: Front side, a NanoGenMo generated novel. (It's possible that some of the current levels would qualify, if I'd only written them in November!) 

@@ -0,0 +1,9 @@+module Term where++import UI.NCurses (Event(..))++data InputEvent = InputEvent Event++inputCharacter :: InputEvent -> Maybe Char+inputCharacter (InputEvent (EventCharacter c)) = Just c+inputCharacter _ = Nothing

@@ -0,0 +1,154 @@+module Term.Curses (+	Palette,+	inCurses,+	displayView,+	arrowDirection,+) where++import UI.NCurses hiding (Window)+import Control.Monad (void, unless, when)+import Data.Foldable (forM_)+import qualified Data.Vector as V+import Data.Vector ((!))+import Control.Applicative+import Prelude++import Types+import Term+import View++inCurses :: (Palette -> Curses a) -> IO a+inCurses a = runCurses $ do+	void $ setCursorMode CursorInvisible+	setEcho False+	palette <- assignColors+	a palette++data Palette = Palette+	{ swallowedColor :: ColorID+	, invokedColor :: ColorID+	}++assignColors :: Curses Palette+assignColors = Palette+	<$> newColorID ColorYellow ColorBlack 1+	<*> newColorID ColorGreen ColorBlack 2++paint :: Palette -> (Palette -> ColorID) -> Update a -> Update a+paint palette selectcolor a = do+	setColor (selectcolor palette)+	r <- a+	setColor defaultColorID+	return r++-- Checks window bounds.+putGlyph :: ViewOffset -> MaxPos -> Pos -> Glyph -> Update ()+putGlyph (xoff, yoff) (xmax, ymax) (x,y) g+	| x' < xmax && x' > 0 && y' < ymax && y' > 0 = do+		moveCursor (fromIntegral y') (fromIntegral x')+		drawLineH (Just g) 1+	| otherwise = return ()+  where+	x' = x + xoff+	y' = y + yoff++headGlyph :: Glyph+headGlyph = bodyGlyph '@'++bodyGlyph :: Char -> Glyph+bodyGlyph c = Glyph c [AttributeStandout]++swallowedGlyph :: Char -> Glyph+swallowedGlyph c = Glyph c [AttributeStandout]++stomachColor :: Segment -> (Palette -> ColorID)+stomachColor s+	| segmentInvoked s = invokedColor+	| otherwise = swallowedColor++drawPlayer :: ViewOffset -> MaxPos -> Palette -> Player -> Update ()+drawPlayer offset maxpos palette p = do+	-- draw the body from the last segment to first, since+	-- segments sometimes sit on top of other segments.+	forM_ (reverse (playerBody p)) $+		drawSegment offset maxpos palette++	-- draw head last so the cursor is over it+	putGlyph offset maxpos (playerHead p) headGlyph++drawSegment :: ViewOffset -> MaxPos -> Palette -> Segment -> Update ()+drawSegment offset maxpos palette s+	| segmentSide s == CurrentSide =+		case segmentSwallowed s of+			Nothing -> putGlyph offset maxpos (segmentPos s) $ bodyGlyph $+				bodyChar $ segmentDirection s+			Just c -> paint palette (stomachColor s) $+				putGlyph offset maxpos (segmentPos s) $ swallowedGlyph c+	| otherwise = return ()++drawWindow :: Integer -> Int -> Window -> Update ()+drawWindow ymax xmax (Window (x,y) l) =+	when (x < xmax) $ do+		let xI = fromIntegral x+		let yI = fromIntegral y+		forM_ [0..length l - 1] $ \n -> do+			let yp = yI+fromIntegral n+			when (yp < ymax) $ do+				moveCursor yp xI+				drawString $ trim (l !! n)+  where+	trim = take (xmax - x - 1)++displayView :: View -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe InputEvent, ViewOffset)+displayView view palette timeoutms oldoffset = loop +  where+	yv = viewVisible view+	loop = do+		w <- defaultWindow+		(ymaxI, xmaxI) <- screenSize+		let ymax = fromIntegral ymaxI+		let xmax = fromIntegral xmaxI++		let maxpos = (xmax, ymax)+		let newoffset@(xdelta, ydelta) = adjustOffset view oldoffset maxpos++		let (ytrimmer, yoff) = viewPort ydelta ymax (V.length yv)+		let yvtrimmed = ytrimmer yv++		let xsample = V.head yv+		let (xtrimmer, xoff) = viewPort xdelta xmax (V.length xsample)+		let xoffI = fromIntegral xoff++		updateWindow w $ do+			let clearline = drawLineH (Just (Glyph ' ' [])) xmaxI+			forM_ [0..ymax-2] $ \y -> do+				let yI = fromIntegral y+				let y' = y - yoff+				moveCursor yI 0+				void clearline+				when (y' < V.length yvtrimmed && y' >= 0) $ do+					let cs = V.toList $ xtrimmer $+						yvtrimmed ! y'+					unless (null cs) $ do+						moveCursor yI xoffI+						drawString cs++			drawPlayer newoffset maxpos palette (viewPlayer view)+			mapM_ (drawWindow ymaxI xmax) (viewWindows view)+		render++		mev <- getEvent w timeoutms+		case mev of+			Just (EventMouse _ _) -> loop+			Just (EventUnknown _) -> loop+			Just EventResized -> loop+			Just ev -> return (Just (InputEvent ev), newoffset)+			Nothing -> return (Nothing, newoffset)++arrowDirection :: InputEvent -> Maybe Direction+arrowDirection (InputEvent (EventSpecialKey KeyLeftArrow)) = Just DLeft+arrowDirection (InputEvent (EventSpecialKey KeyDownArrow)) = Just DDown+arrowDirection (InputEvent (EventSpecialKey KeyUpArrow)) = Just DUp+arrowDirection (InputEvent (EventSpecialKey KeyRightArrow)) = Just DRight+arrowDirection (InputEvent (EventSpecialKey KeyEnter)) = Just DDive+arrowDirection _ = Nothing

@@ -12,9 +12,10 @@ import qualified Data.Set as S import qualified Data.Map as M import Data.CaseInsensitive (CI)-import UI.NCurses (Event) import System.Random (StdGen) +import Term+ -- Most code that updates the world runs in this monad stack. type M = StateT S (ST RealWorld) @@ -138,7 +139,7 @@  -- Calculates a new state of the world based on the provided Input. -- Returns new View, and a continuation to handle the next step.-type Step = Event -> M NextStep+type Step = InputEvent -> M NextStep data NextStep = NextStep View (Maybe Step)  type Level = [String]

@@ -49,6 +49,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.Map as M import Data.Char+import Data.Maybe  -- If table is used without being primed, there is a noticible -- delay the first time a character is looked up.@@ -58,11 +59,14 @@ 	Just _ -> return ()  unicodeCharDesc :: Char -> String-unicodeCharDesc c-	| l1 `elem` vowel = "an " ++ s-	| otherwise = "a " ++ s+unicodeCharDesc c =+	case listToMaybe s of+		Just l1+			| l1 `elem` vowel -> "an " ++ s+			| otherwise -> "a " ++ s+		Nothing -> "a " ++ s   where-  	s@(l1:_) = unicodeCharString c+  	s = unicodeCharString c 	vowel :: String 	vowel = "AEIOU" 

@@ -6,6 +6,7 @@ import Control.Monad.State.Strict import qualified Data.Vector.Mutable as MV import Control.Applicative+import Data.Foldable (forM_) import Prelude  import Types

@@ -1,6 +1,6 @@ Name: scroll-Version: 1.20180421-Cabal-Version: >= 1.6+Version: 1.20250228+Cabal-Version: 1.12 License: GPL-2 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess@@ -31,9 +31,10 @@ Executable scroll   Main-Is: Main.hs   GHC-Options: -threaded -Wall -fno-warn-tabs-  Build-Depends: base >= 4.5, base < 5, vector, bytestring, mtl,+  Build-Depends: base >= 4.5, base < 5, base-compat, vector, bytestring, mtl,     containers, ncurses, data-default, random, monad-loops, IfElse,     case-insensitive, optparse-applicative, text+  Default-Language: Haskell2010    Hs-Source-Dirs: .   if flag(Unix)@@ -45,7 +46,6 @@   Other-Modules:     CharMap     Control-    Curses     DeepCopy     GPL     Help@@ -71,6 +71,8 @@     Spell     Spell.Enum     Status+    Term+    Term.Curses     Time     Types     Unicode

@@ -20,7 +20,7 @@ 				term <- getTerminalName stdOutput 				oldstdin <- dup stdInput 				closeFd stdInput-				newstdin <- openFd term ReadOnly Nothing defaultFileFlags +				newstdin <- openFd term ReadOnly defaultFileFlags  				_ <- dupTo newstdin stdInput 				Just <$> (hGetContents =<< fdToHandle oldstdin) 			else error "stdout is not a terminal"