interact 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+284/−93 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• README.md +1/−1
• interact.cabal +3/−3
• src/System/IO/Interact.hs +165/−88
• tests/Test.hs +112/−1

@@ -1,3 +1,6 @@+# 0.2.0.0+- Added REPLs with prompt: `pRepl`, `pReplState` and `pReplFold`+ # 0.1.0.0  - Initial release

@@ -5,4 +5,4 @@ - REPL with state from plain state function or with State monad - REPL-fold from two-arguments functions, with the accumulator in the first argument -See docs and usage examples on hackage: http://hackage.haskell.org/package/interact+See [docs and usage examples on hackage](http://hackage.haskell.org/package/interact/docs/System-IO-Interact.html).

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: e748dd99c68b9226eb30badff724ac9fa45b88d6da96bd80cd0f7b4c8a715aa3+-- hash: bb6a95dd5b3a368a73376daef53e8c118da2814ceeb01a4ea04afd7bbf80c90d  name:           interact-version:        0.1.0.0+version:        0.2.0.0 synopsis:       instantly create REPL from any function description:    This module provides functions to create interactive REPLs:                 .

@@ -26,21 +26,28 @@     Repl,     repl,     repl',+    pRepl,+    pRepl',      -- * REPL with state     ReplState,     replState,     replState',+    pReplState,+    pReplState',      -- * REPL-fold     replFold,     replFold',+    pReplFold,+    pReplFold',   ) where +import Control.Exception (bracket) import Control.Monad.State-import Data.Either import Data.Maybe+import System.IO import Text.Read (readMaybe)  -- | 'Repl' typeclass with polymorphic stateless function 'repl' to interactively@@ -71,73 +78,121 @@   -- > sqrSqrt (x:xs) = x^2 : sqrt x : sqrSqrt xs   -- > repl sqrSqrt   repl :: (a -> b) -> IO ()+  repl = pRepl "" +  -- | 'pRepl' is 'repl' with prompt+  --+  -- __Example__:+  --+  -- > pRepl ">" (sqrt :: Double -> Double)+  pRepl :: String -> (a -> b) -> IO ()+ -- | 'stdin'/'stdout' 'String's as lazy lists instance {-# OVERLAPPING #-} Repl [String] [String] where-  repl :: ([String] -> [String]) -> IO ()-  repl f = interact $ unlines . f . lines+  pRepl :: String -> ([String] -> [String]) -> IO ()+  pRepl "" f = interact $ unlines . f . lines+  pRepl p f =+    noBuffering . interact $+      (p ++) . concatMap (++ '\n' : p) . f . lines +noBuffering :: IO a -> IO a+noBuffering = withBufferMode NoBuffering stdout++withBufferMode :: BufferMode -> Handle -> IO a -> IO a+withBufferMode mode h act =+  bracket+    (hGetBuffering h <* hSetBuffering h mode)+    (hSetBuffering h)+    (const act)+ -- | 'stdin'/'stdout' values as lazy lists instance {-# OVERLAPPING #-} (Read a, Show b) => Repl [a] [b] where-  repl :: ([a] -> [b]) -> IO ()-  repl f = repl $ map show . f . mapMaybe readMaybe+  pRepl :: String -> ([a] -> [b]) -> IO ()+  pRepl p f = pRepl p $ map show . f . mapMaybe readMaybe  -- | Ctrl-D to exit instance (Read a, Show b) => Repl a b where-  repl :: (a -> b) -> IO ()-  repl f = repl $ maybe invalid show . fmap f . readMaybe+  pRepl :: String -> (a -> b) -> IO ()+  pRepl p = pRepl p . readShow +readShowFunc ::+  (Read a, Show b) =>+  (String -> fs) ->+  ((b -> String) -> fb -> fs) ->+  (a -> fb) ->+  (String -> fs)+readShowFunc pr fm f = maybe (pr invalid) (fm show) . fmap f . readMaybe++readShow ::+  (Read a, Show b) => (a -> b) -> (String -> String)+readShow = readShowFunc id id++readShowA ::+  (Applicative f, Read a, Show b) => (a -> f b) -> (String -> f String)+readShowA = readShowFunc pure fmap++readShowAA ::+  (Applicative g, Applicative f, Read a, Show b) =>+  (a -> g (f b)) ->+  (String -> g (f String))+readShowAA = readShowFunc (pure . pure) (fmap . fmap)+ invalid :: String invalid = "Invalid input"  -- | 'String's do not use 'read'/'show' instance {-# OVERLAPPING #-} Repl String String where-  repl :: (String -> String) -> IO ()-  repl f = repl $ map f+  pRepl :: String -> (String -> String) -> IO ()+  pRepl p = pRepl p . map  instance {-# OVERLAPPING #-} Repl String (Maybe String) where-  repl :: (String -> Maybe String) -> IO ()-  repl f = repl $ whileJust . map f+  pRepl :: String -> (String -> Maybe String) -> IO ()+  pRepl p f = pRepl p $ whileJust . map f  whileJust :: [Maybe String] -> [String] whileJust = map fromJust . takeWhile isJust  instance {-# OVERLAPPING #-} Repl String (Either String String) where-  repl :: (String -> Either String String) -> IO ()-  repl f = repl $ whileRight . map f+  pRepl :: String -> (String -> Either String String) -> IO ()+  pRepl p f = pRepl p $ whileRight . map f  whileRight :: [Either String String] -> [String]-whileRight = rights . rightsAndLeft . span isRight-  where-    rightsAndLeft ([], (Left l : _)) = [Right l]-    rightsAndLeft ([], _) = []-    rightsAndLeft (r : rs, ls) = r : rightsAndLeft (rs, ls)+whileRight (Right x : xs) = x : whileRight xs+whileRight (Left x : _) = [x]+whileRight [] = []  -- | return 'Nothing' to exit instance {-# OVERLAPPING #-} (Read a, Show b) => Repl a (Maybe b) where-  repl :: (a -> Maybe b) -> IO ()-  repl f = repl $ readShow f+  pRepl :: String -> (a -> Maybe b) -> IO ()+  pRepl p = pRepl p . readShowA  -- | return 'Left' to exit, string in 'Left' is printed instance {-# OVERLAPPING #-} (Read a, Show b) => Repl a (Either String b) where-  repl :: (a -> Either String b) -> IO ()-  repl f = repl $ readShow f--readShow :: (Applicative f, Read a, Show b) => (a -> f b) -> String -> f String-readShow f = maybe (pure invalid) (fmap show) . fmap f . readMaybe+  pRepl :: String -> (a -> Either String b) -> IO ()+  pRepl p = pRepl p . readShowA  -- | Same as 'repl' with @(a -> b)@ function but the first argument is -- the value that will cause 'repl'' to exit. repl' :: (Eq a, Read a, Show b) => a -> (a -> b) -> IO ()-repl' stop f = repl f'-  where-    f' :: String -> Maybe String-    f' s = case readMaybe s of-      Nothing -> Just invalid-      Just x-        | x == stop -> Nothing-        | otherwise -> Just . show $ f x+repl' = pRepl' "" +pRepl' ::+  forall a b.+  (Eq a, Read a, Show b) =>+  -- | prompt+  String ->+  -- | value to stop+  a ->+  -- | function to transform the input+  (a -> b) ->+  IO ()+pRepl' p stop = pRepl p . readShowA . checkEq stop++checkEq :: Eq a => a -> (a -> b) -> a -> Maybe b+checkEq stop f x+  | x == stop = Nothing+  | otherwise = Just $ f x+ -- | 'ReplState' typeclass with polymorphic stateful function 'replState' -- to interactively evaluate input lines and print responses (see below). class ReplState a b s | b -> s where@@ -167,95 +222,117 @@   -- > replFold (+) 0   --   -- but replState is more flexible - state and output can be different types.-  replState :: (a -> b) -> s -> IO ()+  replState ::+    -- | state function (type defined by the instances)+    (a -> b) ->+    -- | initial state+    s ->+    IO ()+  replState = pReplState "" +  -- | 'replState' with prompt defined by the first argument+  pReplState :: String -> (a -> b) -> s -> IO ()+ -- | plain state function with 'String's as argument and result instance {-# OVERLAPPING #-} ReplState String (s -> (String, s)) s where-  replState :: (String -> s -> (String, s)) -> s -> IO ()-  replState f s0 = repl $ g s0-    where-      g _ [] = []-      g s (x : xs) = let (x', s') = f x s in x' : g s' xs+  pReplState :: String -> (String -> s -> (String, s)) -> s -> IO ()+  pReplState p = pReplState p . toState  -- | plain state function with argument and result of any 'Read'/'Show' types instance (Read a, Show b) => ReplState a (s -> (b, s)) s where-  replState :: (a -> s -> (b, s)) -> s -> IO ()-  replState f = replState f'-    where-      f' s st = case readMaybe s of-        Just x ->-          let (x', st') = f x st-           in (show x', st')-        Nothing -> (invalid, st)+  pReplState :: String -> (a -> s -> (b, s)) -> s -> IO ()+  pReplState p = pReplState p . toState +toState :: (a -> s -> (b, s)) -> (a -> State s b)+toState f = state . f+ -- | 'stdin'/'stdout' 'String's as lazy lists instance {-# OVERLAPPING #-} ReplState [String] (State s [String]) s where-  replState :: ([String] -> State s [String]) -> s -> IO ()-  replState f s0 = interact linesWithState-    where-      linesWithState str = unlines $ evalState (f $ lines str) s0+  pReplState :: String -> ([String] -> State s [String]) -> s -> IO ()+  pReplState p f s0 = pRepl p $ (`evalState` s0) . f  -- | Ctrl-D to exit instance (Read a, Show b) => ReplState a (State s b) s where-  replState :: (a -> State s b) -> s -> IO ()-  replState f = replState $ readShow f+  pReplState :: String -> (a -> State s b) -> s -> IO ()+  pReplState p = pReplState p . readShowA  -- | 'String's do not use 'read'/'show' instance {-# OVERLAPPING #-} ReplState String (State s String) s where-  replState :: (String -> State s String) -> s -> IO ()-  replState f = replState @[String] $ mapM f+  pReplState :: String -> (String -> State s String) -> s -> IO ()+  pReplState p = pReplState @[String] p . mapM  instance {-# OVERLAPPING #-} ReplState String (State s (Maybe String)) s where-  replState :: (String -> State s (Maybe String)) -> s -> IO ()-  replState f = replState $ fmap whileJust . mapM f+  pReplState ::+    String -> (String -> State s (Maybe String)) -> s -> IO ()+  pReplState p f = pReplState p $ fmap whileJust . mapM f  instance {-# OVERLAPPING #-} ReplState String (State s (Either String String)) s where-  replState :: (String -> State s (Either String String)) -> s -> IO ()-  replState f = replState $ fmap whileRight . mapM f+  pReplState ::+    String -> (String -> State s (Either String String)) -> s -> IO ()+  pReplState p f = pReplState p $ fmap whileRight . mapM f  -- | return 'Nothing' to exit instance {-# OVERLAPPING #-} (Read a, Show b) => ReplState a (State s (Maybe b)) s where-  replState :: (a -> State s (Maybe b)) -> s -> IO ()-  replState f = replState $ readShow' f+  pReplState :: String -> (a -> State s (Maybe b)) -> s -> IO ()+  pReplState p = pReplState p . readShowAA  -- | return 'Left' to exit, string in 'Left' is printed instance {-# OVERLAPPING #-} (Read a, Show b) => ReplState a (State s (Either String b)) s where-  replState :: (a -> State s (Either String b)) -> s -> IO ()-  replState f = replState $ readShow' f--readShow' ::-  (Monad f, Read a, Show b) => (a -> State s (f b)) -> String -> State s (f String)-readShow' f = maybe (pure $ pure invalid) (fmap $ fmap show) . fmap f . readMaybe+  pReplState :: String -> (a -> State s (Either String b)) -> s -> IO ()+  pReplState p = pReplState p . readShowAA  -- | Same as 'replState' with @(a -> State s b)@ function but the first -- argument is the value that will cause 'replState'' to exit. replState' ::-  forall a b s. (Eq a, Read a, Show b) => a -> (a -> State s b) -> s -> IO ()-replState' stop f = replState f'-  where-    f' :: String -> State s (Maybe String)-    f' s = case readMaybe s of-      Nothing -> pure $ Just invalid-      Just x-        | x == stop -> pure Nothing-        | otherwise -> Just . show <$> f x+  (Eq a, Read a, Show b) => a -> (a -> State s b) -> s -> IO ()+replState' = pReplState' "" +-- | 'replState'' with prompt+pReplState' ::+  forall a b s.+  (Eq a, Read a, Show b) =>+  -- | prompt+  String ->+  -- | value to stop+  a ->+  -- | state function+  (a -> State s b) ->+  -- | initial state+  s ->+  IO ()+pReplState' p stop f =+  pReplState p . readShowAA $+    sequence . checkEq stop f+ -- | 'replFold' combines the entered values with the accumulated value using -- provided function and prints the resulting values. replFold ::-  forall a b. (Read a, Show b) => (b -> a -> b) -> b -> IO ()-replFold f = replState f'-  where-    f' :: String -> b -> (String, b)-    f' s y = case readMaybe s of-      Nothing -> (invalid, y)-      Just x -> let y' = f y x in (show y', y')+  (Read a, Show b) => (b -> a -> b) -> b -> IO ()+replFold = pReplFold "" +-- | 'replFold' with prompt+pReplFold :: (Read a, Show b) => String -> (b -> a -> b) -> b -> IO ()+pReplFold p = pReplState p . readShowA . foldState++foldState :: (b -> a -> b) -> a -> State b b+foldState f x = modify (`f` x) >> get+ -- | Same as 'replFold' but the first argument is the value that will cause -- 'replFold'' to exit. replFold' ::-  forall a b. (Eq a, Read a, Show b) => a -> (b -> a -> b) -> b -> IO ()-replFold' stop f = replState' stop f'-  where-    f' :: a -> State b b-    f' x = modify (`f` x) >> get+  (Eq a, Read a, Show b) => a -> (b -> a -> b) -> b -> IO ()+replFold' = pReplFold' ""++-- | 'replFold'' with prompt+pReplFold' ::+  (Eq a, Read a, Show b) =>+  -- | prompt+  String ->+  -- | value to stop+  a ->+  -- | folding function+  (b -> a -> b) ->+  -- | initial value+  b ->+  IO ()+pReplFold' p stop = pReplState' p stop . foldState

@@ -119,12 +119,123 @@     it "sums of squares (stopped)" $       ["2", "5", "12", "0", "11"] #-> replFold' @Int 0 (flip ((+) . (^ (2 :: Int)))) 0         -># ["4", "29", "173"]+  describe "pRepl" do+    it "[String] -> [String]" $+      ["ab", "cdf", "", "efgh"] #-> pRepl ">" (map doubleString)+        ->># [">abab", ">cdfcdf", ">", ">efghefgh"]+    it "String -> String" $+      ["ab", "cdf", "", "efgh"] #-> pRepl ">" doubleString+        ->># [">abab", ">cdfcdf", ">", ">efghefgh"]+    it "String -> Maybe String" $+      ["ab", "cdf", "", "efgh"] #-> pRepl ">" maybeDoubleString+        ->># [">abab", ">cdfcdf"]+    it "String -> Either String String" $+      ["ab", "cdf", "", "efgh"] #-> pRepl ">" eitherDoubleString+        ->># [">abab", ">cdfcdf", ">bye"]+    it "[Int] -> [Int]" $+      ["2", "17", "0", "123"] #-> pRepl ">" (map doubleInt)+        ->># [">4", ">34", ">0", ">246"]+    it "[Int] -> [Int] (invalid input)" $+      ["2", "abc", "17", "0", "123"] #-> pRepl ">" (map doubleInt)+        ->># [">4", ">34", ">0", ">246"]+    it "Int -> Int" $+      ["2", "17", "0", "123"] #-> pRepl ">" doubleInt+        ->># [">4", ">34", ">0", ">246"]+    it "Int -> Int (invalid input)" $+      ["2", "abc", "17", "0", "123"] #-> pRepl ">" doubleInt+        ->># [">4", ">Invalid input", ">34", ">0", ">246"]+    it "Int -> Maybe Int" $+      ["2", "17", "0", "123"] #-> pRepl ">" maybeDoubleInt+        ->># [">4", ">34"]+    it "Int -> Maybe Int (invalid input) " $+      ["2", "abc", "17", "0", "123"] #-> pRepl ">" maybeDoubleInt+        ->># [">4", ">Invalid input", ">34"]+    it "Int -> Either String Int" $+      ["2", "17", "0", "123"] #-> pRepl ">" eitherDoubleInt+        ->># [">4", ">34", ">bye"]+    it "Int -> Either String Int (invalid input)" $+      ["2", "abc", "17", "0", "123"] #-> pRepl ">" eitherDoubleInt+        ->># [">4", ">Invalid input", ">34", ">bye"]+  describe "pRepl'" do+    it "0 -> Int -> Int" $+      ["2", "17", "0", "123"] #-> pRepl' ">" 0 doubleInt+        ->># [">4", ">34"]+    it "0 -> Int -> Int (invalid input)" $+      ["2", "abc", "17", "0", "123"] #-> pRepl' ">" 0 doubleInt+        ->># [">4", ">Invalid input", ">34"]+  describe "pReplState" do+    it "String -> Int -> (Int, String)" $+      ["2", "5", "12", "0", "11"] #-> pReplState ">" infAdderStrFunc 0+        ->># [">2", ">7", ">19", ">19", ">30"]+    it "String -> State Int String" $+      ["2", "5", "12", "0", "11"] #-> pReplState ">" infAdderStr 0+        ->># [">2", ">7", ">19", ">19", ">30"]+    it "String -> State Int (Maybe String)" $+      ["2", "5", "12", "0", "11"] #-> pReplState ">" adderStr 0+        ->># [">2", ">7", ">19"]+    it "String -> State Int (Either String String)" $+      ["2", "5", "12", "0", "11"] #-> pReplState ">" adderStrBye 0+        ->># [">2", ">7", ">19", ">bye"]+    it "Int -> Int -> (Int, Int)" $+      ["2", "5", "12", "0", "11"] #-> pReplState ">" infAdderFunc 0+        ->># [">2", ">7", ">19", ">19", ">30"]+    it "Int -> Int -> (Int, Int) (invlid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> pReplState ">" infAdderFunc 0+        ->># [">2", ">Invalid input", ">7", ">19", ">19", ">30"]+    it "Int -> State Int Int" $+      ["2", "5", "12", "0", "11"] #-> pReplState ">" infAdder 0+        ->># [">2", ">7", ">19", ">19", ">30"]+    it "Int -> State Int Int (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> pReplState ">" infAdder 0+        ->># [">2", ">Invalid input", ">7", ">19", ">19", ">30"]+    it "Int -> State Int (Maybe Int)" $+      ["2", "5", "12", "0", "11"] #-> pReplState ">" adder 0+        ->># [">2", ">7", ">19"]+    it "Int -> State Int (Maybe Int) (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> pReplState ">" adder 0+        ->># [">2", ">Invalid input", ">7", ">19"]+    it "Int -> State Int (Either String Int)" $+      ["2", "5", "12", "0", "11"] #-> pReplState ">" adderBye 0+        ->># [">2", ">7", ">19", ">bye"]+    it "Int -> State Int (Either String Int) (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> pReplState ">" adderBye 0+        ->># [">2", ">Invalid input", ">7", ">19", ">bye"]+  describe "pReplState'" do+    it "0 -> Int -> State Int Int" $+      ["2", "5", "12", "0", "11"] #-> pReplState' ">" 0 infAdder 0+        ->># [">2", ">7", ">19"]+    it "0 -> Int -> State Int Int (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> pReplState' ">" 0 infAdder 0+        ->># [">2", ">Invalid input", ">7", ">19"]+  describe "pReplFold" do+    it "Int -> Int -> Int" $+      ["2", "5", "12", "0", "11"] #-> pReplFold @Int ">" (+) 0+        ->># [">2", ">7", ">19", ">19", ">30"]+    it "Int -> Int -> Int (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> pReplFold @Int ">" (+) 0+        ->># [">2", ">Invalid input", ">7", ">19", ">19", ">30"]+    it "sums of squares" $+      ["2", "5", "12", "0", "11"] #-> pReplFold @Int ">" (flip ((+) . (^ (2 :: Int)))) 0+        ->># [">4", ">29", ">173", ">173", ">294"]+  describe "pReplFold'" do+    it "0 -> Int -> Int -> Int" $+      ["2", "5", "12", "0", "11"] #-> pReplFold' @Int ">" 0 (+) 0+        ->># [">2", ">7", ">19"]+    it "0 -> Int -> Int -> Int (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> pReplFold' @Int ">" 0 (+) 0+        ->># [">2", ">Invalid input", ">7", ">19"]+    it "sums of squares (stopped)" $+      ["2", "5", "12", "0", "11"] #-> pReplFold' @Int ">" 0 (flip ((+) . (^ (2 :: Int)))) 0+        ->># [">4", ">29", ">173"]  (#->) :: [String] -> IO () -> IO () (#->) = withStdin . pack . unlines  (->#) :: IO () -> [String] -> Expectation-testedIO -># expected = capture_ testedIO `shouldReturn` unlines expected+testIO -># expected = capture_ testIO `shouldReturn` unlines expected++(->>#) :: IO () -> [String] -> Expectation+testIO ->># expected = capture_ testIO `shouldReturn` ((++ ">") . unlines) expected  doubleString :: String -> String doubleString s = s ++ s