{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      :  Data.Random.Distribution.MultivariateNormal
-- Copyright   :  (c) 2016 FP Complete Corporation
-- License     :  MIT (see LICENSE)
-- Maintainer  :  dominic@steinitz.org
module Q.Util.File (write)
  where

import Numeric.LinearAlgebra
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Csv
import Data.Char (ord)
import qualified Data.ByteString.Lazy as B
import Data.Random


rowToRecord :: (Show t) => [t] -> Record
rowToRecord :: [t] -> Record
rowToRecord [t]
x = [ByteString] -> Record
record ([ByteString] -> Record) -> [ByteString] -> Record
forall a b. (a -> b) -> a -> b
$ (t -> ByteString) -> [t] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ByteString
C.pack (String -> ByteString) -> (t -> String) -> t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall a. Show a => a -> String
show) [t]
x

write :: (Show t) => [[t]] -> [String] -> FilePath -> IO ()
write :: [[t]] -> [String] -> String -> IO ()
write [[t]]
m [String]
header String
path = do
  let out :: ByteString
out = (EncodeOptions -> [Record] -> ByteString
forall a. ToRecord a => EncodeOptions -> [a] -> ByteString
encodeWith EncodeOptions
opt [Record]
s) where
        opt :: EncodeOptions
opt = EncodeOptions
defaultEncodeOptions { encDelimiter :: Word8
encDelimiter = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
','), encQuoting :: Quoting
encQuoting = Quoting
QuoteNone }
        rows :: [Record]
        rows :: [Record]
rows = ([t] -> Record) -> [[t]] -> [Record]
forall a b. (a -> b) -> [a] -> [b]
map [t] -> Record
forall t. Show t => [t] -> Record
rowToRecord ([[t]] -> [Record]) -> [[t]] -> [Record]
forall a b. (a -> b) -> a -> b
$ [[t]]
m
        header_ :: Record
header_ = [ByteString] -> Record
record ([ByteString] -> Record) -> [ByteString] -> Record
forall a b. (a -> b) -> a -> b
$ (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
C.pack  [String]
header
        s :: [Record]
s = if Record -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Record
header_ then [Record]
rows else Record
header_Record -> [Record] -> [Record]
forall a. a -> [a] -> [a]
:[Record]
rows
  String -> ByteString -> IO ()
B.writeFile String
path ByteString
out