{-# LANGUAGE QuasiQuotes #-}

module Drasil.Generator.ChunkDump (
  -- * Tools for dumping a chunk database
  buildDebugData
) where

import Control.Lens ((^.))
import Data.Aeson (ToJSON)
import Data.Aeson.Encode.Pretty (encodePretty)
import System.Environment (lookupEnv)

import Drasil.Database (dumpChunkDB)
import Drasil.FileHandling (FileLayout, PathSegment, directory, file, ps)
import Drasil.System (SmithEtAlSRS, systemdb, traceTable, refbyTable)

-- | Builds the `.drasil` chunk dump directory if the `DEBUG_ENV` environment
-- variable is non-empty.
buildDebugData :: SmithEtAlSRS -> IO (Maybe FileLayout)
buildDebugData :: SmithEtAlSRS -> IO (Maybe FileLayout)
buildDebugData SmithEtAlSRS
si = do
  Maybe [Char]
maybeDebugging <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"DEBUG_ENV"
  case Maybe [Char]
maybeDebugging of
    (Just (Char
_:[Char]
_)) -> Maybe FileLayout -> IO (Maybe FileLayout)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileLayout -> IO (Maybe FileLayout))
-> Maybe FileLayout -> IO (Maybe FileLayout)
forall a b. (a -> b) -> a -> b
$ FileLayout -> Maybe FileLayout
forall a. a -> Maybe a
Just (FileLayout -> Maybe FileLayout) -> FileLayout -> Maybe FileLayout
forall a b. (a -> b) -> a -> b
$ SmithEtAlSRS -> FileLayout
dumpEverything SmithEtAlSRS
si
    Maybe [Char]
_ -> Maybe FileLayout -> IO (Maybe FileLayout)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FileLayout
forall a. Maybe a
Nothing

-- | Internal: For debugging purposes, constructs a `FileLayout` with a dump of
-- the chunk maps.
dumpEverything :: SmithEtAlSRS -> FileLayout
dumpEverything :: SmithEtAlSRS -> FileLayout
dumpEverything SmithEtAlSRS
si =
  PathSegment -> [FileLayout] -> FileLayout
forall (f :: * -> *).
Foldable f =>
PathSegment -> f FileLayout -> FileLayout
directory [ps|.drasil|]
  [ PathSegment -> DumpedChunkDB -> FileLayout
forall a. ToJSON a => PathSegment -> a -> FileLayout
dumpTo [ps|seeds.json|] (DumpedChunkDB -> FileLayout) -> DumpedChunkDB -> FileLayout
forall a b. (a -> b) -> a -> b
$ ChunkDB -> DumpedChunkDB
dumpChunkDB (SmithEtAlSRS
si SmithEtAlSRS -> Getting ChunkDB SmithEtAlSRS ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB SmithEtAlSRS ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' SmithEtAlSRS ChunkDB
systemdb),
    PathSegment -> Map UID [UID] -> FileLayout
forall a. ToJSON a => PathSegment -> a -> FileLayout
dumpTo [ps|trace.json|] (Map UID [UID] -> FileLayout) -> Map UID [UID] -> FileLayout
forall a b. (a -> b) -> a -> b
$ SmithEtAlSRS
si SmithEtAlSRS
-> Getting (Map UID [UID]) SmithEtAlSRS (Map UID [UID])
-> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. Getting (Map UID [UID]) SmithEtAlSRS (Map UID [UID])
forall c. HasSmithEtAlSRS c => Lens' c (Map UID [UID])
Lens' SmithEtAlSRS (Map UID [UID])
traceTable,
    PathSegment -> Map UID [UID] -> FileLayout
forall a. ToJSON a => PathSegment -> a -> FileLayout
dumpTo [ps|reverse_trace.json|] (Map UID [UID] -> FileLayout) -> Map UID [UID] -> FileLayout
forall a b. (a -> b) -> a -> b
$ SmithEtAlSRS
si SmithEtAlSRS
-> Getting (Map UID [UID]) SmithEtAlSRS (Map UID [UID])
-> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. Getting (Map UID [UID]) SmithEtAlSRS (Map UID [UID])
forall c. HasSmithEtAlSRS c => Lens' c (Map UID [UID])
Lens' SmithEtAlSRS (Map UID [UID])
refbyTable
  ]

-- | Internal: Build a JSON file from arbitrary data.
dumpTo :: ToJSON a => PathSegment -> a -> FileLayout
dumpTo :: forall a. ToJSON a => PathSegment -> a -> FileLayout
dumpTo PathSegment
targetPath = PathSegment -> ByteString -> FileLayout
forall doc. Writeable doc => PathSegment -> doc -> FileLayout
file PathSegment
targetPath (ByteString -> FileLayout) -> (a -> ByteString) -> a -> FileLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty