-- | "System.IO" related functions.
module Music.Theory.Io where

import Control.Monad {- base -}
import System.IO {- base -}

import qualified Data.ByteString as B {- bytestring -}
import qualified System.Directory as D {- directory -}

import qualified Control.Monad.Loops as Loop {- monad-loops -}

import qualified Data.Text as T {- text -}
import qualified Data.Text.Encoding as T {- text -}
import qualified Data.Text.IO as T {- text -}

-- | 'T.decodeUtf8' of 'B.readFile', implemented via "Data.Text".
read_file_utf8_text :: FilePath -> IO T.Text
read_file_utf8_text :: FilePath -> IO Text
read_file_utf8_text = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
B.readFile

-- | Read (strictly) a UTF-8 encoded text file, implemented via "Data.Text".
read_file_utf8 :: FilePath -> IO String
read_file_utf8 :: FilePath -> IO FilePath
read_file_utf8 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
read_file_utf8_text

-- | 'read_file_utf8', or a default value if the file doesn't exist.
read_file_utf8_or :: String -> FilePath -> IO String
read_file_utf8_or :: FilePath -> FilePath -> IO FilePath
read_file_utf8_or FilePath
def FilePath
f = do
  Bool
x <- FilePath -> IO Bool
D.doesFileExist FilePath
f
  if Bool
x then FilePath -> IO FilePath
read_file_utf8 FilePath
f else forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
def

-- | Write UTF8 string as file, via "Data.Text".
write_file_utf8 :: FilePath -> String -> IO ()
write_file_utf8 :: FilePath -> FilePath -> IO ()
write_file_utf8 FilePath
fn = FilePath -> ByteString -> IO ()
B.writeFile FilePath
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack

-- | 'readFile' variant using 'T.Text' for @ISO 8859-1@ (Latin 1) encoding.
read_file_iso_8859_1 :: FilePath -> IO String
read_file_iso_8859_1 :: FilePath -> IO FilePath
read_file_iso_8859_1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
B.readFile

-- | 'readFile' variant using 'T.Text' for local encoding.
read_file_locale :: FilePath -> IO String
read_file_locale :: FilePath -> IO FilePath
read_file_locale = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
T.readFile

-- | Interact with files.  Like Prelude.interact, but with named files.
interactWithFiles :: FilePath -> FilePath -> (String -> String) -> IO ()
interactWithFiles :: FilePath -> FilePath -> (FilePath -> FilePath) -> IO ()
interactWithFiles FilePath
inputFile FilePath
outputFile FilePath -> FilePath
process = do
  FilePath
input <- FilePath -> IO FilePath
readFile FilePath
inputFile
  FilePath -> FilePath -> IO ()
writeFile FilePath
outputFile (FilePath -> FilePath
process FilePath
input)

-- | Get line from stdin if there is any input, else Nothing.
getLineFromStdinIfReady :: IO (Maybe String)
getLineFromStdinIfReady :: IO (Maybe FilePath)
getLineFromStdinIfReady = do
  Bool
r <- Handle -> IO Bool
hReady Handle
stdin
  if Bool
r then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (Handle -> IO FilePath
hGetLine Handle
stdin) else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Wait for input to be available, and then get lines while input remains available.
getAvailableLinesFromStdin :: IO [String]
getAvailableLinesFromStdin :: IO [FilePath]
getAvailableLinesFromStdin = do
  Bool
_ <- Handle -> Int -> IO Bool
hWaitForInput Handle
stdin (-Int
1)
  forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
Loop.unfoldM IO (Maybe FilePath)
getLineFromStdinIfReady

-- | Interact with stdin and stdout.  Like Prelude.interact, but with pipes.
interactWithStdio :: (String -> String) -> IO ()
interactWithStdio :: (FilePath -> FilePath) -> IO ()
interactWithStdio FilePath -> FilePath
strFunc = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO [FilePath]
getAvailableLinesFromStdin forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[FilePath]
ln -> Handle -> FilePath -> IO ()
hPutStrLn Handle
stdout (FilePath -> FilePath
strFunc ([FilePath] -> FilePath
unlines [FilePath]
ln)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout)