{-# language LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.ParseSR.IO
-- Copyright   :  (c) Fabricio Olivetti 2021 - 2024
-- License     :  BSD3
-- Maintainer  :  fabricio.olivetti@gmail.com
-- Stability   :  experimental
-- Portability :  ConstraintKinds
--
-- Functions to parse multiple expressions from stdin or a text file.
--
-----------------------------------------------------------------------------
module Text.ParseSR.IO ( withInput, withOutput, withOutputDebug )
    where

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

-- | given a filename, the symbolic regression algorithm,  a string of variables name, 
-- and two booleans indicating whether to convert float values to parameters and 
-- whether to simplify the expression or not, it will read the file and parse everything 
-- returning a list of either an error message or a tree.
--
-- empty filename defaults to stdin 
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
  h <- if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname then Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
stdin else String -> IOMode -> IO Handle
openFile String
fname IOMode
ReadMode
  contents <- hGetLines h 
  let myParserFun = SRAlgs
-> ByteString -> Bool -> ByteString -> Either String (Fix SRTree)
parseSR SRAlgs
sr (String -> ByteString
B.pack String
hd) Bool
param (ByteString -> Either String (Fix SRTree))
-> (String -> ByteString) -> String -> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack
      -- myParser = if simpl then fmap simplifyEqSat . myParserFun else myParserFun
      myParser = if Bool
simpl then (Fix SRTree -> Fix SRTree)
-> Either String (Fix SRTree) -> Either String (Fix SRTree)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix SRTree -> Fix SRTree
simplifyEqSatDefault (Either String (Fix SRTree) -> Either String (Fix SRTree))
-> (String -> Either String (Fix SRTree))
-> String
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Fix SRTree)
myParserFun else String -> Either String (Fix SRTree)
myParserFun
      es = (String -> Either String (Fix SRTree))
-> [String] -> [Either String (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String (Fix SRTree)
myParser ([String] -> [Either String (Fix SRTree)])
-> [String] -> [Either String (Fix SRTree)]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
contents
  unless (null fname) $ hClose h
  pure es

-- | outputs a list of either error or trees to a file using the Output format. 
--
-- empty filename defaults to stdout 
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
  h <- if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname then Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
stdout else String -> IOMode -> IO Handle
openFile String
fname IOMode
WriteMode
  forM_ exprs $ \case 
                   Left  String
err -> Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"invalid expression: " String -> String -> String
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)
  unless (null fname) $ hClose h

-- | debug version of output function to check the invalid parsers
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
  h <- if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fname then Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
stdout else String -> IOMode -> IO Handle
openFile String
fname IOMode
WriteMode
  forM_ exprs $ \case 
                   Left  String
err      -> Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"invalid expression: " String -> String -> String
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: " String -> String -> String
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: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Output -> Fix SRTree -> String
showOutput Output
output Fix SRTree
t2)
                                       Handle -> IO ()
hFlush Handle
h
  unless (null fname) $ hClose h

hGetLines :: Handle -> IO [String]
hGetLines :: Handle -> IO [String]
hGetLines Handle
h = do
  done <- Handle -> IO Bool
hIsEOF Handle
h
  if done
    then return []
    else do
      line <- hGetLine h
      (line :) <$> hGetLines h