{-# LANGUAGE PackageImports, FlexibleContexts #-}
module Data.Array.Repa.IO.Vector
( readVectorFromTextFile
, writeVectorToTextFile)
where
import Data.Array.Repa as A
import Data.Array.Repa.Repr.Unboxed as A
import Data.Array.Repa.IO.Internals.Text
import Data.List as L
import Prelude as P
import System.IO
import Control.Monad
import Data.Char
readVectorFromTextFile
:: (Num e, Read e, Unbox e)
=> FilePath
-> IO (Array U DIM1 e)
readVectorFromTextFile :: forall e.
(Num e, Read e, Unbox e) =>
FilePath -> IO (Array U DIM1 e)
readVectorFromTextFile FilePath
fileName
= do Handle
handle <- FilePath -> IOMode -> IO Handle
openFile FilePath
fileName IOMode
ReadMode
FilePath
"VECTOR" <- Handle -> IO FilePath
hGetLine Handle
handle
[Int
len] <- (FilePath -> [Int]) -> IO FilePath -> IO [Int]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((FilePath -> Int) -> [FilePath] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
P.map FilePath -> Int
readInt ([FilePath] -> [Int])
-> (FilePath -> [FilePath]) -> FilePath -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words) (IO FilePath -> IO [Int]) -> IO FilePath -> IO [Int]
forall a b. (a -> b) -> a -> b
$ Handle -> IO FilePath
hGetLine Handle
handle
FilePath
str <- Handle -> IO FilePath
hGetContents Handle
handle
let vals :: [e]
vals = FilePath -> [e]
forall a. (Num a, Read a) => FilePath -> [a]
readValues FilePath
str
let dims :: DIM1
dims = Z
Z Z -> Int -> DIM1
forall tail head. tail -> head -> tail :. head
:. Int
len
Array U DIM1 e -> IO (Array U DIM1 e)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array U DIM1 e -> IO (Array U DIM1 e))
-> Array U DIM1 e -> IO (Array U DIM1 e)
forall a b. (a -> b) -> a -> b
$ DIM1 -> [e] -> Array U DIM1 e
forall sh a. (Shape sh, Unbox a) => sh -> [a] -> Array U sh a
fromListUnboxed DIM1
dims [e]
vals
readInt :: String -> Int
readInt :: FilePath -> Int
readInt FilePath
str
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
P.map Char -> Bool
isDigit FilePath
str
= FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
str
| Bool
otherwise
= FilePath -> Int
forall a. HasCallStack => FilePath -> a
error FilePath
"Data.Array.Repa.IO.Vector.readVectorFromTextFile parse error when reading data"
writeVectorToTextFile
:: (Show e, Source r e)
=> Array r DIM1 e
-> FilePath
-> IO ()
writeVectorToTextFile :: forall e r.
(Show e, Source r e) =>
Array r DIM1 e -> FilePath -> IO ()
writeVectorToTextFile Array r DIM1 e
arr FilePath
fileName
= do Handle
file <- FilePath -> IOMode -> IO Handle
openFile FilePath
fileName IOMode
WriteMode
Handle -> FilePath -> IO ()
hPutStrLn Handle
file FilePath
"VECTOR"
let Z
Z :. Int
len
= Array r DIM1 e -> DIM1
forall sh. Shape sh => Array r sh e -> sh
forall r e sh. (Source r e, Shape sh) => Array r sh e -> sh
extent Array r DIM1 e
arr
Handle -> FilePath -> IO ()
hPutStrLn Handle
file (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
len
Handle -> [e] -> IO ()
forall a. Show a => Handle -> [a] -> IO ()
hWriteValues Handle
file ([e] -> IO ()) -> [e] -> IO ()
forall a b. (a -> b) -> a -> b
$ Array r DIM1 e -> [e]
forall sh r e. (Shape sh, Source r e) => Array r sh e -> [e]
toList Array r DIM1 e
arr
Handle -> IO ()
hClose Handle
file
Handle -> IO ()
hFlush Handle
file