{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances    #-}

module Gradual.GUI.Types where

import Language.Haskell.HsColour.Classify (TokenType)
import Language.Haskell.Liquid.GHC.Misc   (Loc(..))

import qualified Data.HashMap.Strict       as M
import Language.Fixpoint.Types.Refinements hiding (L)
import Language.Fixpoint.Types.Spans hiding (Loc(..))
import Language.Fixpoint.Types (symbolString, Symbol) 
import qualified Data.List as L 
import qualified Data.Char as C 
import Data.Maybe (fromJust, fromMaybe)


import Gradual.Types 
import Gradual.PrettyPrinting 


data Unique  = Unique {Unique -> Int
uId :: Int, Unique -> SrcSpan
uLoc :: SrcSpan, Unique -> Symbol
uName :: Symbol} 
type LocTokens = [(TokenType, String, Loc)]
type Deps      = Dependencies () --  [(Int, [SrcSpan])] 
type SDeps     = Dependencies String
type Dependencies val = [(Unique, [(Unique,val)])]
type PKeys    = [[KVar]]

makePKeys :: [[GSub a]] -> PKeys 
makePKeys :: [[GSub a]] -> PKeys
makePKeys [[GSub a]]
sols = GSub a -> [KVar]
forall k v. HashMap k v -> [k]
M.keys (GSub a -> [KVar]) -> ([GSub a] -> GSub a) -> [GSub a] -> [KVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GSub a] -> GSub a
forall a. [a] -> a
head ([GSub a] -> [KVar]) -> [[GSub a]] -> PKeys
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[GSub a]]
sols

instance Show Unique where
  show :: Unique -> String
show Unique
u = SrcSpan -> String
forall a. Show a => a -> String
show (Unique -> SrcSpan
uLoc Unique
u)

kVarId :: Dependencies v -> KVar -> (Int, Int)
kVarId :: Dependencies v -> KVar -> (Int, Int)
kVarId Dependencies v
deps KVar
k = (Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (Int
0,Int
0) (Maybe (Int, Int) -> (Int, Int)) -> Maybe (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Symbol -> [(Symbol, (Int, Int))] -> Maybe (Int, Int)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup (KVar -> Symbol
kv KVar
k) 
                  [(Unique -> Symbol
uName Unique
x,(Unique -> Int
uId Unique
ui, Unique -> Int
uId Unique
x)) | (Unique
ui, [(Unique, v)]
xs) <- Dependencies v
deps, (Unique
x,v
_) <- [(Unique, v)]
xs]

srcDeps :: Dependencies v -> [(Int, Int, SrcSpan, v)]
srcDeps :: Dependencies v -> [(Int, Int, SrcSpan, v)]
srcDeps Dependencies v
deps = [(Unique -> Int
uId Unique
ui, Unique -> Int
uId Unique
x, Unique -> SrcSpan
uLoc Unique
x, v
v) | (Unique
ui, [(Unique, v)]
xs) <- Dependencies v
deps , (Unique
x,v
v) <- [(Unique, v)]
xs]


gSpanToDeps :: GSub a -> GSpan -> SDeps 
gSpanToDeps :: GSub a -> GSpan -> SDeps
gSpanToDeps GSub a
sol GSpan
gm = [(Int -> SrcSpan -> Symbol -> Unique
Unique Int
i (Symbol -> SrcSpan
kVarSpan (Symbol -> SrcSpan) -> Symbol -> SrcSpan
forall a b. (a -> b) -> a -> b
$ KVar -> Symbol
kv KVar
k) (KVar -> Symbol
kv KVar
k), [(KVar, Maybe SrcSpan)] -> [(Unique, String)]
mapValues [(KVar, Maybe SrcSpan)]
ks) 
                        | ((KVar
k,[(KVar, Maybe SrcSpan)]
ks),Int
i) <- [(KVar, [(KVar, Maybe SrcSpan)])]
-> [Int] -> [((KVar, [(KVar, Maybe SrcSpan)]), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(KVar, [(KVar, Maybe SrcSpan)])]
gml [Int
1..]] 
  where
    mapValues :: [(KVar, Maybe SrcSpan)] -> [(Unique, String)]
mapValues [(KVar, Maybe SrcSpan)]
ks = [(Int -> SrcSpan -> Symbol -> Unique
Unique Int
i SrcSpan
s (Symbol -> Unique) -> Symbol -> Unique
forall a b. (a -> b) -> a -> b
$ KVar -> Symbol
kv KVar
k, KVar -> String
lookSol KVar
k) | ((KVar
k,Just SrcSpan
s), Int
i) <- [(KVar, Maybe SrcSpan)] -> [Int] -> [((KVar, Maybe SrcSpan), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(KVar, Maybe SrcSpan)]
ks [Int
1..]]
    gml :: [(KVar, [(KVar, Maybe SrcSpan)])]
gml          = ((KVar, [(KVar, Maybe SrcSpan)])
 -> (KVar, [(KVar, Maybe SrcSpan)]) -> Ordering)
-> [(KVar, [(KVar, Maybe SrcSpan)])]
-> [(KVar, [(KVar, Maybe SrcSpan)])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (\(KVar
k1,[(KVar, Maybe SrcSpan)]
_) (KVar
k2,[(KVar, Maybe SrcSpan)]
_) -> SrcSpan -> SrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Symbol -> SrcSpan
kVarSpan (Symbol -> SrcSpan) -> Symbol -> SrcSpan
forall a b. (a -> b) -> a -> b
$ KVar -> Symbol
kv KVar
k1) (Symbol -> SrcSpan
kVarSpan (Symbol -> SrcSpan) -> Symbol -> SrcSpan
forall a b. (a -> b) -> a -> b
$ KVar -> Symbol
kv KVar
k2)) 
                            ([(KVar, [(KVar, Maybe SrcSpan)])]
 -> [(KVar, [(KVar, Maybe SrcSpan)])])
-> [(KVar, [(KVar, Maybe SrcSpan)])]
-> [(KVar, [(KVar, Maybe SrcSpan)])]
forall a b. (a -> b) -> a -> b
$ GSpan -> [(KVar, [(KVar, Maybe SrcSpan)])]
forall k v. HashMap k v -> [(k, v)]
M.toList GSpan
gm
    lookSol :: KVar -> String
lookSol KVar
k    = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"NA" (Expr -> String
forall a. Pretty a => a -> String
pretty (Expr -> String) -> ((a, Expr) -> Expr) -> (a, Expr) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Expr) -> Expr
forall a b. (a, b) -> b
snd ((a, Expr) -> String) -> Maybe (a, Expr) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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) 



kVarSpan :: Symbol -> SrcSpan
kVarSpan :: Symbol -> SrcSpan
kVarSpan Symbol
k = SourcePos -> SourcePos -> SrcSpan
SS SourcePos
lc SourcePos
lc
  where
    L (Int
l, Int
c) = Symbol -> Loc
symbolLoc Symbol
k
    fn :: String
fn  = ShowS
takeFileName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Symbol -> String
symbolString Symbol
k
    lc :: SourcePos
lc = (String, Int, Int) -> SourcePos
toSourcePos (String
fn, Int
l, Int
c) 

takeFileName :: String -> String 
takeFileName :: ShowS
takeFileName (Char
'$':String
xs) = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') String
xs 
takeFileName String
_ = String
""

symbolLoc :: Symbol -> Loc
symbolLoc :: Symbol -> Loc
symbolLoc Symbol
x = (Int, Int) -> Loc
L (String -> Int
forall a. Read a => String -> a
read String
line, String -> Int
forall a. Read a => String -> a
read String
col)
  where
    (String
line, String
rest) = (Char -> Bool) -> String -> String -> (String, String)
forall a. Eq a => (a -> Bool) -> [a] -> [a] -> ([a], [a])
spanAfter Char -> Bool
C.isDigit String
"line " (Symbol -> String
symbolString Symbol
x)
    (String
col, String
_)     = (Char -> Bool) -> String -> String -> (String, String)
forall a. Eq a => (a -> Bool) -> [a] -> [a] -> ([a], [a])
spanAfter Char -> Bool
C.isDigit String
"column " String
rest
    spanAfter :: (a -> Bool) -> [a] -> [a] -> ([a], [a])
spanAfter a -> Bool
p [a]
str [a]
input = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span a -> Bool
p ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ Maybe [a] -> [a]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix [a]
str ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ 
                             [[a]] -> [a]
forall a. [a] -> a
head  ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf [a]
str) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
L.tails [a]
input