interact (empty) → 0.1.0.0

raw patch · 7 files changed

+533/−0 lines, 7 filesdep +basedep +bytestringdep +hspecsetup-changed

Dependencies added: base, bytestring, hspec, interact, main-tester, mtl, silently

Files

CHANGELOG.md +4/−0
LICENSE +21/−0
README.md +8/−0
Setup.hs +2/−0
interact.cabal +60/−0
src/System/IO/Interact.hs +261/−0
tests/Test.hs +177/−0

+ CHANGELOG.md view

@@ -0,0 +1,4 @@+# 0.1.0.0++- Initial release+- Includes `repl`, `replState` and `replFold` functions

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 Evgeny Poberezkin++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.md view

@@ -0,0 +1,8 @@+# interact++Functions to create interactive REPLs:+- stateless REPL from a single argument functions+- 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

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ interact.cabal view

@@ -0,0 +1,60 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: e748dd99c68b9226eb30badff724ac9fa45b88d6da96bd80cd0f7b4c8a715aa3++name:           interact+version:        0.1.0.0+synopsis:       instantly create REPL from any function+description:    This module provides functions to create interactive REPLs:+                .+                - stateless REPL from a single argument functions+                - REPL with state from plain state function or with State monad+                - REPL-fold from two-arguments functions, with the accumulator in the first argument+                .+                Each line you enter is 'read' into the argument type and sent to the function, with the result printed+category:       System, REPL+homepage:       https://github.com/epoberezkin/interact#readme+author:         Evgeny Poberezkin+maintainer:     evgeny@poberezkin.com+copyright:      2020 Evgeny Poberezkin+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++library+  exposed-modules:+      System.IO.Interact+  other-modules:+      Paths_interact+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns+  build-depends:+      base >=4.7 && <5+    , mtl ==2.2.*+  default-language: Haskell2010++test-suite interact-test+  type: exitcode-stdio-1.0+  main-is: Test.hs+  other-modules:+      Paths_interact+  hs-source-dirs:+      tests+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns+  build-depends:+      base >=4.7 && <5+    , bytestring ==0.10.*+    , hspec ==2.7.*+    , interact+    , main-tester ==0.2.*+    , mtl ==2.2.*+    , silently ==1.2.*+  default-language: Haskell2010

+ src/System/IO/Interact.hs view

@@ -0,0 +1,261 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : System.IO.Interact+-- Copyright   : (c) Evgeny Poberezkin+-- License     : MIT+--+-- Maintainer  : evgeny@poberezkin.com+-- Stability   : experimental+-- Portability : non-portable+--+-- This module provides functions to instantly create interactive REPL,+-- similar to Prelude 'interact' but with line-by-line processing:+--+-- - stateless REPL from a single argument functions+-- - REPL with state from plain state function or with State monad+-- - REPL-fold from two-arguments functions, with the accumulator in the first argument+--+-- Each line you enter is 'read' into the argument type and sent to the function, with the result printed.+module System.IO.Interact+  ( -- * Stateless REPL+    Repl,+    repl,+    repl',++    -- * REPL with state+    ReplState,+    replState,+    replState',++    -- * REPL-fold+    replFold,+    replFold',+  )+where++import Control.Monad.State+import Data.Either+import Data.Maybe+import Text.Read (readMaybe)++-- | 'Repl' typeclass with polymorphic stateless function 'repl' to interactively+-- evaluate input lines and print responses (see below).+class Repl a b where+  -- | Function passed to 'repl' will be called with values from 'stdin'+  -- ('String's or 'Read' instances, one value at a time or as a lazy list+  -- depending on the type of the function) and should return value+  -- to be printed to 'stdout' ('String' or 'Show' instance, possibly+  -- wrapped in 'Maybe' or 'Either', one value at a time or as a lazy list) .+  --+  -- Specific behaviour depends on function type (see instances above).+  --+  -- __Examples__:+  --+  -- Print square roots of the entered numbers:+  --+  -- > repl (sqrt :: Double -> Double)+  --+  -- Reverse entered strings:+  --+  -- > repl (reverse :: String -> String)+  --+  -- Prints both squares and square roots:+  --+  -- > sqrSqrt :: [Double] -> [Double]+  -- > sqrSqrt [] = []+  -- > sqrSqrt (x:xs) = x^2 : sqrt x : sqrSqrt xs+  -- > repl sqrSqrt+  repl :: (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++-- | '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++-- | 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++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++instance {-# OVERLAPPING #-} Repl String (Maybe String) where+  repl :: (String -> Maybe String) -> IO ()+  repl f = repl $ 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++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)++-- | 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++-- | 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++-- | 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++-- | '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+  -- | Function passed to 'replState' will be called with values from 'stdin'+  -- and previous state (depending on type, via State monad or+  -- as the first argument) and should return value to be printed to 'stdout'+  -- and the new state (either via State monad or as a tuple).+  --+  -- Specific behaviour depends on function type (see instances above).+  --+  -- __Examples__:+  --+  -- Prints sums of entered numbers:+  --+  -- > adder :: Int -> State Int Int+  -- > adder x = modify (+ x) >> get+  -- > replState adder 0+  --+  -- or with plain state function+  --+  -- > adder :: Int -> Int -> (Int, Int)+  -- > adder x s = let s' = s + x in (s', s')+  -- > replState adder 0+  --+  -- Above can be done with 'replFold' (see below):+  --+  -- > replFold (+) 0+  --+  -- but replState is more flexible - state and output can be different types.+  replState :: (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++-- | 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)++-- | '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++-- | 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++-- | '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++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++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++-- | 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++-- | 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++-- | 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++-- | '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')++-- | 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

+ tests/Test.hs view

@@ -0,0 +1,177 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++import Control.Monad.State+import Data.ByteString.Char8 (pack)+import System.IO.Interact+import System.IO.Silently (capture_)+import Test.Hspec+import Test.Main (withStdin)++main :: IO ()+main = hspec do+  describe "repl" do+    it "[String] -> [String]" $+      ["ab", "cdf", "", "efgh"] #-> repl (map doubleString)+        -># ["abab", "cdfcdf", "", "efghefgh"]+    it "String -> String" $+      ["ab", "cdf", "", "efgh"] #-> repl doubleString+        -># ["abab", "cdfcdf", "", "efghefgh"]+    it "String -> Maybe String" $+      ["ab", "cdf", "", "efgh"] #-> repl maybeDoubleString+        -># ["abab", "cdfcdf"]+    it "String -> Either String String" $+      ["ab", "cdf", "", "efgh"] #-> repl eitherDoubleString+        -># ["abab", "cdfcdf", "bye"]+    it "[Int] -> [Int]" $+      ["2", "17", "0", "123"] #-> repl (map doubleInt)+        -># ["4", "34", "0", "246"]+    it "[Int] -> [Int] (invalid input)" $+      ["2", "abc", "17", "0", "123"] #-> repl (map doubleInt)+        -># ["4", "34", "0", "246"]+    it "Int -> Int" $+      ["2", "17", "0", "123"] #-> repl doubleInt+        -># ["4", "34", "0", "246"]+    it "Int -> Int (invalid input)" $+      ["2", "abc", "17", "0", "123"] #-> repl doubleInt+        -># ["4", "Invalid input", "34", "0", "246"]+    it "Int -> Maybe Int" $+      ["2", "17", "0", "123"] #-> repl maybeDoubleInt+        -># ["4", "34"]+    it "Int -> Maybe Int (invalid input) " $+      ["2", "abc", "17", "0", "123"] #-> repl maybeDoubleInt+        -># ["4", "Invalid input", "34"]+    it "Int -> Either String Int" $+      ["2", "17", "0", "123"] #-> repl eitherDoubleInt+        -># ["4", "34", "bye"]+    it "Int -> Either String Int (invalid input)" $+      ["2", "abc", "17", "0", "123"] #-> repl eitherDoubleInt+        -># ["4", "Invalid input", "34", "bye"]+  describe "repl'" do+    it "0 -> Int -> Int" $+      ["2", "17", "0", "123"] #-> repl' 0 doubleInt+        -># ["4", "34"]+    it "0 -> Int -> Int (invalid input)" $+      ["2", "abc", "17", "0", "123"] #-> repl' 0 doubleInt+        -># ["4", "Invalid input", "34"]+  describe "replState" do+    it "String -> Int -> (Int, String)" $+      ["2", "5", "12", "0", "11"] #-> replState infAdderStrFunc 0+        -># ["2", "7", "19", "19", "30"]+    it "String -> State Int String" $+      ["2", "5", "12", "0", "11"] #-> replState infAdderStr 0+        -># ["2", "7", "19", "19", "30"]+    it "String -> State Int (Maybe String)" $+      ["2", "5", "12", "0", "11"] #-> replState adderStr 0+        -># ["2", "7", "19"]+    it "String -> State Int (Either String String)" $+      ["2", "5", "12", "0", "11"] #-> replState adderStrBye 0+        -># ["2", "7", "19", "bye"]+    it "Int -> Int -> (Int, Int)" $+      ["2", "5", "12", "0", "11"] #-> replState infAdderFunc 0+        -># ["2", "7", "19", "19", "30"]+    it "Int -> Int -> (Int, Int) (invlid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> replState infAdderFunc 0+        -># ["2", "Invalid input", "7", "19", "19", "30"]+    it "Int -> State Int Int" $+      ["2", "5", "12", "0", "11"] #-> replState infAdder 0+        -># ["2", "7", "19", "19", "30"]+    it "Int -> State Int Int (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> replState infAdder 0+        -># ["2", "Invalid input", "7", "19", "19", "30"]+    it "Int -> State Int (Maybe Int)" $+      ["2", "5", "12", "0", "11"] #-> replState adder 0+        -># ["2", "7", "19"]+    it "Int -> State Int (Maybe Int) (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> replState adder 0+        -># ["2", "Invalid input", "7", "19"]+    it "Int -> State Int (Either String Int)" $+      ["2", "5", "12", "0", "11"] #-> replState adderBye 0+        -># ["2", "7", "19", "bye"]+    it "Int -> State Int (Either String Int) (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> replState adderBye 0+        -># ["2", "Invalid input", "7", "19", "bye"]+  describe "replState'" do+    it "0 -> Int -> State Int Int" $+      ["2", "5", "12", "0", "11"] #-> replState' 0 infAdder 0+        -># ["2", "7", "19"]+    it "0 -> Int -> State Int Int (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> replState' 0 infAdder 0+        -># ["2", "Invalid input", "7", "19"]+  describe "replFold" do+    it "Int -> Int -> Int" $+      ["2", "5", "12", "0", "11"] #-> replFold @Int (+) 0+        -># ["2", "7", "19", "19", "30"]+    it "Int -> Int -> Int (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> replFold @Int (+) 0+        -># ["2", "Invalid input", "7", "19", "19", "30"]+    it "sums of squares" $+      ["2", "5", "12", "0", "11"] #-> replFold @Int (flip ((+) . (^ (2 :: Int)))) 0+        -># ["4", "29", "173", "173", "294"]+  describe "replFold'" do+    it "0 -> Int -> Int -> Int" $+      ["2", "5", "12", "0", "11"] #-> replFold' @Int 0 (+) 0+        -># ["2", "7", "19"]+    it "0 -> Int -> Int -> Int (invalid input)" $+      ["2", "abc", "5", "12", "0", "11"] #-> replFold' @Int 0 (+) 0+        -># ["2", "Invalid input", "7", "19"]+    it "sums of squares (stopped)" $+      ["2", "5", "12", "0", "11"] #-> replFold' @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++doubleString :: String -> String+doubleString s = s ++ s++maybeDoubleString :: String -> Maybe String+maybeDoubleString s = if null s then Nothing else Just $ s ++ s++eitherDoubleString :: String -> Either String String+eitherDoubleString s = if null s then Left "bye" else Right $ s ++ s++doubleInt :: Int -> Int+doubleInt x = x + x++maybeDoubleInt :: Int -> Maybe Int+maybeDoubleInt x = if x == 0 then Nothing else Just $ x + x++eitherDoubleInt :: Int -> Either String Int+eitherDoubleInt x = if x == 0 then Left "bye" else Right $ x + x++infAdderStrFunc :: String -> Int -> (String, Int)+infAdderStrFunc s y = let y' = y + read s in (show y', y')++infAdderStr :: String -> State Int String+infAdderStr s = modify (+ read s) >> gets show++adderStr :: String -> State Int (Maybe String)+adderStr s = case read s of+  0 -> return Nothing+  x -> modify (+ x) >> gets (Just . show)++adderStrBye :: String -> State Int (Either String String)+adderStrBye s = case read s of+  0 -> return $ Left "bye"+  x -> modify (+ x) >> gets (Right . show)++infAdderFunc :: Int -> Int -> (Int, Int)+infAdderFunc x y = let y' = y + x in (y', y')++infAdder :: Int -> State Int Int+infAdder x = modify (+ x) >> get++adder :: Int -> State Int (Maybe Int)+adder x+  | x == 0 = return Nothing+  | otherwise = modify (+ x) >> gets Just++adderBye :: Int -> State Int (Either String Int)+adderBye x+  | x == 0 = return $ Left "bye"+  | otherwise = modify (+ x) >> gets Right