{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}

-- | Tracing metadata.
--
-- Mutagen saves some metadata about the instrumentation it performs at compile
-- time, such as the number of tracing nodes generated, along with their
-- original source location and kind.
--
-- This information is later used to efficiently allocate enough memory for the
-- tracing data structures at runtime, as well as mapping runtime coverage data
-- back to source locations for reporting.
module Test.Mutagen.Tracer.Metadata
  ( -- * Trace metadata
    tracerMetadataDir
  , TracerMetadata (..)
  , mkSingleModuleTracerMetadata
  , numTracingNodes
  , saveTracerMetadata
  , loadTracerMetadata

    -- * Module metadata
  , ModuleMetadata (..)

    -- * Node metadata
  , NodeType (..)
  , NodeLocation (..)
  , NodeMetadata (..)
  )
where

import Control.Exception (Exception, throwIO)
import Control.Monad (forM, forM_)
import Control.Monad.Extra (whenM)
import Data.Aeson (FromJSON, ToJSON, eitherDecodeFileStrict, encodeFile)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import System.Directory
  ( createDirectoryIfMissing
  , doesDirectoryExist
  , listDirectory
  , removeDirectoryRecursive
  )
import System.Environment (lookupEnv)
import System.FilePath (takeExtension, (<.>), (</>))
import System.IO.Unsafe (unsafePerformIO)

{-------------------------------------------------------------------------------
-- * Trace metadata
-------------------------------------------------------------------------------}

-- | Folder where to put the generated metadata.
--
-- NOTE: can be overridden via the @MUTAGEN_TRACER_METADATA_DIR@ environment
-- variable. Just remember to have it set up to the same value both at compile
-- time and at runtime.
tracerMetadataDir :: FilePath
tracerMetadataDir :: FilePath
tracerMetadataDir =
  FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
".mutagen"
    (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ IO (Maybe FilePath) -> Maybe FilePath
forall a. IO a -> a
unsafePerformIO
    (IO (Maybe FilePath) -> Maybe FilePath)
-> IO (Maybe FilePath) -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"MUTAGEN_TRACER_METADATA_DIR"
{-# NOINLINE tracerMetadataDir #-}

-- | Generated instrumentation metadata.
newtype TracerMetadata = TracerMetadata
  { TracerMetadata -> Map FilePath ModuleMetadata
tracerModules :: Map FilePath ModuleMetadata
  }
  deriving (TracerMetadata -> TracerMetadata -> Bool
(TracerMetadata -> TracerMetadata -> Bool)
-> (TracerMetadata -> TracerMetadata -> Bool) -> Eq TracerMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TracerMetadata -> TracerMetadata -> Bool
== :: TracerMetadata -> TracerMetadata -> Bool
$c/= :: TracerMetadata -> TracerMetadata -> Bool
/= :: TracerMetadata -> TracerMetadata -> Bool
Eq, (forall x. TracerMetadata -> Rep TracerMetadata x)
-> (forall x. Rep TracerMetadata x -> TracerMetadata)
-> Generic TracerMetadata
forall x. Rep TracerMetadata x -> TracerMetadata
forall x. TracerMetadata -> Rep TracerMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TracerMetadata -> Rep TracerMetadata x
from :: forall x. TracerMetadata -> Rep TracerMetadata x
$cto :: forall x. Rep TracerMetadata x -> TracerMetadata
to :: forall x. Rep TracerMetadata x -> TracerMetadata
Generic, ReadPrec [TracerMetadata]
ReadPrec TracerMetadata
Int -> ReadS TracerMetadata
ReadS [TracerMetadata]
(Int -> ReadS TracerMetadata)
-> ReadS [TracerMetadata]
-> ReadPrec TracerMetadata
-> ReadPrec [TracerMetadata]
-> Read TracerMetadata
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TracerMetadata
readsPrec :: Int -> ReadS TracerMetadata
$creadList :: ReadS [TracerMetadata]
readList :: ReadS [TracerMetadata]
$creadPrec :: ReadPrec TracerMetadata
readPrec :: ReadPrec TracerMetadata
$creadListPrec :: ReadPrec [TracerMetadata]
readListPrec :: ReadPrec [TracerMetadata]
Read, Int -> TracerMetadata -> ShowS
[TracerMetadata] -> ShowS
TracerMetadata -> FilePath
(Int -> TracerMetadata -> ShowS)
-> (TracerMetadata -> FilePath)
-> ([TracerMetadata] -> ShowS)
-> Show TracerMetadata
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TracerMetadata -> ShowS
showsPrec :: Int -> TracerMetadata -> ShowS
$cshow :: TracerMetadata -> FilePath
show :: TracerMetadata -> FilePath
$cshowList :: [TracerMetadata] -> ShowS
showList :: [TracerMetadata] -> ShowS
Show)

instance ToJSON TracerMetadata

instance FromJSON TracerMetadata

-- | Create tracer metadata for a single module.
mkSingleModuleTracerMetadata :: FilePath -> ModuleMetadata -> TracerMetadata
mkSingleModuleTracerMetadata :: FilePath -> ModuleMetadata -> TracerMetadata
mkSingleModuleTracerMetadata FilePath
modName ModuleMetadata
metadata =
  Map FilePath ModuleMetadata -> TracerMetadata
TracerMetadata (FilePath -> ModuleMetadata -> Map FilePath ModuleMetadata
forall k a. k -> a -> Map k a
Map.singleton FilePath
modName ModuleMetadata
metadata)

-- | Return the number of tracing nodes for an entire instrumentation run.
numTracingNodes :: TracerMetadata -> Int
numTracingNodes :: TracerMetadata -> Int
numTracingNodes TracerMetadata
metadata =
  [NodeMetadata] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((ModuleMetadata -> [NodeMetadata])
-> Map FilePath ModuleMetadata -> [NodeMetadata]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModuleMetadata -> [NodeMetadata]
moduleTracingNodes (TracerMetadata -> Map FilePath ModuleMetadata
tracerModules TracerMetadata
metadata))

-- | Save the generated instrumentation metadata.
--
-- NOTE: to avoid loading potentially invalid metadata when a source file gets
-- deleted, this function recreates the target directory if it already exists.
saveTracerMetadata :: TracerMetadata -> IO ()
saveTracerMetadata :: TracerMetadata -> IO ()
saveTracerMetadata TracerMetadata
metadata = do
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
doesDirectoryExist FilePath
tracerMetadataDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> IO ()
removeDirectoryRecursive FilePath
tracerMetadataDir
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
tracerMetadataDir
  [(FilePath, ModuleMetadata)]
-> ((FilePath, ModuleMetadata) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map FilePath ModuleMetadata -> [(FilePath, ModuleMetadata)]
forall k a. Map k a -> [(k, a)]
Map.toList (TracerMetadata -> Map FilePath ModuleMetadata
tracerModules TracerMetadata
metadata)) (((FilePath, ModuleMetadata) -> IO ()) -> IO ())
-> ((FilePath, ModuleMetadata) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
modName, ModuleMetadata
modMetadata) ->
    FilePath -> ModuleMetadata -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
encodeFile (FilePath
tracerMetadataDir FilePath -> ShowS
</> FilePath
modName FilePath -> ShowS
<.> FilePath
"json") ModuleMetadata
modMetadata

-- | Load the generated instrumentation metadata.
loadTracerMetadata :: IO TracerMetadata
loadTracerMetadata :: IO TracerMetadata
loadTracerMetadata = do
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesDirectoryExist FilePath
tracerMetadataDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    MutagenTracerMetadataError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO
      (MutagenTracerMetadataError -> IO ())
-> MutagenTracerMetadataError -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> MutagenTracerMetadataError
MutagenTracerMetadataError
      (FilePath -> MutagenTracerMetadataError)
-> FilePath -> MutagenTracerMetadataError
forall a b. (a -> b) -> a -> b
$ FilePath
"Tracer metadata directory does not exist: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
tracerMetadataDir
  files <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isJSON ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
tracerMetadataDir
  modules <- forM files $ \FilePath
file -> do
    FilePath -> IO (Either FilePath ModuleMetadata)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
eitherDecodeFileStrict (FilePath
tracerMetadataDir FilePath -> ShowS
</> FilePath
file) IO (Either FilePath ModuleMetadata)
-> (Either FilePath ModuleMetadata
    -> IO (FilePath, ModuleMetadata))
-> IO (FilePath, ModuleMetadata)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left FilePath
err -> MutagenTracerMetadataError -> IO (FilePath, ModuleMetadata)
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (MutagenTracerMetadataError -> IO (FilePath, ModuleMetadata))
-> MutagenTracerMetadataError -> IO (FilePath, ModuleMetadata)
forall a b. (a -> b) -> a -> b
$ FilePath -> MutagenTracerMetadataError
MutagenTracerMetadataError FilePath
err
      Right ModuleMetadata
modMetadata -> (FilePath, ModuleMetadata) -> IO (FilePath, ModuleMetadata)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file, ModuleMetadata
modMetadata)
  return $ TracerMetadata (Map.fromList modules)
  where
    isJSON :: FilePath -> Bool
isJSON FilePath
file = ShowS
takeExtension FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".json"

-- | Exception thrown loading instantiation metadata.
data MutagenTracerMetadataError
  = MutagenTracerMetadataError String
  | MutagenTracerMetadataIOError String
  deriving (Int -> MutagenTracerMetadataError -> ShowS
[MutagenTracerMetadataError] -> ShowS
MutagenTracerMetadataError -> FilePath
(Int -> MutagenTracerMetadataError -> ShowS)
-> (MutagenTracerMetadataError -> FilePath)
-> ([MutagenTracerMetadataError] -> ShowS)
-> Show MutagenTracerMetadataError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MutagenTracerMetadataError -> ShowS
showsPrec :: Int -> MutagenTracerMetadataError -> ShowS
$cshow :: MutagenTracerMetadataError -> FilePath
show :: MutagenTracerMetadataError -> FilePath
$cshowList :: [MutagenTracerMetadataError] -> ShowS
showList :: [MutagenTracerMetadataError] -> ShowS
Show)

instance Exception MutagenTracerMetadataError

{-------------------------------------------------------------------------------
-- * Module metadata
-------------------------------------------------------------------------------}

-- | Tracer metadata of a single module.
newtype ModuleMetadata = ModuleMetadata
  { ModuleMetadata -> [NodeMetadata]
moduleTracingNodes :: [NodeMetadata]
  }
  deriving (ModuleMetadata -> ModuleMetadata -> Bool
(ModuleMetadata -> ModuleMetadata -> Bool)
-> (ModuleMetadata -> ModuleMetadata -> Bool) -> Eq ModuleMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleMetadata -> ModuleMetadata -> Bool
== :: ModuleMetadata -> ModuleMetadata -> Bool
$c/= :: ModuleMetadata -> ModuleMetadata -> Bool
/= :: ModuleMetadata -> ModuleMetadata -> Bool
Eq, (forall x. ModuleMetadata -> Rep ModuleMetadata x)
-> (forall x. Rep ModuleMetadata x -> ModuleMetadata)
-> Generic ModuleMetadata
forall x. Rep ModuleMetadata x -> ModuleMetadata
forall x. ModuleMetadata -> Rep ModuleMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModuleMetadata -> Rep ModuleMetadata x
from :: forall x. ModuleMetadata -> Rep ModuleMetadata x
$cto :: forall x. Rep ModuleMetadata x -> ModuleMetadata
to :: forall x. Rep ModuleMetadata x -> ModuleMetadata
Generic, ReadPrec [ModuleMetadata]
ReadPrec ModuleMetadata
Int -> ReadS ModuleMetadata
ReadS [ModuleMetadata]
(Int -> ReadS ModuleMetadata)
-> ReadS [ModuleMetadata]
-> ReadPrec ModuleMetadata
-> ReadPrec [ModuleMetadata]
-> Read ModuleMetadata
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ModuleMetadata
readsPrec :: Int -> ReadS ModuleMetadata
$creadList :: ReadS [ModuleMetadata]
readList :: ReadS [ModuleMetadata]
$creadPrec :: ReadPrec ModuleMetadata
readPrec :: ReadPrec ModuleMetadata
$creadListPrec :: ReadPrec [ModuleMetadata]
readListPrec :: ReadPrec [ModuleMetadata]
Read, Int -> ModuleMetadata -> ShowS
[ModuleMetadata] -> ShowS
ModuleMetadata -> FilePath
(Int -> ModuleMetadata -> ShowS)
-> (ModuleMetadata -> FilePath)
-> ([ModuleMetadata] -> ShowS)
-> Show ModuleMetadata
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleMetadata -> ShowS
showsPrec :: Int -> ModuleMetadata -> ShowS
$cshow :: ModuleMetadata -> FilePath
show :: ModuleMetadata -> FilePath
$cshowList :: [ModuleMetadata] -> ShowS
showList :: [ModuleMetadata] -> ShowS
Show)

instance ToJSON ModuleMetadata

instance FromJSON ModuleMetadata

{-------------------------------------------------------------------------------
-- * Node metadata
-------------------------------------------------------------------------------}

-- | Kind of tracing node.
data NodeType = GRHSNode | ThenNode | ElseNode
  deriving (NodeType -> NodeType -> Bool
(NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool) -> Eq NodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeType -> NodeType -> Bool
== :: NodeType -> NodeType -> Bool
$c/= :: NodeType -> NodeType -> Bool
/= :: NodeType -> NodeType -> Bool
Eq, (forall x. NodeType -> Rep NodeType x)
-> (forall x. Rep NodeType x -> NodeType) -> Generic NodeType
forall x. Rep NodeType x -> NodeType
forall x. NodeType -> Rep NodeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeType -> Rep NodeType x
from :: forall x. NodeType -> Rep NodeType x
$cto :: forall x. Rep NodeType x -> NodeType
to :: forall x. Rep NodeType x -> NodeType
Generic, ReadPrec [NodeType]
ReadPrec NodeType
Int -> ReadS NodeType
ReadS [NodeType]
(Int -> ReadS NodeType)
-> ReadS [NodeType]
-> ReadPrec NodeType
-> ReadPrec [NodeType]
-> Read NodeType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NodeType
readsPrec :: Int -> ReadS NodeType
$creadList :: ReadS [NodeType]
readList :: ReadS [NodeType]
$creadPrec :: ReadPrec NodeType
readPrec :: ReadPrec NodeType
$creadListPrec :: ReadPrec [NodeType]
readListPrec :: ReadPrec [NodeType]
Read, Int -> NodeType -> ShowS
[NodeType] -> ShowS
NodeType -> FilePath
(Int -> NodeType -> ShowS)
-> (NodeType -> FilePath) -> ([NodeType] -> ShowS) -> Show NodeType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeType -> ShowS
showsPrec :: Int -> NodeType -> ShowS
$cshow :: NodeType -> FilePath
show :: NodeType -> FilePath
$cshowList :: [NodeType] -> ShowS
showList :: [NodeType] -> ShowS
Show)

instance ToJSON NodeType

instance FromJSON NodeType

-- | Node locations.
data NodeLocation = NodeLocation
  { NodeLocation -> FilePath
filePath :: FilePath
  , NodeLocation -> Int
startLine :: Int
  , NodeLocation -> Int
startCol :: Int
  , NodeLocation -> Int
endLine :: Int
  , NodeLocation -> Int
endCol :: Int
  }
  deriving (NodeLocation -> NodeLocation -> Bool
(NodeLocation -> NodeLocation -> Bool)
-> (NodeLocation -> NodeLocation -> Bool) -> Eq NodeLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeLocation -> NodeLocation -> Bool
== :: NodeLocation -> NodeLocation -> Bool
$c/= :: NodeLocation -> NodeLocation -> Bool
/= :: NodeLocation -> NodeLocation -> Bool
Eq, (forall x. NodeLocation -> Rep NodeLocation x)
-> (forall x. Rep NodeLocation x -> NodeLocation)
-> Generic NodeLocation
forall x. Rep NodeLocation x -> NodeLocation
forall x. NodeLocation -> Rep NodeLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeLocation -> Rep NodeLocation x
from :: forall x. NodeLocation -> Rep NodeLocation x
$cto :: forall x. Rep NodeLocation x -> NodeLocation
to :: forall x. Rep NodeLocation x -> NodeLocation
Generic, ReadPrec [NodeLocation]
ReadPrec NodeLocation
Int -> ReadS NodeLocation
ReadS [NodeLocation]
(Int -> ReadS NodeLocation)
-> ReadS [NodeLocation]
-> ReadPrec NodeLocation
-> ReadPrec [NodeLocation]
-> Read NodeLocation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NodeLocation
readsPrec :: Int -> ReadS NodeLocation
$creadList :: ReadS [NodeLocation]
readList :: ReadS [NodeLocation]
$creadPrec :: ReadPrec NodeLocation
readPrec :: ReadPrec NodeLocation
$creadListPrec :: ReadPrec [NodeLocation]
readListPrec :: ReadPrec [NodeLocation]
Read, Int -> NodeLocation -> ShowS
[NodeLocation] -> ShowS
NodeLocation -> FilePath
(Int -> NodeLocation -> ShowS)
-> (NodeLocation -> FilePath)
-> ([NodeLocation] -> ShowS)
-> Show NodeLocation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeLocation -> ShowS
showsPrec :: Int -> NodeLocation -> ShowS
$cshow :: NodeLocation -> FilePath
show :: NodeLocation -> FilePath
$cshowList :: [NodeLocation] -> ShowS
showList :: [NodeLocation] -> ShowS
Show)

instance ToJSON NodeLocation

instance FromJSON NodeLocation

-- | Tracer metadata of a single tracing node.
data NodeMetadata = NodeMetadata
  { NodeMetadata -> Int
nodeId :: Int
  , NodeMetadata -> NodeType
nodeKind :: NodeType
  , NodeMetadata -> Maybe NodeLocation
nodeLocation :: Maybe NodeLocation
  }
  deriving (NodeMetadata -> NodeMetadata -> Bool
(NodeMetadata -> NodeMetadata -> Bool)
-> (NodeMetadata -> NodeMetadata -> Bool) -> Eq NodeMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeMetadata -> NodeMetadata -> Bool
== :: NodeMetadata -> NodeMetadata -> Bool
$c/= :: NodeMetadata -> NodeMetadata -> Bool
/= :: NodeMetadata -> NodeMetadata -> Bool
Eq, (forall x. NodeMetadata -> Rep NodeMetadata x)
-> (forall x. Rep NodeMetadata x -> NodeMetadata)
-> Generic NodeMetadata
forall x. Rep NodeMetadata x -> NodeMetadata
forall x. NodeMetadata -> Rep NodeMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeMetadata -> Rep NodeMetadata x
from :: forall x. NodeMetadata -> Rep NodeMetadata x
$cto :: forall x. Rep NodeMetadata x -> NodeMetadata
to :: forall x. Rep NodeMetadata x -> NodeMetadata
Generic, ReadPrec [NodeMetadata]
ReadPrec NodeMetadata
Int -> ReadS NodeMetadata
ReadS [NodeMetadata]
(Int -> ReadS NodeMetadata)
-> ReadS [NodeMetadata]
-> ReadPrec NodeMetadata
-> ReadPrec [NodeMetadata]
-> Read NodeMetadata
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NodeMetadata
readsPrec :: Int -> ReadS NodeMetadata
$creadList :: ReadS [NodeMetadata]
readList :: ReadS [NodeMetadata]
$creadPrec :: ReadPrec NodeMetadata
readPrec :: ReadPrec NodeMetadata
$creadListPrec :: ReadPrec [NodeMetadata]
readListPrec :: ReadPrec [NodeMetadata]
Read, Int -> NodeMetadata -> ShowS
[NodeMetadata] -> ShowS
NodeMetadata -> FilePath
(Int -> NodeMetadata -> ShowS)
-> (NodeMetadata -> FilePath)
-> ([NodeMetadata] -> ShowS)
-> Show NodeMetadata
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeMetadata -> ShowS
showsPrec :: Int -> NodeMetadata -> ShowS
$cshow :: NodeMetadata -> FilePath
show :: NodeMetadata -> FilePath
$cshowList :: [NodeMetadata] -> ShowS
showList :: [NodeMetadata] -> ShowS
Show)

instance ToJSON NodeMetadata

instance FromJSON NodeMetadata