-- FIXME: Why is this a `Language` top-level module name?
module Language.Drasil.Dump where

import qualified Database.Drasil as DB
import SysInfo.Drasil (SystemInformation(_sysinfodb))

import System.Directory
import System.IO
import Data.Aeson (ToJSON)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.Map.Strict as SM

import Utils.Drasil (invert, atLeast2)
import Database.Drasil (traceTable, refbyTable)
import Control.Lens ((^.))
import System.Environment (lookupEnv)

import Language.Drasil.Printers (PrintingInformation, printAllDebugInfo)
import Text.PrettyPrint

type Path = String
type TargetFile = String

-- | For debugging purposes, if the system has a `DEBUG_ENV` environment
--   variable set to anything, we can dump the chunk maps in a system to the
--   host system.
dumpEverything :: SystemInformation -> PrintingInformation -> Path -> IO ()
dumpEverything :: SystemInformation -> PrintingInformation -> ChunkType -> IO ()
dumpEverything SystemInformation
si PrintingInformation
pinfo ChunkType
p = do
  Maybe ChunkType
maybeDebugging <- ChunkType -> IO (Maybe ChunkType)
lookupEnv ChunkType
"DEBUG_ENV"
  case Maybe ChunkType
maybeDebugging of
    (Just (Char
_:ChunkType
_)) -> do
      SystemInformation -> PrintingInformation -> ChunkType -> IO ()
dumpEverything0 SystemInformation
si PrintingInformation
pinfo ChunkType
p
    Maybe ChunkType
_ -> IO ()
forall a. Monoid a => a
mempty

dumpEverything0 :: SystemInformation -> PrintingInformation -> Path -> IO ()
dumpEverything0 :: SystemInformation -> PrintingInformation -> ChunkType -> IO ()
dumpEverything0 SystemInformation
si PrintingInformation
pinfo ChunkType
targetPath = do
  Bool -> ChunkType -> IO ()
createDirectoryIfMissing Bool
True ChunkType
targetPath
  let chunkDb :: ChunkDB
chunkDb = SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si
      chunkDump :: DumpedChunkDB
chunkDump = ChunkDB -> DumpedChunkDB
DB.dumpChunkDB ChunkDB
chunkDb
      invertedChunkDump :: Map UID [ChunkType]
invertedChunkDump = DumpedChunkDB -> Map UID [ChunkType]
forall v k. Ord v => Map k [v] -> Map v [k]
invert DumpedChunkDB
chunkDump
      sharedUIDs :: Map UID [ChunkType]
sharedUIDs = ([ChunkType] -> Bool) -> Map UID [ChunkType] -> Map UID [ChunkType]
forall a k. (a -> Bool) -> Map k a -> Map k a
SM.filter [ChunkType] -> Bool
forall a. [a] -> Bool
atLeast2 Map UID [ChunkType]
invertedChunkDump
      traceDump :: TraceMap
traceDump = ChunkDB
chunkDb ChunkDB -> Getting TraceMap ChunkDB TraceMap -> TraceMap
forall s a. s -> Getting a s a -> a
^. Getting TraceMap ChunkDB TraceMap
Lens' ChunkDB TraceMap
traceTable
      refByDump :: TraceMap
refByDump = ChunkDB
chunkDb ChunkDB -> Getting TraceMap ChunkDB TraceMap -> TraceMap
forall s a. s -> Getting a s a -> a
^. Getting TraceMap ChunkDB TraceMap
Lens' ChunkDB TraceMap
refbyTable

  DumpedChunkDB -> ChunkType -> IO ()
forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo DumpedChunkDB
chunkDump (ChunkType -> IO ()) -> ChunkType -> IO ()
forall a b. (a -> b) -> a -> b
$ ChunkType
targetPath ChunkType -> ChunkType -> ChunkType
forall a. [a] -> [a] -> [a]
++ ChunkType
"seeds.json"
  Map UID [ChunkType] -> ChunkType -> IO ()
forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo Map UID [ChunkType]
invertedChunkDump (ChunkType -> IO ()) -> ChunkType -> IO ()
forall a b. (a -> b) -> a -> b
$ ChunkType
targetPath ChunkType -> ChunkType -> ChunkType
forall a. [a] -> [a] -> [a]
++ ChunkType
"inverted_seeds.json"
  Map UID [ChunkType] -> ChunkType -> IO ()
forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo Map UID [ChunkType]
sharedUIDs (ChunkType -> IO ()) -> ChunkType -> IO ()
forall a b. (a -> b) -> a -> b
$ ChunkType
targetPath ChunkType -> ChunkType -> ChunkType
forall a. [a] -> [a] -> [a]
++ ChunkType
"problematic_seeds.json"
  TraceMap -> ChunkType -> IO ()
forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo TraceMap
traceDump (ChunkType -> IO ()) -> ChunkType -> IO ()
forall a b. (a -> b) -> a -> b
$ ChunkType
targetPath ChunkType -> ChunkType -> ChunkType
forall a. [a] -> [a] -> [a]
++ ChunkType
"trace.json"
  TraceMap -> ChunkType -> IO ()
forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo TraceMap
refByDump (ChunkType -> IO ()) -> ChunkType -> IO ()
forall a b. (a -> b) -> a -> b
$ ChunkType
targetPath ChunkType -> ChunkType -> ChunkType
forall a. [a] -> [a] -> [a]
++ ChunkType
"reverse_trace.json"

  PrintingInformation -> ChunkType -> IO ()
dumpChunkTables PrintingInformation
pinfo (ChunkType -> IO ()) -> ChunkType -> IO ()
forall a b. (a -> b) -> a -> b
$ ChunkType
targetPath ChunkType -> ChunkType -> ChunkType
forall a. [a] -> [a] -> [a]
++ ChunkType
"tables.txt"

-- FIXME: This is more of a general utility than it is drasil-database specific
dumpTo :: ToJSON a => a -> TargetFile -> IO ()
dumpTo :: forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo a
d ChunkType
targetFile = do
  Handle
trg <- ChunkType -> IOMode -> IO Handle
openFile ChunkType
targetFile IOMode
WriteMode
  Handle -> ByteString -> IO ()
LB.hPutStrLn Handle
trg (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty a
d
  Handle -> IO ()
hClose Handle
trg

dumpChunkTables :: PrintingInformation -> TargetFile -> IO ()
dumpChunkTables :: PrintingInformation -> ChunkType -> IO ()
dumpChunkTables PrintingInformation
pinfo ChunkType
targetFile = do
  Handle
trg <- ChunkType -> IOMode -> IO Handle
openFile ChunkType
targetFile IOMode
WriteMode
  (Doc -> IO ()) -> [Doc] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> ChunkType -> IO ()
hPutStrLn Handle
trg (ChunkType -> IO ()) -> (Doc -> ChunkType) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> ChunkType
render) ([Doc] -> IO ()) -> [Doc] -> IO ()
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> [Doc]
printAllDebugInfo PrintingInformation
pinfo
  Handle -> IO ()
hClose Handle
trg