module Gradual.GUI.Annotate (renderHtml) where 

import Language.Haskell.Liquid.GHC.Misc   (Loc(..))
import Language.Fixpoint.Misc (thd3)
import Language.Fixpoint.Types.Spans hiding (Loc)

-- import GHC                     ( SrcSpan (..)
--                                           , srcSpanStartCol, srcSpanEndCol, srcSpanStartLine, srcSpanEndLine)
import qualified Language.Haskell.HsColour.CSS as CSS


import Gradual.GUI.Types 

import qualified Data.List as L

pretag :: String
pretag :: String
pretag = String
"<div class='dropdown'><span class='dropbtn'>"


posttag :: Int -> Int -> String -> String 
posttag :: Int -> Int -> String -> String
posttag Int
i Int
j String
val
  = String
"</span><div class='dropdown-content' name='select-" 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
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' id='select-" 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
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'>"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<button type='button' onclick=\"showPrev("String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\"> << </button>" 
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<div id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
val
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</div>" 
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<button type='button' onclick=\"showNext("String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\"> >> </button>" 
  -- ++ "undefined"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</div>"
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</div>"
  where
    name :: String
name = String
"'content-" 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
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"


tag :: Loc -> [(String, Loc)] -> (Int, Int, SrcSpan, String) -> [(String, Loc)]
tag :: Loc
-> [(String, Loc)]
-> (Int, Int, SrcSpan, String)
-> [(String, Loc)]
tag Loc
eof [(String, Loc)]
toks (Int
i, Int
j, SrcSpan
sp, String
v) = Bool -> [(String, Loc)] -> [(String, Loc)]
go Bool
False [(String, Loc)]
toks 
  where
    go :: Bool -> [(String, Loc)] -> [(String, Loc)]
go Bool
True [] = [(String
"</span>"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String -> String
posttag Int
i Int
j String
v, Loc
eof)]
    go Bool
_    [] = []
    go Bool
b    ((String
s,Loc
l):[(String, Loc)]
rest)
      | Loc
l Loc -> SrcSpan -> Bool
`inLoc` SrcSpan
sp, Bool -> Bool
not Bool
b 
      = (String
pretag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<span class='"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
sourceName Int
iString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s , Loc
l)(String, Loc) -> [(String, Loc)] -> [(String, Loc)]
forall a. a -> [a] -> [a]
:Bool -> [(String, Loc)] -> [(String, Loc)]
go Bool
True [(String, Loc)]
rest 
      | Bool -> Bool
not (Loc
l Loc -> SrcSpan -> Bool
`inLoc` SrcSpan
sp), Bool
b 
      = (String
"</span>"String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String -> String
posttag Int
i Int
j String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s, Loc
l)(String, Loc) -> [(String, Loc)] -> [(String, Loc)]
forall a. a -> [a] -> [a]
:[(String, Loc)]
rest 
      | Bool
otherwise 
      = (String
s,Loc
l)(String, Loc) -> [(String, Loc)] -> [(String, Loc)]
forall a. a -> [a] -> [a]
:Bool -> [(String, Loc)] -> [(String, Loc)]
go Bool
b [(String, Loc)]
rest 

_highlight :: String -> Loc -> [(String, Loc)] -> SrcSpan -> [(String, Loc)] 
_highlight :: String -> Loc -> [(String, Loc)] -> SrcSpan -> [(String, Loc)]
_highlight String
color Loc
eof [(String, Loc)]
toks SrcSpan
sp = Bool -> [(String, Loc)] -> [(String, Loc)]
go Bool
False [(String, Loc)]
toks 
  where
    go :: Bool -> [(String, Loc)] -> [(String, Loc)]
go Bool
True [] = [(String
"</span>", Loc
eof)]
    go Bool
_    [] = []
    go Bool
b    ((String
s,Loc
l):[(String, Loc)]
rest)
      | Loc
l Loc -> SrcSpan -> Bool
`inLoc` SrcSpan
sp, Bool -> Bool
not Bool
b 
      = (String
"<span id=\"background-color: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
color String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\">" String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s, Loc
l)(String, Loc) -> [(String, Loc)] -> [(String, Loc)]
forall a. a -> [a] -> [a]
:Bool -> [(String, Loc)] -> [(String, Loc)]
go Bool
True [(String, Loc)]
rest 
      | Bool -> Bool
not (Loc
l Loc -> SrcSpan -> Bool
`inLoc` SrcSpan
sp), Bool
b 
      = (String
"</span>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s, Loc
l)(String, Loc) -> [(String, Loc)] -> [(String, Loc)]
forall a. a -> [a] -> [a]
:[(String, Loc)]
rest 
      | Bool
otherwise 
      = (String
s,Loc
l)(String, Loc) -> [(String, Loc)] -> [(String, Loc)]
forall a. a -> [a] -> [a]
:Bool -> [(String, Loc)] -> [(String, Loc)]
go Bool
b [(String, Loc)]
rest 

inLoc :: Loc -> SrcSpan -> Bool 
inLoc :: Loc -> SrcSpan -> Bool
inLoc Loc
l (SS SourcePos
start SourcePos
end) 
  = (Int, Int) -> Loc
L (Int
sline, Int
scol) Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
<= Loc
l Bool -> Bool -> Bool
&& Loc
l Loc -> Loc -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Int) -> Loc
L (Int
eline, Int
ecol)
  where
    (String
_,Int
sline, Int
scol) = SourcePos -> (String, Int, Int)
sourcePosElts SourcePos
start
    (String
_,Int
eline, Int
ecol) = SourcePos -> (String, Int, Int)
sourcePosElts SourcePos
end


renderHtml :: FilePath -> String -> LocTokens -> SDeps -> String 
renderHtml :: String -> String -> LocTokens -> SDeps -> String
renderHtml String
html String
initSrc LocTokens
tokens SDeps
deps 
  = String -> String -> String -> String
topAndTail String
initSrc String
html (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$! String
body
  where 
    eof :: Loc
eof  = (TokenType, String, Loc) -> Loc
forall a b c. (a, b, c) -> c
thd3 ((TokenType, String, Loc) -> Loc)
-> (TokenType, String, Loc) -> Loc
forall a b. (a -> b) -> a -> b
$ LocTokens -> (TokenType, String, Loc)
forall a. [a] -> a
last LocTokens
tokens
    body :: String
body = Int -> String -> String
formButton Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
CSS.pre (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
$ ((String, Loc) -> String) -> [(String, Loc)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Loc) -> String
forall a b. (a, b) -> a
fst [(String, Loc)]
taggedTokens
    taggedTokens :: [(String, Loc)]
taggedTokens = ([(String, Loc)] -> (Int, Int, SrcSpan, String) -> [(String, Loc)])
-> [(String, Loc)]
-> [(Int, Int, SrcSpan, String)]
-> [(String, Loc)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Loc
-> [(String, Loc)]
-> (Int, Int, SrcSpan, String)
-> [(String, Loc)]
tag Loc
eof) 
                      [((TokenType, String) -> String
CSS.renderToken (TokenType
x, String
y), Loc
z) | (TokenType
x,String
y,Loc
z) <- LocTokens
tokens] 
                      (SDeps -> [(Int, Int, SrcSpan, String)]
forall v. Dependencies v -> [(Int, Int, SrcSpan, v)]
srcDeps SDeps
deps)

formButton :: Int -> String -> String 
formButton :: Int -> String -> String
formButton Int
i str :: String
str@(Char
_:Char
_:String
rest) 
  | String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf String
"??" String
str
  = Int -> String
bform Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
formButton (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
rest
formButton Int
i (Char
x:String
rest)
  = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Int -> String -> String
formButton Int
i String
rest
formButton Int
_ []
  = []  



classbuttonName :: Int -> String 
classbuttonName :: Int -> String
classbuttonName Int
i = String
"classbutton-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i 


sourceName :: Int -> String 
sourceName :: Int -> String
sourceName Int
i = String
"src-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i 

bform :: Int -> String
bform :: Int -> String
bform Int
i = 
  String
"<button type='button' id='button-" 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
"' onclick='gradualClick("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
")'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
  String
" class='" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
classbuttonName Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'>??</button>"


topAndTail :: String -> String -> String -> String
topAndTail :: String -> String -> String -> String
topAndTail String
initSrc String
title String
body = String -> String -> String
htmlHeader String
initSrc String
title String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
body String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
htmlClose


-- ATTENTION: these colors should match with ones in util.js
-- TODO: use spec
colours :: [(Int, String)]
colours :: [(Int, String)]
colours = 
  [ (Int
1, String
"#E59EFF")
  , (Int
2, String
"#FF9EE9")
  , (Int
3, String
"#FF9EB8")
  , (Int
4, String
"#FFB49E")
  , (Int
5, String
"#FFE59E")
  , (Int
6, String
"#E9FF9E")]

bottonsCss :: String 
bottonsCss :: String
bottonsCss = ((Int, String) -> String) -> [(Int, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, String) -> String
bottonCss [(Int, String)]
colours 

bottonCss :: (Int, String) -> String 
bottonCss :: (Int, String) -> String
bottonCss (Int
i, String
color)= [String] -> String
unlines 
  [ String
"<style>"
  , String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
classbuttonName Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{"
  , String
"background-color: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
color String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
  , String
"cursor: pointer;"
  , String
"type: button;}"
  , String
""
  , String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
sourceName Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{"
  , String
"background-color: #f0f0f0;}"
  , String
"</style>"
  ]

htmlHeader :: String -> String -> String
htmlHeader :: String -> String -> String
htmlHeader String
initSrc String
title = [String] -> String
unlines
  [ String
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">"
  , String
"<html>"
  , String
"<head>"
  , String
"<title>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
title String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</title>"
  , String
"</head>"
  , String
"<style type='text/css'>"
  , String
" form {display:inline; margin:0px; padding:0px; }"
  , String
"</style>"
  , String
"<script src='http://goto.ucsd.edu/~nvazou/gradual/util.js'></script>"
  , String
initSrc
  , String
"<link type='text/css' rel='stylesheet' href='http://goto.ucsd.edu/~nvazou/gradual/liquid.css' />"
  , String
bottonsCss
  , String
"<body>"
  , String
"<hr>"
  , String
"Interactive Solution based on Gradual Typing"
  ]

htmlClose :: String
htmlClose :: String
htmlClose  = String
"\n</body>\n</html>"