{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoOverloadedLists #-}
module Salak.Internal.Source where
import Control.Concurrent.MVar
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import qualified Data.Heap as H
import Salak.Internal.Key
import Salak.Internal.Val
import qualified Salak.Trie as T
type Source = T.Trie Vals
type TraceSource = T.Trie ([String], Vals)
data ReloadResult = ReloadResult
{ hasError :: !Bool
, msgs :: ![String]
} deriving Show
type QFunc = Source -> Either String (IO ())
type LFunc = String -> IO ()
data SourcePack = SourcePack
{ source :: !Source
, pref :: !Keys
, qref :: !(MVar QFunc)
, lref :: !(MVar LFunc)
, reload :: !(IO ReloadResult)
}
diff :: Source -> Source -> T.Trie ModType
diff = T.unionWith' go
where
go Nothing Nothing = Nothing
go (Just (Vals a)) Nothing = if H.null a then Nothing else Just Add
go Nothing (Just (Vals a)) = if H.null a then Nothing else Just Del
go (Just (Vals a)) (Just (Vals b))
| H.null a && H.null b = Nothing
| H.null a = Just Del
| H.null b = Just Add
| otherwise =
let Val i x = H.minimum a
Val j y = H.minimum b
in if i==j && x==y then Nothing else Just Mod
extract :: Source -> TraceSource -> (Source, T.Trie ModType, [String])
extract o t =
( t1
, diff t1 o
, concatMap (\(k,v)-> fmap (k++) v) list)
where
t1 = fmap snd t
list = fmap (\(k,v)->(show k,v)) $ T.toList $ fmap fst t
gen :: (Foldable f, ToKeys k, ToValue v) => Int -> f (k,v) -> TraceSource
gen i = foldr go T.empty
where
go (k,v) x = case toKeys k of
Left e -> T.alter (g3 e) mempty x
Right k' -> T.alter (g2 $ Val i $ toVal v) k' x
g2 v (Just (a,Vals c)) = Just (a, Vals $ H.insert v c)
g2 v _ = Just ([], Vals $ H.singleton v)
g3 e (Just (a,c)) = Just (e:a,c)
g3 e _ = Just ([e], Vals H.empty)
fmt :: ModType -> Int -> String -> String -> String
fmt m i s n = concat ['#' : show i, ' ' : show m, ' ' : s , ' ' : n]
fmtMod :: Int -> String -> HashMap String ModType -> [String]
fmtMod i name cs = fmap (\(k,v)-> fmt v i k name) (HM.toList cs)
loadSource :: (Int -> IO TraceSource) -> Int -> TraceSource -> IO TraceSource
loadSource f i ts = T.unionWith go ts <$> f i
where
go Nothing Nothing = Nothing
go (Just v) Nothing = Just v
go Nothing (Just v) = Just v
go (Just (e1,v1)) (Just (e2,v2)) = Just (e1++e2, modVals' v2 v1)
setVal :: ToValue v => Int -> v -> TraceSource -> TraceSource
setVal i v = T.update go
where
go Nothing = Just ([], modVals (Val i $ toVal v) emptyVals)
go (Just (e,vs)) = Just (e, modVals (Val i $ toVal v) vs)