FileSystem.hs

module Interpreter.Lib.FileSystem where

import Control.Concurrent.STM (newTVarIO)
import Control.Monad.IO.Class
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
import Data.Coerce
import Data.Maybe (fromMaybe)
import Data.Text as T
import Data.Text.Encoding
import Data.Text.IO as T
import System.Directory
import qualified System.IO as SIO
import System.Posix.Directory as POSIX
import System.FilePath

import Interpreter.Common

builtInWriteFile :: BuiltInFnWithDoc '[ '("filename", FilePath), '("data", BytesOrText)]
builtInWriteFile ((coerce -> filepath) :> (coerce -> bot) :> EmptyArgs) = liftIO $ case bot of
  BTBytes bin -> do
      BS.writeFile filepath bin
      pure Nothing
  BTText dat -> do
      T.writeFile filepath dat
      pure Nothing

builtInReadFile :: BuiltInFnWithDoc '[ '("filename", FilePath)]
builtInReadFile ((coerce -> filepath) :> _) = liftIO $ do
  c <- BS.readFile filepath
  pure $ Just $ BytesValue c

builtInIsFile :: BuiltInFnWithDoc '[ '("filename", FilePath)]
builtInIsFile ((coerce -> filepath) :> _) = liftIO $ do
  c <- doesFileExist filepath
  pure $ Just $ BoolValue c

builtInIsDir :: BuiltInFnWithDoc '[ '("filename", FilePath)]
builtInIsDir ((coerce -> filepath) :> _) = liftIO $ do
  c <- doesDirectoryExist filepath
  pure $ Just $ BoolValue c

builtInOpenFileHandle :: BuiltInFnWithDoc '[ '("filepath", FilePath), '("openmode", Text) ]
builtInOpenFileHandle ((coerce -> filepath) :> (coerce -> (openmode :: Text)) :>  EmptyArgs) = liftIO $ do
  let
    oMode = case openmode of
      "r" -> SIO.ReadMode
      "w" -> SIO.WriteMode
      "a" -> SIO.AppendMode
      "rw" -> SIO.ReadWriteMode
      _ -> error "Unknown file open mode"
  handle <- SIO.openBinaryFile filepath oMode
  pure $ Just $ FileHandleValue $ FileHandle handle

builtInReadFileHandle :: BuiltInFnWithDoc '[ '("handle", SIO.Handle), '("length", Int) ]
builtInReadFileHandle ((coerce -> (handle :: SIO.Handle)) :> (coerce -> len) :> EmptyArgs) = liftIO $ do
  dat <- BSI.createAndTrim len (\buf -> SIO.hGetBuf handle buf len)
  pure $ Just $ BytesValue dat

builtInGetFileSize :: BuiltInFnWithDoc '[ '("handle", SIO.Handle) ]
builtInGetFileSize ((coerce -> (handle :: SIO.Handle)) :>  EmptyArgs) = liftIO $ do
  s <- SIO.hFileSize handle
  pure $ Just $ NumberValue $ NumberInt s

builtInWriteFileHandle :: BuiltInFnWithDoc '[ '("filepath", SIO.Handle), '("data", BS.ByteString) ]
builtInWriteFileHandle ((coerce -> (handle :: SIO.Handle)) :> (coerce -> dat) :> EmptyArgs) = liftIO $ do
  BS.useAsCString dat (\buf -> SIO.hPutBuf handle buf (BS.length dat))
  pure Nothing

builtInOpenDir :: BuiltInFnWithDoc '[ '("dirpath", FilePath), '("recursive", Maybe Bool)]
builtInOpenDir ((coerce -> filepath) :> (coerce -> mrecursive) :> _) = liftIO $ do
  afp <- makeAbsolute filepath
  ds <- POSIX.openDirStream filepath
  ref <- newTVarIO [DirStreamInfo (AbsoluteFilePath afp) (Just ds)]
  pure $ Just $ DirectoryStack $ DirHandleRef (fromMaybe False mrecursive) ref

builtInGetCurrentDir :: BuiltInFnWithDoc '[]
builtInGetCurrentDir _ = liftIO $ do
  Just . StringValue . T.pack <$> getCurrentDirectory

builtInReadTextFile :: BuiltInFnWithDoc '[ '("filename", FilePath)]
builtInReadTextFile ((coerce -> filepath) :> _) = do
  c <- decodeUtf8 <$> (liftIO $ BS.readFile filepath)
  pure $ Just $ StringValue c

builtInRenameFile :: BuiltInFnWithDoc '[ '("filename", FilePath), '("newfilename", FilePath)]
builtInRenameFile ((coerce -> filepath) :> (coerce -> newfile) :> _) = do
  liftIO $ renameFile filepath ((takeDirectory filepath) </> newfile)
  pure Nothing

builtInTakeFilename :: BuiltInFnWithDoc '[ '("filepath", FilePath)]
builtInTakeFilename ((coerce -> filepath) :> _) =
  pure $ Just $ StringValue $ T.pack $ takeFileName filepath

builtInTakeDirectory :: BuiltInFnWithDoc '[ '("filepath", FilePath)]
builtInTakeDirectory ((coerce -> filepath) :> _) =
  pure $ Just $ StringValue $ T.pack $ takeDirectory filepath

builtInTakeExtension :: BuiltInFnWithDoc '[ '("filepath", FilePath)]
builtInTakeExtension ((coerce -> filepath) :> _) =
  pure $ Just $ StringValue $ T.pack $ takeExtension filepath

builtInDropExtension :: BuiltInFnWithDoc '[ '("filepath", FilePath)]
builtInDropExtension ((coerce -> filepath) :> _) =
  pure $ Just $ StringValue $ T.pack $ dropExtension filepath

builtInTakeBaseName :: BuiltInFnWithDoc '[ '("filepath", FilePath)]
builtInTakeBaseName ((coerce -> filepath) :> _) =
  pure $ Just $ StringValue $ T.pack $ takeBaseName filepath

builtInJoinPaths :: BuiltInFnWithDoc '[ '("filepath", FilePath), '("filepath", FilePath)]
builtInJoinPaths ((coerce -> filepath1) :> (coerce -> filepath2) :> _) =
  pure $ Just $ StringValue $ T.pack $ filepath1 </> filepath2