module Gradual.GUI (render) where

import Language.Haskell.Liquid.UX.Annotate (tokeniseWithLoc)
import Language.Fixpoint.Types (KVar, Expr)
import Language.Fixpoint.Utils.Files

import Gradual.Types 
import Gradual.PrettyPrinting 
import Gradual.GUI.Annotate 
import Gradual.GUI.Types 
import Gradual.GUI.Misc 

import qualified Data.HashMap.Strict as M

render :: GConfig -> GSpan -> [[GSub a]] -> IO () 
render :: GConfig -> GSpan -> [[GSub a]] -> IO ()
render GConfig
cfg GSpan
gspan [[GSub a]]
sols = do 
  [(TokenType, String, Loc)]
tokens <- String -> [(TokenType, String, Loc)]
tokeniseWithLoc (String -> [(TokenType, String, Loc)])
-> IO String -> IO [(TokenType, String, Loc)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile (GConfig -> String
gtarget GConfig
cfg)
  let fname :: String
fname = GConfig -> String
makeFileName GConfig
cfg
  let sol1 :: GSub a
sol1  = [GSub a] -> GSub a
forall a. Monoid a => [a] -> a
mconcat ([GSub a] -> GSub a
forall a. [a] -> a
head ([GSub a] -> GSub a) -> [[GSub a]] -> [GSub a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[GSub a]]
sols)
  let deps :: SDeps
deps  = GSub a -> GSpan -> SDeps
forall a. GSub a -> GSpan -> SDeps
gSpanToDeps GSub a
sol1 GSpan
gspan
  let pkeys :: PKeys
pkeys = [[GSub a]] -> PKeys
forall a. [[GSub a]] -> PKeys
makePKeys [[GSub a]]
sols 
  let src :: String
src   = SDeps -> PKeys -> [[GSub a]] -> String
forall v a. Dependencies v -> PKeys -> [[GSub a]] -> String
initSrc SDeps
deps PKeys
pkeys [[GSub a]]
sols 
  String -> String -> IO ()
writeFile String
fname (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$! (String -> String -> [(TokenType, String, Loc)] -> SDeps -> String
renderHtml String
fname String
src [(TokenType, String, Loc)]
tokens SDeps
deps)
  String -> IO ()
putStrLn (String
"Output written in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname)

makeFileName :: GConfig -> String 
makeFileName :: GConfig -> String
makeFileName GConfig
cfg = Ext -> String -> String
extFileName Ext
Html (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ GConfig -> String
gtarget GConfig
cfg


initSrc :: Dependencies v -> PKeys -> [[GSub a]] -> String 
initSrc :: Dependencies v -> PKeys -> [[GSub a]] -> String
initSrc Dependencies v
deps PKeys
pkeys [[GSub a]]
sols = [String] -> String
unlines
  [ [[(Int, Int)]] -> String
initDependents [[(Int, Int)]]
kmap 
  , [[GSub a]] -> PKeys -> String
forall a. [[GSub a]] -> PKeys -> String
initValues [[GSub a]]
sols PKeys
pkeys
  , PKeys -> String
forall a. [a] -> String
initCurrentstatus PKeys
pkeys
  , Dependencies v -> String
forall v. Dependencies v -> String
initDepzise Dependencies v
deps 
  ]
  where
    kmap :: [[(Int, Int)]]
kmap = (KVar -> (Int, Int)) -> [KVar] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Dependencies v -> KVar -> (Int, Int)
forall v. Dependencies v -> KVar -> (Int, Int)
kVarId Dependencies v
deps) ([KVar] -> [(Int, Int)]) -> PKeys -> [[(Int, Int)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PKeys
pkeys

initValues :: [[GSub a]] -> PKeys -> String 
initValues :: [[GSub a]] -> PKeys -> String
initValues [[GSub a]]
sols PKeys
pkeys = String -> String
script (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ([KVar] -> [GSub a] -> String) -> PKeys -> [[GSub a]] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [KVar] -> [GSub a] -> String
forall a. [KVar] -> [GSub a] -> String
go PKeys
pkeys [[GSub a]]
sols
  where
   go :: [KVar] -> [GSub a] -> String 
   go :: [KVar] -> [GSub a] -> String
go [KVar]
keys [GSub a]
sols = String
"values.push(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [[String]] -> String
forall a. Show a => a -> String
show ([KVar] -> GSub a -> [String]
forall a. [KVar] -> GSub a -> [String]
go' [KVar]
keys (GSub a -> [String]) -> [GSub a] -> [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GSub a]
sols) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"

   go' :: [KVar] -> GSub a -> [String] 
   go' :: [KVar] -> GSub a -> [String]
go' [KVar]
keys GSub a
sol = (KVar -> String) -> [KVar] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\KVar
k -> Maybe (a, Expr) -> String
forall a. Maybe (a, Expr) -> String
renderSol (Maybe (a, Expr) -> String) -> Maybe (a, Expr) -> String
forall a b. (a -> b) -> a -> b
$ KVar -> GSub a -> Maybe (a, Expr)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup KVar
k GSub a
sol) [KVar]
keys 

   renderSol :: Maybe (a, Expr) -> String 
   renderSol :: Maybe (a, Expr) -> String
renderSol Maybe (a, Expr)
Nothing  = String
"NA"
   renderSol (Just (a, Expr)
e) = Expr -> String
forall a. Pretty a => a -> String
pretty (Expr -> String) -> Expr -> String
forall a b. (a -> b) -> a -> b
$ (a, Expr) -> Expr
forall a b. (a, b) -> b
snd (a, Expr)
e

initDependents :: [[(Int,Int)]] -> String
initDependents :: [[(Int, Int)]] -> String
initDependents [[(Int, Int)]]
xs = String -> String
script (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ([(Int, Int)] -> String) -> [[(Int, Int)]] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [(Int, Int)] -> String
forall a a. (Show a, Show a) => [(a, a)] -> String
go [[(Int, Int)]]
xs
  where
    go :: [(a, a)] -> String
go [(a, a)]
is = String
"dependents.push(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[" 
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"'content-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'" | (a
i,a
j)<-[(a, a)]
is] 
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n"

initCurrentstatus :: [a] -> String
initCurrentstatus :: [a] -> String
initCurrentstatus [a]
ps = String -> String
script (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ 
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ps) String
"currentstatus.push(0);\n") 


initDepzise ::  Dependencies v -> String
initDepzise :: Dependencies v -> String
initDepzise Dependencies v
deps = String -> String
script (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
  (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
i -> String
"depzise.push(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");\n") [Int]
ns 
  where
    ns :: [Int]
ns = ((Unique, [(Unique, v)]) -> Int) -> Dependencies v -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(Unique, v)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Unique, v)] -> Int)
-> ((Unique, [(Unique, v)]) -> [(Unique, v)])
-> (Unique, [(Unique, v)])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unique, [(Unique, v)]) -> [(Unique, v)]
forall a b. (a, b) -> b
snd) Dependencies v
deps