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 {uId :: Int, uLoc :: SrcSpan, uName :: Symbol}
type LocTokens = [(TokenType, String, Loc)]
type Deps = Dependencies ()
type SDeps = Dependencies String
type Dependencies val = [(Unique, [(Unique,val)])]
type PKeys = [[KVar]]
makePKeys :: [[GSub a]] -> PKeys
makePKeys sols = M.keys <$> head <$> sols
instance Show Unique where
show u = show (uLoc u)
kVarId :: Dependencies v -> KVar -> (Int, Int)
kVarId deps k = fromMaybe (0,0) $ L.lookup (kv k)
[(uName x,(uId ui, uId x)) | (ui, xs) <- deps, (x,_) <- xs]
srcDeps :: Dependencies v -> [(Int, Int, SrcSpan, v)]
srcDeps deps = [(uId ui, uId x, uLoc x, v) | (ui, xs) <- deps , (x,v) <- xs]
gSpanToDeps :: GSub a -> GSpan -> SDeps
gSpanToDeps sol gm = [(Unique i (kVarSpan $ kv k) (kv k), mapValues ks)
| ((k,ks),i) <- zip gml [1..]]
where
mapValues ks = [(Unique i s $ kv k, lookSol k) | ((k,Just s), i) <- zip ks [1..]]
gml = L.sortBy (\(k1,_) (k2,_) -> compare (kVarSpan $ kv k1) (kVarSpan $ kv k2))
$ M.toList gm
lookSol k = fromMaybe "NA" (pretty . snd <$> M.lookup k sol)
kVarSpan :: Symbol -> SrcSpan
kVarSpan k = SS lc lc
where
L (l, c) = symbolLoc k
fn = takeFileName $ symbolString k
lc = toSourcePos (fn, l, c)
takeFileName :: String -> String
takeFileName ('$':xs) = takeWhile (/= ' ') xs
takeFileName _ = ""
symbolLoc :: Symbol -> Loc
symbolLoc x = L (read line, read col)
where
(line, rest) = spanAfter C.isDigit "line " (symbolString x)
(col, _) = spanAfter C.isDigit "column " rest
spanAfter p str input = L.span p $ fromJust $ L.stripPrefix str $
head $ filter (L.isPrefixOf str) $ L.tails input