{-# language LambdaCase #-}
module Text.ParseSR.IO ( withInput, withOutput, withOutputDebug )
    where

import Control.Monad ( unless, forM_ )
import System.IO
import qualified Data.ByteString.Char8 as B
import Data.SRTree
import Data.SRTree.Recursion (Fix(..))
import Text.ParseSR ( SRAlgs, Output, parseSR, showOutput )

withInput :: String -> SRAlgs -> String -> Bool -> Bool -> IO [Either String (Fix SRTree)]
withInput :: String
-> SRAlgs
-> String
-> Bool
-> Bool
-> IO [Either String (Fix SRTree)]
withInput String
fname SRAlgs
sr String
hd Bool
param Bool
simpl = do
  Handle
h <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname then forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
stdin else String -> IOMode -> IO Handle
openFile String
fname IOMode
ReadMode
  [String]
contents <- Handle -> IO [String]
hGetLines Handle
h 
  let myParserFun :: String -> Either String (Fix SRTree)
myParserFun = SRAlgs
-> ByteString -> Bool -> ByteString -> Either String (Fix SRTree)
parseSR SRAlgs
sr (String -> ByteString
B.pack String
hd) Bool
param forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack
      myParser :: String -> Either String (Fix SRTree)
myParser = if Bool
simpl then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. a -> a
simplify forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Fix SRTree)
myParserFun else String -> Either String (Fix SRTree)
myParserFun
      es :: [Either String (Fix SRTree)]
es = forall a b. (a -> b) -> [a] -> [b]
map String -> Either String (Fix SRTree)
myParser forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
contents
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname) forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h
  forall (f :: * -> *) a. Applicative f => a -> f a
pure [Either String (Fix SRTree)]
es
  where simplify :: a -> a
simplify = forall {a}. a -> a
id

withOutput :: String -> Output -> [Either String (Fix SRTree)] -> IO ()
withOutput :: String -> Output -> [Either String (Fix SRTree)] -> IO ()
withOutput String
fname Output
output [Either String (Fix SRTree)]
exprs = do
  Handle
h <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname then forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
stdout else String -> IOMode -> IO Handle
openFile String
fname IOMode
WriteMode
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Either String (Fix SRTree)]
exprs forall a b. (a -> b) -> a -> b
$ \case 
                   Left  String
err -> Handle -> String -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ String
"invalid expression: " forall a. Semigroup a => a -> a -> a
<> String
err
                   Right Fix SRTree
ex  -> Handle -> String -> IO ()
hPutStrLn Handle
h (Output -> Fix SRTree -> String
showOutput Output
output Fix SRTree
ex)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname) forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h

withOutputDebug :: String -> Output -> [Either String (Fix SRTree, Fix SRTree)] -> IO ()
withOutputDebug :: String
-> Output -> [Either String (Fix SRTree, Fix SRTree)] -> IO ()
withOutputDebug String
fname Output
output [Either String (Fix SRTree, Fix SRTree)]
exprs = do
  Handle
h <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname then forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
stdout else String -> IOMode -> IO Handle
openFile String
fname IOMode
WriteMode
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Either String (Fix SRTree, Fix SRTree)]
exprs forall a b. (a -> b) -> a -> b
$ \case 
                   Left  String
err      -> Handle -> String -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ String
"invalid expression: " forall a. Semigroup a => a -> a -> a
<> String
err
                   Right (Fix SRTree
t1, Fix SRTree
t2) -> do 
                                       Handle -> String -> IO ()
hPutStrLn Handle
h (String
"First: " forall a. Semigroup a => a -> a -> a
<> Output -> Fix SRTree -> String
showOutput Output
output Fix SRTree
t1)
                                       Handle -> String -> IO ()
hPutStrLn Handle
h (String
"Second: " forall a. Semigroup a => a -> a -> a
<> Output -> Fix SRTree -> String
showOutput Output
output Fix SRTree
t2)
                                       Handle -> IO ()
hFlush Handle
h
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname) forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h

hGetLines :: Handle -> IO [String]
hGetLines :: Handle -> IO [String]
hGetLines Handle
h = do
  Bool
done <- Handle -> IO Bool
hIsEOF Handle
h
  if Bool
done
    then forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      String
line <- Handle -> IO String
hGetLine Handle
h
      (String
line forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO [String]
hGetLines Handle
h