<commit_before>module TclLib.IOCmds (ioCmds) where
import Common
import Control.Monad (unless, liftM2)
import System.IO
import System.Exit
import System.Directory (getCurrentDirectory,
                         doesFileExist, 
                         doesDirectoryExist,
                         getPermissions,
                         Permissions(..))
import Control.Exception (handle)
import Core ()
import qualified TclObj as T
import qualified TclChan as T
import qualified System.IO.Error as IOE 
import qualified Data.ByteString.Char8 as B
import TclObj ((.==))
import TclLib.LibUtil
import Util

ioCmds = nsCmdList "" $ safe ++ unsafe
 where safe = safeCmds [("puts",cmdPuts),("gets",cmdGets),("read",cmdRead),
                        ("close", cmdClose),("flush", cmdFlush),("eof", cmdEof)]
       unsafe = unsafeCmds [("exit", cmdExit), ("source", cmdSource),
                            ("pwd", cmdPwd), ("open", cmdOpen),("file", cmdFile)]

cmdEof args = case args of
  [ch] -> do h <- getReadable ch
             io (hIsEOF h) >>= return . T.fromBool 
  _    -> vArgErr "eof channelId"

cmdRead args = case args of
     [ch] -> do
        h <- getReadable ch
        c <- io $ B.hGetContents h
        return $ c `seq` T.fromBStr c
     _ -> argErr "read"

cmdFile = mkEnsemble "file" [
    ("channels", file_channels),
    pred_check "exists" (\fn -> liftM2 (||) (doesFileExist fn)
                                            (doesDirectoryExist fn)),
    pred_check "isfile" doesFileExist,
    pred_check "isdirectory" doesDirectoryExist,
    permtest "readable" readable,
    permtest "executable" executable,
    permtest "writable" writable]
 where permtest n a = pred_check n (get_perm a)
       get_perm a fn = handle (\_ -> return False) (getPermissions fn >>= return . a)
       pred_check n p = 
        let cmd args = case args of
             [name] -> (io $ p (T.asStr name)) >>= return . T.fromBool
             _   -> vArgErr $ "file " ++ n ++ " name"
        in (n,cmd)
 
file_channels args = case args of
   [] -> namesChan >>= return . T.fromBList
   _  -> vArgErr "file channels"


cmdPuts args = case args of
                 [s] -> tPutLn stdout s
                 [a1,str] -> if a1 .== "-nonewline" then tPut stdout str
                               else do h <- getWritable a1
                                       tPutLn h str
                 [a1,a2,str] ->do unless (a1 .== "-nonewline") bad
                                  h <- getWritable a2
                                  tPut h str 
                 _        -> bad
 where tPut = putFun B.hPutStr
       tPutLn = putFun B.hPutStrLn
       getWritable c = lookupChan (T.asBStr c) >>= checkWritable . T.chanHandle
       bad = vArgErr "puts ?-nonewline? ?channelId? string"
       putFun f h s = (io . f h . T.asBStr) s >> ret

cmdGets args = case args of
          [ch] -> do h <- getReadable ch
                     eof <- io (hIsEOF h)
                     if eof then ret else (io . B.hGetLine) h >>= treturn
          [ch,vname] -> do h <- getReadable ch
                           eof <- io (hIsEOF h)
                           if eof
                             then varSetNS (T.asVarName vname) (T.empty) >> return (T.fromInt (-1))
                             else do s <- io (B.hGetLine h)
                                     varSetNS (T.asVarName vname) (T.fromBStr s)<commit_msg>Added 'tell' and 'file size'.<commit_after>module TclLib.IOCmds (ioCmds) where
import Common
import Control.Monad (unless, liftM2)
import System.IO
import System.Exit
import System.Directory (getCurrentDirectory,
                         doesFileExist, 
                         doesDirectoryExist,
                         getPermissions,
                         Permissions(..))
import Control.Exception (handle,try)
import Core ()
import qualified TclObj as T
import qualified TclChan as T
import qualified System.IO.Error as IOE 
import qualified Data.ByteString.Char8 as B
import TclObj ((.==))
import TclLib.LibUtil
import Util

ioCmds = nsCmdList "" $ safe ++ unsafe
 where safe = safeCmds [("puts",cmdPuts),("gets",cmdGets),("read",cmdRead),
                        ("close", cmdClose),("flush", cmdFlush),("eof", cmdEof),
                        ("tell", cmdTell)]
       unsafe = unsafeCmds [("exit", cmdExit), ("source", cmdSource),
                            ("pwd", cmdPwd), ("open", cmdOpen),("file", cmdFile)]

cmdEof args = case args of
  [ch] -> do h <- getReadable ch
             io (hIsEOF h) >>= return . T.fromBool 
  _    -> vArgErr "eof channelId"

cmdTell args = case args of
  [ch] -> do h <- lookupChan (T.asBStr ch) >>= return . T.chanHandle
             io (hTell h) >>= return . T.fromInt . fromIntegral
  _    -> vArgErr "tell channelId"

cmdRead args = case args of
     [ch] -> do
        h <- getReadable ch
        c <- io $ B.hGetContents h
        return $ c `seq` T.fromBStr c
     _ -> argErr "read"

cmdFile = mkEnsemble "file" [
    ("channels", file_channels),
    ("size", file_size),
    pred_check "exists" (\fn -> liftM2 (||) (doesFileExist fn)
                                            (doesDirectoryExist fn)),
    pred_check "isfile" doesFileExist,
    pred_check "isdirectory" doesDirectoryExist,
    permtest "readable" readable,
    permtest "executable" executable,
    permtest "writable" writable]
 where permtest n a = pred_check n (get_perm a)
       get_perm a fn = handle (\_ -> return False) (getPermissions fn >>= return . a)
       pred_check n p = 
        let cmd args = case args of
             [name] -> (io $ p (T.asStr name)) >>= return . T.fromBool
             _   -> vArgErr $ "file " ++ n ++ " name"
        in (n,cmd)
 
file_channels args = case args of
   [] -> namesChan >>= return . T.fromBList
   _  -> vArgErr "file channels"

file_size args = case args of
   [n] -> do 
      let name = T.asStr n 
      esiz <- io $ try (withFile name ReadMode hFileSize)
      case esiz of
        Left _ -> tclErr $ "could not read " ++ show name ++ ": no such file or directory"
        Right siz -> return . T.fromInt . fromIntegral $ siz
   _ -> vArgErr "file size name"

cmdPuts args = case args of
                 [s] -> tPutLn stdout s
                 [a1,str] -> if a1 .== "-nonewline" then tPut stdout str
                               else do h <- getWritable a1
                                       tPutLn h str
                 [a1,a2,str] ->do unless (a1 .== "-nonewline") bad
                                  h <- getWritable a2
                                  tPut h str 
                 _        -> bad
 where tPut = putFun B.hPutStr
       tPutLn = putFun B.hPutStrLn
       getWritable c = lookupChan (T.asBStr c) >>= checkWritable . T.chanHandle
       bad = vArgErr "puts ?-nonewline? ?channelId? string"
       putFun f h s = (io . f h . T.asBStr) s >> ret

cmdGets args = case args of
          [ch] -> do h <- getReadable ch
                     eof <- io (hIsEOF h)
                     if eof then ret else (io . B.hGetLine) h >>= treturn
          [ch,vname] -> do h <- getReadable ch
                           eof <- io (hIsEOF h)
                           if eof
                             then varSetNS (T.asVarName vname) (T.empty) >> return (T.fromInt (-1))
                             else do s <- io (B.hGetLine h)
                                     varSetNS (T.asVarName vname) (T.fromBStr s)
{'fraction_non_alphanumeric': 0.11144130757800892, 'fraction_numerical': 0.0029717682020802376, 'mean_word_length': 1.653763440860215, 'pattern_counts': {'":': 1, '<': 25, '<?xml version=': 0, '>': 77, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 14, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4844829', 'n_tokens_mistral': 2308, 'n_tokens_neox': 2246, 'n_words': 700}