module Drasil.Generator.ChunkDump (
  -- * Tools for dumping a chunk database to disk for debugging
  dumpEverything
) where

import Control.Lens ((^.))
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 System.IO
import System.Environment (lookupEnv)
import Text.PrettyPrint

import Language.Drasil.Printers (PrintingInformation, printAllDebugInfo)
import Utils.Drasil (invert, atLeast2, createDirIfMissing)
import Database.Drasil
import qualified Database.Drasil as DB
import Drasil.System (System, systemdb)
import Drasil.Database.SearchTools (findAllIdeaDicts)


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]
_) = ([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 :: Map UID [UID]
traceDump = ChunkDB -> Map UID [UID]
traceTable ChunkDB
chunkDb
      refByDump :: Map UID [UID]
refByDump = ChunkDB -> Map UID [UID]
refbyTable ChunkDB
chunkDb
      justTerms :: [UID]
justTerms = (IdeaDict -> UID) -> [IdeaDict] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (IdeaDict -> Getting UID IdeaDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID IdeaDict UID
forall c. HasUID c => Getter c UID
Getter IdeaDict UID
uid) (ChunkDB -> [IdeaDict]
findAllIdeaDicts 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"
  [UID] -> ChunkType -> IO ()
forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo [UID]
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"
  Map UID [UID] -> ChunkType -> IO ()
forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo Map UID [UID]
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"
  Map UID [UID] -> ChunkType -> IO ()
forall a. ToJSON a => a -> ChunkType -> IO ()
dumpTo Map UID [UID]
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