{-# LANGUAGE FlexibleInstances, UndecidableInstances, EmptyDataDecls #-}
module Data.NetCDF.Metadata
( Name
, NcDim (..)
, NcAttr (..), ToNcAttr (..), FromNcAttr (..)
, NcVar (..)
, NcInfo (..), NcRead, NcWrite
, ncDim, ncAttr, ncVar, ncVarAttr
, emptyNcInfo
, addNcDim, addNcVar, addNcAttr, addNcVarAttr, (#)
) where
import Data.NetCDF.Types
import qualified Data.Map as M
import Data.Word
import Foreign.C
type Name = String
data NcDim = NcDim { ncDimName :: Name
, ncDimLength :: Int
, ncDimUnlimited :: Bool
} deriving Show
data NcAttr = NcAttrByte [Word8]
| NcAttrChar [Char]
| NcAttrShort [CShort]
| NcAttrInt [CInt]
| NcAttrFloat [CFloat]
| NcAttrDouble [CDouble]
deriving (Eq, Show)
class ToNcAttrHelp a where
toAttrHelp :: [a] -> NcAttr
instance ToNcAttrHelp Word8 where toAttrHelp = NcAttrByte
instance ToNcAttrHelp Char where toAttrHelp = NcAttrChar
instance ToNcAttrHelp CShort where toAttrHelp = NcAttrShort
instance ToNcAttrHelp CInt where toAttrHelp = NcAttrInt
instance ToNcAttrHelp CFloat where toAttrHelp = NcAttrFloat
instance ToNcAttrHelp CDouble where toAttrHelp = NcAttrDouble
class ToNcAttr a where
toAttr :: a -> NcAttr
instance ToNcAttrHelp a => ToNcAttr a where
toAttr x = toAttrHelp [x]
instance ToNcAttrHelp a => ToNcAttr [a] where
toAttr xs = toAttrHelp xs
class FromNcAttr a where
fromAttr :: NcAttr -> Maybe a
instance FromNcAttr Word8 where
fromAttr (NcAttrByte [x]) = Just x
fromAttr _ = Nothing
instance FromNcAttr [Word8] where
fromAttr (NcAttrByte xs) = Just xs
fromAttr _ = Nothing
instance FromNcAttr Char where
fromAttr (NcAttrChar [x]) = Just x
fromAttr _ = Nothing
instance FromNcAttr [Char] where
fromAttr (NcAttrChar xs) = Just xs
fromAttr _ = Nothing
instance FromNcAttr CShort where
fromAttr (NcAttrShort [x]) = Just x
fromAttr _ = Nothing
instance FromNcAttr [CShort] where
fromAttr (NcAttrShort xs) = Just xs
fromAttr _ = Nothing
instance FromNcAttr CInt where
fromAttr (NcAttrInt [x]) = Just x
fromAttr _ = Nothing
instance FromNcAttr [CInt] where
fromAttr (NcAttrInt xs) = Just xs
fromAttr _ = Nothing
instance FromNcAttr CFloat where
fromAttr (NcAttrFloat [x]) = Just x
fromAttr _ = Nothing
instance FromNcAttr [CFloat] where
fromAttr (NcAttrFloat xs) = Just xs
fromAttr _ = Nothing
instance FromNcAttr CDouble where
fromAttr (NcAttrDouble [x]) = Just x
fromAttr _ = Nothing
instance FromNcAttr [CDouble] where
fromAttr (NcAttrDouble xs) = Just xs
fromAttr _ = Nothing
data NcVar = NcVar { ncVarName :: Name
, ncVarType :: NcType
, ncVarDims :: [NcDim]
, ncVarAttrs :: M.Map Name NcAttr
} deriving Show
data NcRead
data NcWrite
data NcInfo a = NcInfo { ncName :: FilePath
, ncDims :: M.Map Name NcDim
, ncVars :: M.Map Name NcVar
, ncAttrs :: M.Map Name NcAttr
, ncId :: NcId
, ncVarIds :: M.Map Name NcId
} deriving Show
ncDim :: NcInfo a -> Name -> Maybe NcDim
ncDim nc n = M.lookup n $ ncDims nc
ncAttr :: NcInfo a -> Name -> Maybe NcAttr
ncAttr nc n = M.lookup n $ ncAttrs nc
ncVar :: NcInfo a -> Name -> Maybe NcVar
ncVar nc n = M.lookup n $ ncVars nc
ncVarAttr :: NcVar -> Name -> Maybe NcAttr
ncVarAttr v n = M.lookup n $ ncVarAttrs v
emptyNcInfo :: FilePath -> NcInfo NcWrite
emptyNcInfo n = NcInfo n M.empty M.empty M.empty ncInvalidId M.empty
addNcDim :: NcDim -> NcInfo NcWrite -> NcInfo NcWrite
addNcDim dim@(NcDim name _ _) (NcInfo n ds vs as fid vids) =
NcInfo n (M.insert name chkdim ds) vs as fid vids
where chkdim = dim { ncDimUnlimited =
ncDimUnlimited dim &&
(not . or . (map ncDimUnlimited) . M.elems $ ds) }
addNcVar :: NcVar -> NcInfo NcWrite -> NcInfo NcWrite
addNcVar var@(NcVar name _ _ _) (NcInfo n ds vs as fid vids) =
NcInfo n ds (M.insert name var vs) as fid vids
addNcAttr :: Name -> NcAttr -> NcInfo NcWrite -> NcInfo NcWrite
addNcAttr name att (NcInfo n ds vs as fid vids) =
NcInfo n ds vs (M.insert name att as) fid vids
addNcVarAttr :: Name -> NcAttr -> NcVar -> NcVar
addNcVarAttr name att (NcVar n t ds as) = NcVar n t ds (M.insert name att as)
infixl 8 #
(#) :: a -> (a -> b) -> b
(#) = flip ($)