-- 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
_ -> 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 = forall v k. Ord v => Map k [v] -> Map v [k]
invert DumpedChunkDB
chunkDump
      sharedUIDs :: Map UID [ChunkType]
sharedUIDs = forall a k. (a -> Bool) -> Map k a -> Map k a
SM.filter forall a. [a] -> Bool
atLeast2 Map UID [ChunkType]
invertedChunkDump
      traceDump :: TraceMap
traceDump = ChunkDB
chunkDb forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB TraceMap
traceTable
      refByDump :: TraceMap
refByDump = ChunkDB
chunkDb forall s a. s -> Getting a s a -> a
^. Lens' ChunkDB TraceMap
refbyTable

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

  PrintingInformation -> ChunkType -> IO ()
dumpChunkTables PrintingInformation
pinfo forall a b. (a -> b) -> a -> b
$ ChunkType
targetPath 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 forall a b. (a -> b) -> a -> b
$ 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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> ChunkType -> IO ()
hPutStrLn Handle
trg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> ChunkType
render) forall a b. (a -> b) -> a -> b
$ PrintingInformation -> [Doc]
printAllDebugInfo PrintingInformation
pinfo
  Handle -> IO ()
hClose Handle
trg