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

import qualified Database.Drasil as DB
import Drasil.System (System, systemdb)

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, createDirIfMissing)
import Database.Drasil (traceTable, refbyTable, ChunkDB (termTable))
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 :: System -> PrintingInformation -> Path -> IO ()
dumpEverything :: System -> PrintingInformation -> ChunkType -> IO ()
dumpEverything System
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
      System -> PrintingInformation -> ChunkType -> IO ()
dumpEverything0 System
si PrintingInformation
pinfo ChunkType
p
    Maybe ChunkType
_ -> IO ()
forall a. Monoid a => a
mempty

dumpEverything0 :: System -> PrintingInformation -> Path -> IO ()
dumpEverything0 :: System -> PrintingInformation -> ChunkType -> IO ()
dumpEverything0 System
si PrintingInformation
pinfo ChunkType
targetPath = do
  Bool -> ChunkType -> IO ()
createDirIfMissing Bool
True ChunkType
targetPath
  let chunkDb :: ChunkDB
chunkDb = System
si System -> Getting ChunkDB System ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB System ChunkDB
forall c. HasSystem c => Lens' c ChunkDB
Lens' System ChunkDB
systemdb
      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
      (Map UID [ChunkType]
sharedUIDs, Map UID [ChunkType]
nonsharedUIDs) = ([ChunkType] -> Bool)
-> Map UID [ChunkType]
-> (Map UID [ChunkType], Map UID [ChunkType])
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
SM.partition [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
      justTerms :: Map UID [ChunkType]
justTerms = Map UID [ChunkType]
-> Map UID (IdeaDict, Int) -> Map UID [ChunkType]
forall k a b. Ord k => Map k a -> Map k b -> Map k a
SM.intersection Map UID [ChunkType]
nonsharedUIDs (Map UID (IdeaDict, Int) -> Map UID [ChunkType])
-> Map UID (IdeaDict, Int) -> Map UID [ChunkType]
forall a b. (a -> b) -> a -> b
$ ChunkDB -> Map UID (IdeaDict, Int)
termTable ChunkDB
chunkDb

  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]
justTerms (ChunkType -> IO ()) -> ChunkType -> IO ()
forall a b. (a -> b) -> a -> b
$ ChunkType
targetPath ChunkType -> ChunkType -> ChunkType
forall a. [a] -> [a] -> [a]
++ ChunkType
"uids_are_just_terms.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