{-# OPTIONS_GHC -Wall -fno-full-laziness #-}

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Read Binary NutMeg Data
module Data.NutMeg ( -- * Data Types
                     NutMeg, Plot, RealPlot, ComplexPlot, Wave (..), Flag (..), Field (..)
                   -- * Read raw binary data
                   , readFile
                   -- * Parsing NutMeg binary data
                   , extractPlots, extractPlot, parseHeader, readField
                   -- * Accessing Plot data
                   , asVector, vectorize, flattenPlots, flattenPlots'
                   , asRealPlot, asComplexPlot
                   -- * Utilities
                   , concat, isReal, isComplex, isReal', isComplex'
                   , byteSwap, castByteStringToVector
                   ) where

import           GHC.Generics
import           Control.DeepSeq
import           Control.Monad                    ((<$!>))
import           Data.Either
import           Data.Maybe                       (fromJust)
import           Data.Complex
import           Data.ByteString                  (ByteString)
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Char8      as CS
import           Data.ByteString.Internal         (c2w, isSpaceWord8, unsafePackLenBytes, toForeignPtr)
import           Data.ByteString.Unsafe           (unsafeIndex)
import           Data.Map                         (Map)
import qualified Data.Map                   as M
import           Data.Vector.Storable             (Storable, Vector, (!), (++))
import qualified Data.Vector.Storable       as V
import           Prelude                          hiding (readFile, (++), concat)
import           Foreign.ForeignPtr               (ForeignPtr, castForeignPtr)

-- | Swap Bytes of Big-Endian encoded ByteString
-- Thanks Noughtmare:
-- https://stackoverflow.com/a/71341067
byteSwap :: BS.ByteString -> BS.ByteString
byteSwap :: ByteString -> ByteString
byteSwap !ByteString
xs = Int -> [Word8] -> ByteString
unsafePackLenBytes (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
bytesPerReal Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bytesPerReal)
                                   [ ByteString -> Int -> Word8
unsafeIndex ByteString
xs (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bytesPerReal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j
                                   | Int
i <- [Item [Int]
0 .. Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
bytesPerReal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                                   , Int
j <- [Int
bytesPerReal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
bytesPerReal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 .. Item [Int]
0] ]
  where
    !len :: Int
len = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$! ByteString -> Int
BS.length ByteString
xs

-- | Swap bytes and  cast to vector (slow)
castByteStringToVector :: (Storable a) => BS.ByteString -> Vector a
castByteStringToVector :: ByteString -> Vector a
castByteStringToVector !ByteString
xs = Vector Word8 -> Vector a
forall a b. (Storable a, Storable b) => Vector a -> Vector b
V.unsafeCast Vector Word8
ys'
  where
    (ForeignPtr Word8
ptr, Int
off, Int
len) = ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr ByteString
xs
    xs' :: Vector Word8
xs' = ForeignPtr Word8 -> Int -> Int -> Vector Word8
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
V.unsafeFromForeignPtr ForeignPtr Word8
ptr Int
off Int
len
    ys' :: Vector Word8
ys' = [Vector Word8] -> Vector Word8
forall a. Storable a => [Vector a] -> Vector a
V.concat [ Vector Word8 -> Vector Word8
forall a. Storable a => Vector a -> Vector a
V.reverse (Vector Word8 -> Vector Word8) -> Vector Word8 -> Vector Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Word8 -> Vector Word8
forall a. Storable a => Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
idx Int
bytesPerReal Vector Word8
xs'
                   | Int
idx <- [Item [Int]
0, Int
Item [Int]
bytesPerReal .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]

-- | Data Field identifier in NutMeg (binary) Files
data Field = Title       -- ^ Title of the @'NutMeg'@ file, usually first line of netlist
           | Date        -- ^ Date of creation
           | Plotname    -- ^ Name of a @'Plot'@
           | Flags       -- ^ Whether the @'Plot'@ is @'Real'@ or @'Complex'@
           | NoVariables -- ^ No. Variables in the @'Plot'@
           | NoPoints    -- ^ No. Points per Variable
           | Variables   -- ^ String representation of Variables in the @'Plot'@
           | Binary      -- ^ Binary Data, 'Double' or 'Complex Double' encoded in Big Endian
    deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Int -> Field
Field -> Int
Field -> [Field]
Field -> Field
Field -> Field -> [Field]
Field -> Field -> Field -> [Field]
(Field -> Field)
-> (Field -> Field)
-> (Int -> Field)
-> (Field -> Int)
-> (Field -> [Field])
-> (Field -> Field -> [Field])
-> (Field -> Field -> [Field])
-> (Field -> Field -> Field -> [Field])
-> Enum Field
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Field -> Field -> Field -> [Field]
$cenumFromThenTo :: Field -> Field -> Field -> [Field]
enumFromTo :: Field -> Field -> [Field]
$cenumFromTo :: Field -> Field -> [Field]
enumFromThen :: Field -> Field -> [Field]
$cenumFromThen :: Field -> Field -> [Field]
enumFrom :: Field -> [Field]
$cenumFrom :: Field -> [Field]
fromEnum :: Field -> Int
$cfromEnum :: Field -> Int
toEnum :: Int -> Field
$ctoEnum :: Int -> Field
pred :: Field -> Field
$cpred :: Field -> Field
succ :: Field -> Field
$csucc :: Field -> Field
Enum, Eq Field
Eq Field
-> (Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmax :: Field -> Field -> Field
>= :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c< :: Field -> Field -> Bool
compare :: Field -> Field -> Ordering
$ccompare :: Field -> Field -> Ordering
$cp1Ord :: Eq Field
Ord, Field
Field -> Field -> Bounded Field
forall a. a -> a -> Bounded a
maxBound :: Field
$cmaxBound :: Field
minBound :: Field
$cminBound :: Field
Bounded, (forall x. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field x -> Field
$cfrom :: forall x. Field -> Rep Field x
Generic, Field -> ()
(Field -> ()) -> NFData Field
forall a. (a -> ()) -> NFData a
rnf :: Field -> ()
$crnf :: Field -> ()
NFData)

instance Show Field where
  show :: Field -> String
show Field
Title       = String
"Title:"
  show Field
Date        = String
"Date:"
  show Field
Plotname    = String
"Plotname:"
  show Field
Flags       = String
"Flags:"
  show Field
NoVariables = String
"No. Variables:"
  show Field
NoPoints    = String
"No. Points:"
  show Field
Variables   = String
"Variables:"
  show Field
Binary      = String
"Binary:"

-- | Flag indicating whether a plot is real or complex valued
data Flag = Real'    -- ^ Real valued ('Double') plot
          | Complex' -- ^ Complex valued ('Complex Double') plot
    deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Flag
Flag -> Flag -> Bounded Flag
forall a. a -> a -> Bounded a
maxBound :: Flag
$cmaxBound :: Flag
minBound :: Flag
$cminBound :: Flag
Bounded, (forall x. Flag -> Rep Flag x)
-> (forall x. Rep Flag x -> Flag) -> Generic Flag
forall x. Rep Flag x -> Flag
forall x. Flag -> Rep Flag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flag x -> Flag
$cfrom :: forall x. Flag -> Rep Flag x
Generic, Flag -> ()
(Flag -> ()) -> NFData Flag
forall a. (a -> ()) -> NFData a
rnf :: Flag -> ()
$crnf :: Flag -> ()
NFData)

instance Read Flag where
  readsPrec :: Int -> ReadS Flag
readsPrec Int
_ String
"real"    = [(Flag
Real', String
"")]
  readsPrec Int
_ String
"complex" = [(Flag
Complex', String
"")]
  readsPrec Int
_ String
_         = [(Flag, String)]
forall a. HasCallStack => a
undefined

instance Show Flag where
  show :: Flag -> String
show Flag
Real'    = String
"real"
  show Flag
Complex' = String
"complex"

-- | Wrapper around Real or Complex valued Vector, so they can be stored in the
-- same List.
data Wave = RealWave    {-# UNPACK #-} !(Vector Double)           -- ^ Real valued ('Double') wave form
          | ComplexWave {-# UNPACK #-} !(Vector (Complex Double)) -- ^ Complex valued ('Complex Double') wave form
    deriving (Int -> Wave -> ShowS
[Wave] -> ShowS
Wave -> String
(Int -> Wave -> ShowS)
-> (Wave -> String) -> ([Wave] -> ShowS) -> Show Wave
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wave] -> ShowS
$cshowList :: [Wave] -> ShowS
show :: Wave -> String
$cshow :: Wave -> String
showsPrec :: Int -> Wave -> ShowS
$cshowsPrec :: Int -> Wave -> ShowS
Show, Wave -> Wave -> Bool
(Wave -> Wave -> Bool) -> (Wave -> Wave -> Bool) -> Eq Wave
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wave -> Wave -> Bool
$c/= :: Wave -> Wave -> Bool
== :: Wave -> Wave -> Bool
$c== :: Wave -> Wave -> Bool
Eq, (forall x. Wave -> Rep Wave x)
-> (forall x. Rep Wave x -> Wave) -> Generic Wave
forall x. Rep Wave x -> Wave
forall x. Wave -> Rep Wave x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Wave x -> Wave
$cfrom :: forall x. Wave -> Rep Wave x
Generic, Wave -> ()
(Wave -> ()) -> NFData Wave
forall a. (a -> ()) -> NFData a
rnf :: Wave -> ()
$crnf :: Wave -> ()
NFData)

-- | A /Plot/ inside a @'NutMeg'@ file consists of uniquely identified waveforms:
-- @[(Variable Name, Waveform)]@
type Plot        = Map String Wave

-- | Type alias for real valued @'Plot'@
type RealPlot    = Map String (Vector Double)

-- | Type alias for complex valued @'Plot'@
type ComplexPlot = Map String (Vector (Complex Double))

-- | A NutMeg file consists of a list of @'Plot'@s
-- @[(Plotname, @'Plot'@)]
-- Plotnames do /not/ have to be unique in a NutMeg file. Data may be lost by
-- turning this into a 'Map'.
type NutMeg = [(String, Plot)]

-- | Number of bytes per @'Double'@
-- bytesPerReal :: Int64
bytesPerReal :: Int
bytesPerReal :: Int
bytesPerReal = Int
8

-- | Transpose Rows / Columns
r2c :: (Storable a) => Int -> Int -> Vector a -> [Vector a]
r2c :: Int -> Int -> Vector a -> [Vector a]
r2c Int
numVars Int
numPoints !Vector a
wave' = [Vector a]
waves
  where
    r2c' :: Int -> Vector a
r2c' Int
v = [a] -> Vector a
forall a. Storable a => [a] -> Vector a
V.fromList ([a] -> Vector a) -> [a] -> Vector a
forall a b. (a -> b) -> a -> b
$ (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((Vector a
wave' Vector a -> Int -> a
forall a. Storable a => Vector a -> Int -> a
!) (Int -> a) -> (Int -> Int) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v)) [Item [Int]
0, Int
Item [Int]
numVars .. Int
numPoints Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numVars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    waves :: [Vector a]
waves  = (Int -> Vector a) -> [Int] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Vector a
r2c' [Item [Int]
0 .. Int
numVars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

-- | Check whether waveform is real valued
isReal' :: Wave -> Bool
isReal' :: Wave -> Bool
isReal' (RealWave Vector Double
_) = Bool
True
isReal' Wave
_            = Bool
False

-- | Check whether waveform is complex valued
isComplex' :: Wave -> Bool
isComplex' :: Wave -> Bool
isComplex' = Bool -> Bool
not (Bool -> Bool) -> (Wave -> Bool) -> Wave -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wave -> Bool
isReal'

-- | Check whether Plot is real valued
isReal :: Plot -> Bool
isReal :: Plot -> Bool
isReal = (Wave -> Bool) -> [Wave] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Wave -> Bool
isReal' ([Wave] -> Bool) -> (Plot -> [Wave]) -> Plot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plot -> [Wave]
forall k a. Map k a -> [a]
M.elems

-- | Check whether Plot is complex valued
isComplex :: Plot -> Bool
isComplex :: Plot -> Bool
isComplex = Bool -> Bool
not (Bool -> Bool) -> (Plot -> Bool) -> Plot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plot -> Bool
isReal

-- | Convert Waveform to unboxed 'Vector', fails horribly if types are incorrect
asVector :: Wave -> Either (Vector (Complex Double)) (Vector Double)
asVector :: Wave -> Either (Vector (Complex Double)) (Vector Double)
asVector (RealWave    Vector Double
w) = Vector Double -> Either (Vector (Complex Double)) (Vector Double)
forall a b. b -> Either a b
Right Vector Double
w
asVector (ComplexWave Vector (Complex Double)
w) = Vector (Complex Double)
-> Either (Vector (Complex Double)) (Vector Double)
forall a b. a -> Either a b
Left  Vector (Complex Double)
w

-- | Get rid of @'Wave'@ type and convert to either 'Complex Double' or
-- 'Double' Vector, depending on Wave type.
vectorize :: Plot -> Either ComplexPlot RealPlot
vectorize :: Plot -> Either ComplexPlot RealPlot
vectorize Plot
p | ComplexPlot -> Bool
forall k a. Map k a -> Bool
M.null ComplexPlot
complexPlots = RealPlot -> Either ComplexPlot RealPlot
forall a b. b -> Either a b
Right RealPlot
realPlots
            | Bool
otherwise           = ComplexPlot -> Either ComplexPlot RealPlot
forall a b. a -> Either a b
Left ComplexPlot
complexPlots
  where
    (ComplexPlot
complexPlots, RealPlot
realPlots) = (Wave -> Either (Vector (Complex Double)) (Vector Double))
-> Plot -> (ComplexPlot, RealPlot)
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
M.mapEither Wave -> Either (Vector (Complex Double)) (Vector Double)
asVector Plot
p

-- | Unsafe extraction of 'Right' value for real valued plots. Check with
-- @'isReal'@ before using, to be sure
asRealPlot :: Plot -> RealPlot
asRealPlot :: Plot -> RealPlot
asRealPlot Plot
plot = RealPlot
plot'
  where
    (Right RealPlot
plot') = Plot -> Either ComplexPlot RealPlot
vectorize Plot
plot

-- | Unsafe extraction of 'Left' value for complex valued plots. Check with
-- @'isComplex'@ before using, to be sure
asComplexPlot :: Plot -> ComplexPlot
asComplexPlot :: Plot -> ComplexPlot
asComplexPlot Plot
plot = ComplexPlot
plot'
  where
    (Left ComplexPlot
plot') = Plot -> Either ComplexPlot RealPlot
vectorize Plot
plot

-- | Joins two @'Wave'@s of the same type: @wave1 ++ wave2@
-- Attempting to concatenate a Real and Complex wave will result in an error
concat :: Wave -> Wave -> Wave
concat :: Wave -> Wave -> Wave
concat (RealWave    Vector Double
a) (RealWave    Vector Double
b) = Vector Double -> Wave
RealWave    (Vector Double
a Vector Double -> Vector Double -> Vector Double
forall a. Storable a => Vector a -> Vector a -> Vector a
++ Vector Double
b)
concat (ComplexWave Vector (Complex Double)
a) (ComplexWave Vector (Complex Double)
b) = Vector (Complex Double) -> Wave
ComplexWave (Vector (Complex Double)
a Vector (Complex Double)
-> Vector (Complex Double) -> Vector (Complex Double)
forall a. Storable a => Vector a -> Vector a -> Vector a
++ Vector (Complex Double)
b)
concat Wave
_               Wave
_               = String -> Wave
forall a. HasCallStack => String -> a
error String
"Cannot concatenate Real and Complex Waves"

-- | Concatenate waves of all @'Plot'@s in @'NutMeg'@. Probably won't work as intended
-- when variable names of the @'Plot'@s don't line up
flattenPlots' :: NutMeg -> Plot
flattenPlots' :: NutMeg -> Plot
flattenPlots' = (Wave -> Wave -> Wave) -> [Plot] -> Plot
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith Wave -> Wave -> Wave
concat ([Plot] -> Plot) -> (NutMeg -> [Plot]) -> NutMeg -> Plot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Plot) -> Plot) -> NutMeg -> [Plot]
forall a b. (a -> b) -> [a] -> [b]
map (String, Plot) -> Plot
forall a b. (a, b) -> b
snd

-- | Concatenate the @'Wave'@s of a given list of @'Plot'@ names. This will
-- only work if the keys line up.
flattenPlots :: [String] -> NutMeg -> Plot
flattenPlots :: [String] -> NutMeg -> Plot
flattenPlots ![String]
plotNames !NutMeg
nut = NutMeg -> Plot
flattenPlots' (NutMeg -> Plot) -> NutMeg -> Plot
forall a b. (a -> b) -> a -> b
$ ((String, Plot) -> Bool) -> NutMeg -> NutMeg
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
plotNames) (String -> Bool)
-> ((String, Plot) -> String) -> (String, Plot) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Plot) -> String
forall a b. (a, b) -> a
fst) NutMeg
nut

-- | Read a @'NutMeg'@ field from a ByteString
readField :: Field -> ByteString -> String
readField :: Field -> ByteString -> String
readField !Field
nf !ByteString
bs = ByteString -> String
CS.unpack (ByteString -> String)
-> (Maybe ByteString -> ByteString) -> Maybe ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isSpaceWord8 (ByteString -> ByteString)
-> (Maybe ByteString -> ByteString)
-> Maybe ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> String) -> Maybe ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Maybe ByteString
BS.stripPrefix ByteString
nfn ByteString
bs
  where 
    nfn :: ByteString
nfn = String -> ByteString
CS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Field -> String
forall a. Show a => a -> String
show Field
nf

-- | Extract @'Plot'@ header information:
-- @((Plotname, 'Flag', No. Variables, No. Points), [Variable Names])@
parseHeader :: [ByteString] -> ((String, Flag, Int, Int),  [String])
parseHeader :: [ByteString] -> ((String, Flag, Int, Int), [String])
parseHeader ![ByteString]
hdr = ((String, Flag, Int, Int)
h, [String]
var')
  where
    hdr' :: [String]
hdr' = (Field -> ByteString -> String)
-> [Field] -> [ByteString] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Field -> ByteString -> String
readField [ Item [Field]
Field
Plotname .. Item [Field]
Field
NoPoints ] [ByteString]
hdr
    h :: (String, Flag, Int, Int)
h    = ( [String] -> String
forall a. [a] -> a
head [String]
hdr'
           , String -> Flag
forall a. Read a => String -> a
read ([String]
hdr' [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1)
           , Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read ([String]
hdr' [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
2)
           , Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read ([String]
hdr' [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
3) )
    vars :: [ByteString]
vars = Word8 -> ByteString -> ByteString
BS.cons (Char -> Word8
c2w Char
'\t')
                   (Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (ByteString -> ByteString -> Maybe ByteString
BS.stripPrefix (String -> ByteString
CS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Field -> String
forall a. Show a => a -> String
show Field
Variables) ([ByteString]
hdr [ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! Int
4)))
         ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
5 [ByteString]
hdr
    var' :: [String]
var' = (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
CS.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ve) [ByteString]
vars
    ve :: ByteString -> ByteString
ve ByteString
s = (Word8 -> Bool) -> ByteString -> ByteString
BS.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
'\t') (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> Int -> Int
forall a. [a] -> Int -> a
!! Int
2)
         ([Int] -> Int) -> (ByteString -> [Int]) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [Int]
BS.elemIndices (Char -> Word8
c2w Char
'\t') (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ ByteString
s) ByteString
s

-- | Extract the wave forms from binary data given header information
extractPlot :: Flag       -- ^ Real or Complex Data
             -> Int        -- ^ No. Variables
             -> Int        -- ^ No. Points
             -> ByteString -- ^ Binary Data
             -> [Wave]     -- ^ Wave forms
extractPlot :: Flag -> Int -> Int -> ByteString -> [Wave]
extractPlot Flag
Real'    !Int
numVars !Int
numPoints !ByteString
bin = Vector Double -> [Wave] -> [Wave]
seq Vector Double
wave' [Wave]
waves
  where
    -- !wave' = V.generate (numVars * numPoints)
    --        $ \i -> runGet getDoublebe $ BL.drop (fromIntegral i * bytesPerReal) bin
    -- !wave' = V.unsafeCast . V.fromList $ byteSwap' bin :: V.Vector Double
    -- !wave' = castByteStringToVector bin
    (ForeignPtr Word8
ptr', Int
off, Int
len') = ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr (ByteString -> (ForeignPtr Word8, Int, Int))
-> ByteString -> (ForeignPtr Word8, Int, Int)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
byteSwap ByteString
bin
    len :: Int
len               = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
len' Int
bytesPerReal
    ptr :: ForeignPtr Double
ptr               = ForeignPtr Word8 -> ForeignPtr Double
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
ptr' :: ForeignPtr Double
    !wave' :: Vector Double
wave'            = ForeignPtr Double -> Int -> Int -> Vector Double
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
V.unsafeFromForeignPtr ForeignPtr Double
ptr Int
off Int
len
    !waves :: [Wave]
waves            = (Vector Double -> Wave) -> [Vector Double] -> [Wave]
forall a b. (a -> b) -> [a] -> [b]
map Vector Double -> Wave
RealWave ([Vector Double] -> [Wave]) -> [Vector Double] -> [Wave]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Double -> [Vector Double]
forall a. Storable a => Int -> Int -> Vector a -> [Vector a]
r2c Int
numVars Int
numPoints Vector Double
wave'
        -- map RealWave . A.toRows $ A.fromVector (numPoints,numVars) wave'
extractPlot Flag
Complex' !Int
numVars !Int
numPoints !ByteString
bin = Vector (Complex Double) -> [Wave] -> [Wave]
seq Vector (Complex Double)
wave' [Wave]
waves
  where
    -- !wave' = V.generate (numVars * numPoints)
    --       $ \i -> let i'   = fromIntegral $ i * 2
    --                   real = runGet getDoublebe $ BL.drop (i' * bytesPerReal) bin
    --                   imag = runGet getDoublebe $ BL.drop ((i' + 1) * bytesPerReal) bin
    --                in (real:+imag)
    -- !wave' = V.unsafeCast . V.fromList $ byteSwap' bin :: V.Vector (Complex Double)
    -- !wave' = castByteStringToVector bin
    (ForeignPtr Word8
ptr', Int
off, Int
len') = ByteString -> (ForeignPtr Word8, Int, Int)
toForeignPtr (ByteString -> (ForeignPtr Word8, Int, Int))
-> ByteString -> (ForeignPtr Word8, Int, Int)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
byteSwap ByteString
bin
    len :: Int
len               = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
len' (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bytesPerReal)
    ptr :: ForeignPtr (Complex Double)
ptr               = ForeignPtr Word8 -> ForeignPtr (Complex Double)
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
ptr' :: ForeignPtr (Complex Double)
    !wave' :: Vector (Complex Double)
wave'            = ForeignPtr (Complex Double)
-> Int -> Int -> Vector (Complex Double)
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
V.unsafeFromForeignPtr ForeignPtr (Complex Double)
ptr Int
off Int
len
    !waves :: [Wave]
waves            = (Vector (Complex Double) -> Wave)
-> [Vector (Complex Double)] -> [Wave]
forall a b. (a -> b) -> [a] -> [b]
map Vector (Complex Double) -> Wave
ComplexWave ([Vector (Complex Double)] -> [Wave])
-> [Vector (Complex Double)] -> [Wave]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector (Complex Double) -> [Vector (Complex Double)]
forall a. Storable a => Int -> Int -> Vector a -> [Vector a]
r2c Int
numVars Int
numPoints Vector (Complex Double)
wave'
        -- map ComplexWave . A.toRows $ A.fromVector (numPoints,numVars) wave'

-- | Read The first plot encountered in ByteString String:
-- @((Plotname, 'Plot'), Remianing ByteString)@
extractPlots :: ByteString -> NutMeg -> NutMeg
extractPlots :: ByteString -> NutMeg -> NutMeg
extractPlots !ByteString
bs !NutMeg
nut | ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"Plotname:" ByteString
bs = ByteString -> NutMeg -> NutMeg
seq ByteString
rest (NutMeg -> NutMeg) -> (NutMeg -> NutMeg) -> NutMeg -> NutMeg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plot -> NutMeg -> NutMeg
seq Plot
plot (NutMeg -> NutMeg) -> NutMeg -> NutMeg
forall a b. (a -> b) -> a -> b
$ ByteString -> NutMeg -> NutMeg
extractPlots ByteString
rest NutMeg
nut'
                      | Bool
otherwise                    = NutMeg
nut
  where
    hdr :: [ByteString]
hdr  = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"Binary:") ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
CS.lines ByteString
bs
    ((String
plotName, Flag
flag, Int
numVars, Int
numPoints), [String]
varNames) = [ByteString] -> ((String, Flag, Int, Int), [String])
parseHeader [ByteString]
hdr
    n :: Int
n    = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8) (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
CS.unlines [ByteString]
hdr 
    b :: Int
b    = if Flag
flag Flag -> Flag -> Bool
forall a. Eq a => a -> a -> Bool
== Flag
Real' then Int
bytesPerReal else Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bytesPerReal
    n' :: Int
n'   = Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numVars Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numPoints
    bin :: ByteString
bin  = Int -> ByteString -> ByteString
BS.take Int
n' (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
n ByteString
bs
    plot :: Plot
plot = [(String, Wave)] -> Plot
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Wave)] -> Plot)
-> ([Wave] -> [(String, Wave)]) -> [Wave] -> Plot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Wave] -> [(String, Wave)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
varNames ([Wave] -> Plot) -> [Wave] -> Plot
forall a b. (a -> b) -> a -> b
$! Flag -> Int -> Int -> ByteString -> [Wave]
extractPlot Flag
flag Int
numVars Int
numPoints ByteString
bin
    rest :: ByteString
rest = Int -> ByteString -> ByteString
BS.drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n') ByteString
bs
    nut' :: NutMeg
nut' = (String
plotName, Plot
plot) (String, Plot) -> NutMeg -> NutMeg
forall a. a -> [a] -> [a]
: NutMeg
nut

-- | Read a binary nutmeg .raw file
readFile :: FilePath -> IO NutMeg
readFile :: String -> IO NutMeg
readFile !String
path = do
    !NutMeg
plots <- (ByteString -> NutMeg -> NutMeg) -> NutMeg -> ByteString -> NutMeg
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> NutMeg -> NutMeg
extractPlots [] (ByteString -> NutMeg)
-> (ByteString -> ByteString) -> ByteString -> NutMeg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
CS.unlines ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
2 ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
CS.lines (ByteString -> NutMeg) -> IO ByteString -> IO NutMeg
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> String -> IO ByteString
BS.readFile String
path
    NutMeg -> IO NutMeg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NutMeg -> IO NutMeg) -> NutMeg -> IO NutMeg
forall a b. (a -> b) -> a -> b
$! NutMeg
plots