-- | This module contains the code for Incremental checking, which finds the
--   part of a target file (the subset of the @[CoreBind]@ that have been
--   modified since it was last checked, as determined by a diff against
--   a saved version of the file.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}

module Language.Haskell.Liquid.UX.DiffCheck (

   -- * Changed binders + Unchanged Errors
     DiffCheck (..)

   -- * Use previously saved info to generate DiffCheck target
   , slice

   -- * Use target binders to generate DiffCheck target
   , thin -- , ThinDeps (..)

   -- * Save current information for next time
   , saveResult

   -- * Names of top-level binders that are rechecked
   , checkedVars

   -- * CoreBinds defining given set of Var
   , filterBinds
   , coreDeps
   , dependsOn
   )
   where


import           FastString                             (FastString)
import           Prelude                                hiding (error)
import           Data.Aeson
import qualified Data.Text                              as T
import           Data.Algorithm.Diff
import           Data.Maybe                             (listToMaybe, mapMaybe, fromMaybe)
import qualified Data.IntervalMap.FingerTree            as IM
import           CoreSyn                                hiding (sourceName)
import           Name                                   (getSrcSpan, NamedThing)
import           Outputable                             (Outputable, OutputableBndr)
import           SrcLoc                                 hiding (Located)
import           Var
import qualified Data.HashSet                           as S
import qualified Data.HashMap.Strict                    as M
import qualified Data.List                              as L
import           System.Directory                       (copyFile, doesFileExist)
import           Language.Fixpoint.Types                (atLoc, FixResult (..))
import           Language.Fixpoint.Utils.Files
import           Language.Fixpoint.Solver.Stats         as Solver
import           Language.Haskell.Liquid.Misc           (ifM, mkGraph)
import           Language.Haskell.Liquid.GHC.Misc
-- import           Language.Haskell.Liquid.Types.Visitors
import           Text.Parsec.Pos                        (sourceName, sourceLine, sourceColumn, SourcePos, newPos)
import           Text.PrettyPrint.HughesPJ              (text, render, Doc)
-- import           Language.Haskell.Liquid.Types.Errors
import qualified Data.ByteString                        as B
import qualified Data.ByteString.Lazy                   as LB                                               

import           Language.Haskell.Liquid.Types          hiding (Def, LMap)

--------------------------------------------------------------------------------
-- | Data Types ----------------------------------------------------------------
--------------------------------------------------------------------------------

-- | Main type of value returned for diff-check.
data DiffCheck = DC { DiffCheck -> [CoreBind]
newBinds  :: [CoreBind]
                    , DiffCheck -> Output Doc
oldOutput :: !(Output Doc)
                    , DiffCheck -> TargetSpec
newSpec   :: !TargetSpec
                    }

instance PPrint DiffCheck where
  pprintTidy :: Tidy -> DiffCheck -> Doc
pprintTidy Tidy
k = Tidy -> [Var] -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k ([Var] -> Doc) -> (DiffCheck -> [Var]) -> DiffCheck -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffCheck -> [Var]
checkedVars

-- | Variable definitions
data Def  = D { Def -> Int
start  :: Int -- ^ line at which binder definition starts
              , Def -> Int
end    :: Int -- ^ line at which binder definition ends
              , Def -> Var
binder :: Var -- ^ name of binder
              }
            deriving (Def -> Def -> Bool
(Def -> Def -> Bool) -> (Def -> Def -> Bool) -> Eq Def
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Def -> Def -> Bool
$c/= :: Def -> Def -> Bool
== :: Def -> Def -> Bool
$c== :: Def -> Def -> Bool
Eq, Eq Def
Eq Def
-> (Def -> Def -> Ordering)
-> (Def -> Def -> Bool)
-> (Def -> Def -> Bool)
-> (Def -> Def -> Bool)
-> (Def -> Def -> Bool)
-> (Def -> Def -> Def)
-> (Def -> Def -> Def)
-> Ord Def
Def -> Def -> Bool
Def -> Def -> Ordering
Def -> Def -> Def
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Def -> Def -> Def
$cmin :: Def -> Def -> Def
max :: Def -> Def -> Def
$cmax :: Def -> Def -> Def
>= :: Def -> Def -> Bool
$c>= :: Def -> Def -> Bool
> :: Def -> Def -> Bool
$c> :: Def -> Def -> Bool
<= :: Def -> Def -> Bool
$c<= :: Def -> Def -> Bool
< :: Def -> Def -> Bool
$c< :: Def -> Def -> Bool
compare :: Def -> Def -> Ordering
$ccompare :: Def -> Def -> Ordering
$cp1Ord :: Eq Def
Ord)

-- | Variable dependencies "call-graph"
type Deps = M.HashMap Var (S.HashSet Var)

-- | Map from saved-line-num ---> current-line-num
type LMap   = IM.IntervalMap Int Int

-- | Intervals of line numbers that have been re-checked
type ChkItv = IM.IntervalMap Int ()

instance Show Def where
  show :: Def -> String
show (D Int
i Int
j Var
x) = Var -> String
forall a. Outputable a => a -> String
showPpr Var
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" start: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" end: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j

--------------------------------------------------------------------------------
-- | `checkedNames` returns the names of the top-level binders that will be checked
--------------------------------------------------------------------------------
checkedVars              ::  DiffCheck -> [Var]
checkedVars :: DiffCheck -> [Var]
checkedVars              = (CoreBind -> [Var]) -> [CoreBind] -> [Var]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CoreBind -> [Var]
forall b. Bind b -> [b]
names ([CoreBind] -> [Var])
-> (DiffCheck -> [CoreBind]) -> DiffCheck -> [Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffCheck -> [CoreBind]
newBinds
   where
     names :: Bind b -> [b]
names (NonRec b
v Expr b
_ ) = [b
v]
     names (Rec [(b, Expr b)]
xs)      = (b, Expr b) -> b
forall a b. (a, b) -> a
fst ((b, Expr b) -> b) -> [(b, Expr b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(b, Expr b)]
xs

--------------------------------------------------------------------------------
-- | `slice` returns a subset of the @[CoreBind]@ of the input `target`
--    file which correspond to top-level binders whose code has changed
--    and their transitive dependencies.
--------------------------------------------------------------------------------
slice :: FilePath -> [CoreBind] -> TargetSpec -> IO (Maybe DiffCheck)
--------------------------------------------------------------------------------
slice :: String -> [CoreBind] -> TargetSpec -> IO (Maybe DiffCheck)
slice String
target [CoreBind]
cbs TargetSpec
sp = IO Bool
-> IO (Maybe DiffCheck)
-> IO (Maybe DiffCheck)
-> IO (Maybe DiffCheck)
forall (m :: * -> *) b. Monad m => m Bool -> m b -> m b -> m b
ifM (String -> IO Bool
doesFileExist String
savedFile)
                          IO (Maybe DiffCheck)
doDiffCheck
                          (Maybe DiffCheck -> IO (Maybe DiffCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiffCheck
forall a. Maybe a
Nothing)
  where
    savedFile :: String
savedFile       = Ext -> ShowS
extFileName Ext
Saved String
target
    doDiffCheck :: IO (Maybe DiffCheck)
doDiffCheck     = String
-> String -> [CoreBind] -> TargetSpec -> IO (Maybe DiffCheck)
sliceSaved String
target String
savedFile [CoreBind]
cbs TargetSpec
sp

sliceSaved :: FilePath -> FilePath -> [CoreBind] -> TargetSpec -> IO (Maybe DiffCheck)
sliceSaved :: String
-> String -> [CoreBind] -> TargetSpec -> IO (Maybe DiffCheck)
sliceSaved String
target String
savedFile [CoreBind]
coreBinds TargetSpec
spec = do
  ([Int]
is, LMap
lm) <- String -> String -> IO ([Int], LMap)
lineDiff String
target String
savedFile
  Output Doc
result   <- String -> IO (Output Doc)
loadResult String
target
  Maybe DiffCheck -> IO (Maybe DiffCheck)
forall (m :: * -> *) a. Monad m => a -> m a
return    (Maybe DiffCheck -> IO (Maybe DiffCheck))
-> Maybe DiffCheck -> IO (Maybe DiffCheck)
forall a b. (a -> b) -> a -> b
$ String -> [Int] -> LMap -> DiffCheck -> Maybe DiffCheck
sliceSaved' String
target [Int]
is LMap
lm ([CoreBind] -> Output Doc -> TargetSpec -> DiffCheck
DC [CoreBind]
coreBinds Output Doc
result TargetSpec
spec)

sliceSaved' :: FilePath -> [Int] -> LMap -> DiffCheck -> Maybe DiffCheck
sliceSaved' :: String -> [Int] -> LMap -> DiffCheck -> Maybe DiffCheck
sliceSaved' String
srcF [Int]
is LMap
lm (DC [CoreBind]
coreBinds Output Doc
result TargetSpec
spec)
  | Bool
gDiff     = Maybe DiffCheck
forall a. Maybe a
Nothing
  | Bool
otherwise = DiffCheck -> Maybe DiffCheck
forall a. a -> Maybe a
Just (DiffCheck -> Maybe DiffCheck) -> DiffCheck -> Maybe DiffCheck
forall a b. (a -> b) -> a -> b
$ [CoreBind] -> Output Doc -> TargetSpec -> DiffCheck
DC [CoreBind]
cbs' Output Doc
res' TargetSpec
sp'
  where
    gDiff :: Bool
gDiff     = String -> [Int] -> TargetSpec -> Bool
globalDiff String
srcF [Int]
is TargetSpec
spec
    sp' :: TargetSpec
sp'       = HashMap Var LocSpecType -> TargetSpec -> TargetSpec
assumeSpec HashMap Var LocSpecType
sigm TargetSpec
spec
    res' :: Output Doc
res'      = LMap -> ChkItv -> Output Doc -> Output Doc
adjustOutput LMap
lm ChkItv
cm Output Doc
result
    cm :: ChkItv
cm        = [Def] -> ChkItv
checkedItv ([CoreBind] -> [Def]
coreDefs [CoreBind]
cbs')
    cbs' :: [CoreBind]
cbs'      = HashSet Var -> [CoreBind] -> [Var] -> [CoreBind]
thinWith HashSet Var
sigs [CoreBind]
coreBinds ([Int] -> [Def] -> [Var]
diffVars [Int]
is [Def]
defs)
    defs :: [Def]
defs      = [CoreBind] -> [Def]
coreDefs [CoreBind]
coreBinds [Def] -> [Def] -> [Def]
forall a. [a] -> [a] -> [a]
++ String -> TargetSpec -> [Def]
specDefs String
srcF TargetSpec
spec
    sigs :: HashSet Var
sigs      = [Var] -> HashSet Var
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList ([Var] -> HashSet Var) -> [Var] -> HashSet Var
forall a b. (a -> b) -> a -> b
$ HashMap Var LocSpecType -> [Var]
forall k v. HashMap k v -> [k]
M.keys HashMap Var LocSpecType
sigm
    sigm :: HashMap Var LocSpecType
sigm      = String -> [Int] -> TargetSpec -> HashMap Var LocSpecType
sigVars String
srcF [Int]
is TargetSpec
spec

-- | Add the specified signatures for vars-with-preserved-sigs,
--   whose bodies have been pruned from [CoreBind] into the "assumes"

assumeSpec :: M.HashMap Var LocSpecType -> TargetSpec -> TargetSpec
assumeSpec :: HashMap Var LocSpecType -> TargetSpec -> TargetSpec
assumeSpec HashMap Var LocSpecType
sigm TargetSpec
sp = TargetSpec
sp { gsSig :: GhcSpecSig
gsSig = GhcSpecSig
gsig { gsAsmSigs :: [(Var, LocSpecType)]
gsAsmSigs = HashMap Var LocSpecType -> [(Var, LocSpecType)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap Var LocSpecType -> [(Var, LocSpecType)])
-> HashMap Var LocSpecType -> [(Var, LocSpecType)]
forall a b. (a -> b) -> a -> b
$ HashMap Var LocSpecType
-> HashMap Var LocSpecType -> HashMap Var LocSpecType
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union HashMap Var LocSpecType
sigm HashMap Var LocSpecType
assm } }
  where
    assm :: HashMap Var LocSpecType
assm           = [(Var, LocSpecType)] -> HashMap Var LocSpecType
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList (GhcSpecSig -> [(Var, LocSpecType)]
gsAsmSigs GhcSpecSig
gsig) 
    gsig :: GhcSpecSig
gsig           = TargetSpec -> GhcSpecSig
gsSig TargetSpec
sp

diffVars :: [Int] -> [Def] -> [Var]
diffVars :: [Int] -> [Def] -> [Var]
diffVars [Int]
ls [Def]
defs'    = -- tracePpr ("INCCHECK: diffVars lines = " ++ show ls ++ " defs= " ++ show defs) $
                         [Int] -> [Def] -> [Var]
go ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort [Int]
ls) [Def]
defs
  where
    defs :: [Def]
defs             = [Def] -> [Def]
forall a. Ord a => [a] -> [a]
L.sort [Def]
defs'
    go :: [Int] -> [Def] -> [Var]
go [Int]
_      []     = []
    go []     [Def]
_      = []
    go (Int
i:[Int]
is) (Def
d:[Def]
ds)
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Def -> Int
start Def
d  = [Int] -> [Def] -> [Var]
go [Int]
is (Def
dDef -> [Def] -> [Def]
forall a. a -> [a] -> [a]
:[Def]
ds)
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Def -> Int
end Def
d    = [Int] -> [Def] -> [Var]
go (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is) [Def]
ds
      | Bool
otherwise    = Def -> Var
binder Def
d Var -> [Var] -> [Var]
forall a. a -> [a] -> [a]
: [Int] -> [Def] -> [Var]
go (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is) [Def]
ds

sigVars :: FilePath -> [Int] -> TargetSpec -> M.HashMap Var LocSpecType
sigVars :: String -> [Int] -> TargetSpec -> HashMap Var LocSpecType
sigVars String
srcF [Int]
ls TargetSpec
sp = [(Var, LocSpecType)] -> HashMap Var LocSpecType
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Var, LocSpecType)] -> HashMap Var LocSpecType)
-> [(Var, LocSpecType)] -> HashMap Var LocSpecType
forall a b. (a -> b) -> a -> b
$ ((Var, LocSpecType) -> Bool)
-> [(Var, LocSpecType)] -> [(Var, LocSpecType)]
forall a. (a -> Bool) -> [a] -> [a]
filter (LocSpecType -> Bool
forall a. Located a -> Bool
ok (LocSpecType -> Bool)
-> ((Var, LocSpecType) -> LocSpecType)
-> (Var, LocSpecType)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, LocSpecType) -> LocSpecType
forall a b. (a, b) -> b
snd) ([(Var, LocSpecType)] -> [(Var, LocSpecType)])
-> [(Var, LocSpecType)] -> [(Var, LocSpecType)]
forall a b. (a -> b) -> a -> b
$ TargetSpec -> [(Var, LocSpecType)]
specSigs TargetSpec
sp
  where
    ok :: Located a -> Bool
ok             = Bool -> Bool
not (Bool -> Bool) -> (Located a -> Bool) -> Located a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int] -> Located a -> Bool
forall a. String -> [Int] -> Located a -> Bool
isDiff String
srcF [Int]
ls

globalDiff :: FilePath -> [Int] -> TargetSpec -> Bool
globalDiff :: String -> [Int] -> TargetSpec -> Bool
globalDiff String
srcF [Int]
ls TargetSpec
gspec = Bool
measDiff Bool -> Bool -> Bool
|| Bool
invsDiff Bool -> Bool -> Bool
|| Bool
dconsDiff
  where
    measDiff :: Bool
measDiff  = (LocSpecType -> Bool) -> [LocSpecType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [Int] -> LocSpecType -> Bool
forall a. String -> [Int] -> Located a -> Bool
isDiff String
srcF [Int]
ls) ((Symbol, LocSpecType) -> LocSpecType
forall a b. (a, b) -> b
snd ((Symbol, LocSpecType) -> LocSpecType)
-> [(Symbol, LocSpecType)] -> [LocSpecType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSpecData -> [(Symbol, LocSpecType)]
gsMeas GhcSpecData
spec)
    invsDiff :: Bool
invsDiff  = (LocSpecType -> Bool) -> [LocSpecType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [Int] -> LocSpecType -> Bool
forall a. String -> [Int] -> Located a -> Bool
isDiff String
srcF [Int]
ls) ((Maybe Var, LocSpecType) -> LocSpecType
forall a b. (a, b) -> b
snd ((Maybe Var, LocSpecType) -> LocSpecType)
-> [(Maybe Var, LocSpecType)] -> [LocSpecType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSpecData -> [(Maybe Var, LocSpecType)]
gsInvariants GhcSpecData
spec)
    dconsDiff :: Bool
dconsDiff = (Located () -> Bool) -> [Located ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [Int] -> Located () -> Bool
forall a. String -> [Int] -> Located a -> Bool
isDiff String
srcF [Int]
ls) [ Located DataCon -> () -> Located ()
forall l b. Loc l => l -> b -> Located b
atLoc Located DataCon
ldc () | Located DataCon
ldc <- GhcSpecNames -> [Located DataCon]
gsDconsP (TargetSpec -> GhcSpecNames
gsName TargetSpec
gspec) ]
    spec :: GhcSpecData
spec      = TargetSpec -> GhcSpecData
gsData TargetSpec
gspec
    -- (dloc . snd <$> gsDconsP spec)
    -- dloc dc   = Loc (dc_loc dc) (dc_locE dc) ()


isDiff :: FilePath -> [Int] -> Located a -> Bool
isDiff :: String -> [Int] -> Located a -> Bool
isDiff String
srcF [Int]
ls Located a
x = Located a -> String
forall a. Located a -> String
file Located a
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
srcF Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Int -> Bool
hits [Int]
ls
  where
    hits :: Int -> Bool
hits Int
i       = Located a -> Int
forall a. Located a -> Int
line Located a
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Located a -> Int
forall a. Located a -> Int
lineE Located a
x

--------------------------------------------------------------------------------
-- | @thin cbs sp vs@ returns a subset of the @cbs :: [CoreBind]@ which
--   correspond to the definitions of @vs@ and the functions transitively
--   called therein for which there are *no* type signatures. Callees with
--   type signatures are assumed to satisfy those signatures.
--------------------------------------------------------------------------------

{- data ThinDeps = Trans [Var] -- ^ Check all transitive dependencies
              | None   Var  -- ^ Check only the given binders
 -}

--------------------------------------------------------------------------------
thin :: [CoreBind] -> TargetSpec -> [Var] -> DiffCheck
--------------------------------------------------------------------------------
-- thin cbs sp (Trans vs) = DC (thinWith S.empty cbs vs ) mempty sp
thin :: [CoreBind] -> TargetSpec -> [Var] -> DiffCheck
thin [CoreBind]
cbs TargetSpec
sp [Var]
vs = [CoreBind] -> Output Doc -> TargetSpec -> DiffCheck
DC ([CoreBind] -> HashSet Var -> [CoreBind]
filterBinds      [CoreBind]
cbs HashSet Var
vs') Output Doc
forall a. Monoid a => a
mempty TargetSpec
sp'
  where
    vs' :: HashSet Var
vs'        = Deps -> HashSet Var -> HashSet Var -> HashSet Var
txClosure ([CoreBind] -> Deps
coreDeps [CoreBind]
cbs) HashSet Var
xs ([Var] -> HashSet Var
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [Var]
vs)
    sp' :: TargetSpec
sp'        = HashMap Var LocSpecType -> TargetSpec -> TargetSpec
assumeSpec HashMap Var LocSpecType
sigs' TargetSpec
sp
    sigs' :: HashMap Var LocSpecType
sigs'      = (Var -> HashMap Var LocSpecType -> HashMap Var LocSpecType)
-> HashMap Var LocSpecType -> [Var] -> HashMap Var LocSpecType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Var -> HashMap Var LocSpecType -> HashMap Var LocSpecType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete ([(Var, LocSpecType)] -> HashMap Var LocSpecType
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(Var, LocSpecType)]
xts) [Var]
vs
    xts :: [(Var, LocSpecType)]
xts        = TargetSpec -> [(Var, LocSpecType)]
specSigs TargetSpec
sp
    xs :: HashSet Var
xs         = [Var] -> HashSet Var
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList ([Var] -> HashSet Var) -> [Var] -> HashSet Var
forall a b. (a -> b) -> a -> b
$ (Var, LocSpecType) -> Var
forall a b. (a, b) -> a
fst ((Var, LocSpecType) -> Var) -> [(Var, LocSpecType)] -> [Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, LocSpecType)]
xts

thinWith :: S.HashSet Var -> [CoreBind] -> [Var] -> [CoreBind]
thinWith :: HashSet Var -> [CoreBind] -> [Var] -> [CoreBind]
thinWith HashSet Var
sigs [CoreBind]
cbs [Var]
xs = [CoreBind] -> HashSet Var -> [CoreBind]
filterBinds [CoreBind]
cbs HashSet Var
ys
  where
    ys :: HashSet Var
ys       = HashSet Var
calls HashSet Var -> HashSet Var -> HashSet Var
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`S.union` HashSet Var
calledBy
    calls :: HashSet Var
calls    = Deps -> HashSet Var -> HashSet Var -> HashSet Var
txClosure ([CoreBind] -> Deps
coreDeps [CoreBind]
cbs) HashSet Var
sigs ([Var] -> HashSet Var
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [Var]
xs)
    calledBy :: HashSet Var
calledBy = Deps -> [Var] -> HashSet Var
dependsOn ([CoreBind] -> Deps
coreDeps [CoreBind]
cbs) [Var]
xs

coreDeps    :: [CoreBind] -> Deps
coreDeps :: [CoreBind] -> Deps
coreDeps [CoreBind]
bs = [(Var, Var)] -> Deps
forall a b.
(Eq a, Eq b, Hashable a, Hashable b) =>
[(a, b)] -> HashMap a (HashSet b)
mkGraph ([(Var, Var)] -> Deps) -> [(Var, Var)] -> Deps
forall a b. (a -> b) -> a -> b
$ [(Var, Var)]
calls [(Var, Var)] -> [(Var, Var)] -> [(Var, Var)]
forall a. [a] -> [a] -> [a]
++ [(Var, Var)]
calls'
  where
    calls :: [(Var, Var)]
calls   = (CoreBind -> [(Var, Var)]) -> [CoreBind] -> [(Var, Var)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CoreBind -> [(Var, Var)]
forall a. CBVisitable (Bind a) => Bind a -> [(a, Var)]
deps [CoreBind]
bs
    calls' :: [(Var, Var)]
calls'  = [(Var
y, Var
x) | (Var
x, Var
y) <- [(Var, Var)]
calls]
    deps :: Bind a -> [(a, Var)]
deps Bind a
b  = [(a
x, Var
y) | a
x <- Bind a -> [a]
forall b. Bind b -> [b]
bindersOf Bind a
b
                      , Var
y <- HashSet Var -> Bind a -> [Var]
forall a. CBVisitable a => HashSet Var -> a -> [Var]
freeVars HashSet Var
forall a. HashSet a
S.empty Bind a
b]

-- | Given a call graph, and a list of vars, `dependsOn`
--   checks all functions to see if they call any of the
--   functions in the vars list.
--   If any do, then they must also be rechecked.

dependsOn :: Deps -> [Var] -> S.HashSet Var
dependsOn :: Deps -> [Var] -> HashSet Var
dependsOn Deps
cg [Var]
vars  = [Var] -> HashSet Var
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [Var]
results
  where
    preds :: [HashSet Var -> Bool]
preds          = (Var -> HashSet Var -> Bool) -> [Var] -> [HashSet Var -> Bool]
forall a b. (a -> b) -> [a] -> [b]
map Var -> HashSet Var -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member [Var]
vars
    filteredMaps :: [Deps]
filteredMaps   = (HashSet Var -> Bool) -> Deps -> Deps
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
M.filter ((HashSet Var -> Bool) -> Deps -> Deps)
-> [HashSet Var -> Bool] -> [Deps -> Deps]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashSet Var -> Bool]
preds [Deps -> Deps] -> [Deps] -> [Deps]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Deps -> [Deps]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Deps
cg
    results :: [Var]
results        = ((Var, HashSet Var) -> Var) -> [(Var, HashSet Var)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, HashSet Var) -> Var
forall a b. (a, b) -> a
fst ([(Var, HashSet Var)] -> [Var]) -> [(Var, HashSet Var)] -> [Var]
forall a b. (a -> b) -> a -> b
$ Deps -> [(Var, HashSet Var)]
forall k v. HashMap k v -> [(k, v)]
M.toList (Deps -> [(Var, HashSet Var)]) -> Deps -> [(Var, HashSet Var)]
forall a b. (a -> b) -> a -> b
$ [Deps] -> Deps
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
M.unions [Deps]
filteredMaps

txClosure :: Deps -> S.HashSet Var -> S.HashSet Var -> S.HashSet Var
txClosure :: Deps -> HashSet Var -> HashSet Var -> HashSet Var
txClosure Deps
d HashSet Var
sigs    = HashSet Var -> HashSet Var -> HashSet Var
go HashSet Var
forall a. HashSet a
S.empty
  where
    next :: HashSet Var -> HashSet Var
next            = [HashSet Var] -> HashSet Var
forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a
S.unions ([HashSet Var] -> HashSet Var)
-> (HashSet Var -> [HashSet Var]) -> HashSet Var -> HashSet Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var -> HashSet Var) -> [Var] -> [HashSet Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var -> HashSet Var
deps ([Var] -> [HashSet Var])
-> (HashSet Var -> [Var]) -> HashSet Var -> [HashSet Var]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet Var -> [Var]
forall a. HashSet a -> [a]
S.toList
    deps :: Var -> HashSet Var
deps Var
x          = HashSet Var -> Var -> Deps -> HashSet Var
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault HashSet Var
forall a. HashSet a
S.empty Var
x Deps
d
    go :: HashSet Var -> HashSet Var -> HashSet Var
go HashSet Var
seen HashSet Var
new
      | HashSet Var -> Bool
forall a. HashSet a -> Bool
S.null HashSet Var
new  = HashSet Var
seen
      | Bool
otherwise   = let seen' :: HashSet Var
seen' = HashSet Var -> HashSet Var -> HashSet Var
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
S.union HashSet Var
seen HashSet Var
new
                          new' :: HashSet Var
new'  = HashSet Var -> HashSet Var
next HashSet Var
new HashSet Var -> HashSet Var -> HashSet Var
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`S.difference` HashSet Var
seen'
                          new'' :: HashSet Var
new'' = HashSet Var
new'     HashSet Var -> HashSet Var -> HashSet Var
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`S.difference` HashSet Var
sigs
                      in HashSet Var -> HashSet Var -> HashSet Var
go HashSet Var
seen' HashSet Var
new''



--------------------------------------------------------------------------------
filterBinds        :: [CoreBind] -> S.HashSet Var -> [CoreBind]
--------------------------------------------------------------------------------
filterBinds :: [CoreBind] -> HashSet Var -> [CoreBind]
filterBinds [CoreBind]
cbs HashSet Var
ys = (CoreBind -> Bool) -> [CoreBind] -> [CoreBind]
forall a. (a -> Bool) -> [a] -> [a]
filter CoreBind -> Bool
f [CoreBind]
cbs
  where
    f :: CoreBind -> Bool
f (NonRec Var
x Expr Var
_) = Var
x Var -> HashSet Var -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet Var
ys
    f (Rec [(Var, Expr Var)]
xes)    = (Var -> Bool) -> [Var] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Var -> HashSet Var -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet Var
ys) ([Var] -> Bool) -> [Var] -> Bool
forall a b. (a -> b) -> a -> b
$ (Var, Expr Var) -> Var
forall a b. (a, b) -> a
fst ((Var, Expr Var) -> Var) -> [(Var, Expr Var)] -> [Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, Expr Var)]
xes


--------------------------------------------------------------------------------
specDefs :: FilePath -> TargetSpec -> [Def]
--------------------------------------------------------------------------------
specDefs :: String -> TargetSpec -> [Def]
specDefs String
srcF  = ((Var, LocSpecType) -> Def) -> [(Var, LocSpecType)] -> [Def]
forall a b. (a -> b) -> [a] -> [b]
map (Var, LocSpecType) -> Def
forall a. (Var, Located a) -> Def
def ([(Var, LocSpecType)] -> [Def])
-> (TargetSpec -> [(Var, LocSpecType)]) -> TargetSpec -> [Def]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Var, LocSpecType) -> Bool)
-> [(Var, LocSpecType)] -> [(Var, LocSpecType)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Var, LocSpecType) -> Bool
forall a a. (a, Located a) -> Bool
sameFile ([(Var, LocSpecType)] -> [(Var, LocSpecType)])
-> (TargetSpec -> [(Var, LocSpecType)])
-> TargetSpec
-> [(Var, LocSpecType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetSpec -> [(Var, LocSpecType)]
specSigs
  where
    def :: (Var, Located a) -> Def
def (Var
x, Located a
t) = Int -> Int -> Var -> Def
D (Located a -> Int
forall a. Located a -> Int
line Located a
t) (Located a -> Int
forall a. Located a -> Int
lineE Located a
t) Var
x
    sameFile :: (a, Located a) -> Bool
sameFile   = (String
srcF String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> ((a, Located a) -> String) -> (a, Located a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> String
forall a. Located a -> String
file (Located a -> String)
-> ((a, Located a) -> Located a) -> (a, Located a) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Located a) -> Located a
forall a b. (a, b) -> b
snd

specSigs :: TargetSpec -> [(Var, LocSpecType)]
specSigs :: TargetSpec -> [(Var, LocSpecType)]
specSigs TargetSpec
sp = GhcSpecSig -> [(Var, LocSpecType)]
gsTySigs  (TargetSpec -> GhcSpecSig
gsSig  TargetSpec
sp) 
           [(Var, LocSpecType)]
-> [(Var, LocSpecType)] -> [(Var, LocSpecType)]
forall a. [a] -> [a] -> [a]
++ GhcSpecSig -> [(Var, LocSpecType)]
gsAsmSigs (TargetSpec -> GhcSpecSig
gsSig  TargetSpec
sp) 
           [(Var, LocSpecType)]
-> [(Var, LocSpecType)] -> [(Var, LocSpecType)]
forall a. [a] -> [a] -> [a]
++ GhcSpecData -> [(Var, LocSpecType)]
gsCtors   (TargetSpec -> GhcSpecData
gsData TargetSpec
sp)

--------------------------------------------------------------------------------
coreDefs     :: [CoreBind] -> [Def]
--------------------------------------------------------------------------------
coreDefs :: [CoreBind] -> [Def]
coreDefs [CoreBind]
cbs = [Def] -> [Def]
forall a. Ord a => [a] -> [a]
L.sort [Int -> Int -> Var -> Def
D Int
l Int
l' Var
x | CoreBind
b <- [CoreBind]
cbs
                                , Var
x <- CoreBind -> [Var]
forall b. Bind b -> [b]
bindersOf CoreBind
b
                                , SrcSpan -> Bool
isGoodSrcSpan (Var -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Var
x)
                                , (Int
l, Int
l') <- CoreBind -> [(Int, Int)]
forall a.
(NamedThing a, OutputableBndr a) =>
Bind a -> [(Int, Int)]
coreDef CoreBind
b]

coreDef :: (NamedThing a, OutputableBndr a)
        => Bind a -> [(Int, Int)]
coreDef :: Bind a -> [(Int, Int)]
coreDef Bind a
b    = Bind a -> Maybe (Int, Int) -> Maybe (Int, Int) -> [(Int, Int)]
forall t1 t t2 t3.
Ord t1 =>
t -> Maybe (t1, t2) -> Maybe (t1, t3) -> [(t1, t2)]
meetSpans Bind a
b Maybe (Int, Int)
eSp Maybe (Int, Int)
vSp
  where
    eSp :: Maybe (Int, Int)
eSp      = Bind a -> SrcSpan -> Maybe (Int, Int)
forall t. t -> SrcSpan -> Maybe (Int, Int)
lineSpan Bind a
b (SrcSpan -> Maybe (Int, Int)) -> SrcSpan -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ Bind a -> [SrcSpan] -> SrcSpan
forall r.
(NamedThing r, OutputableBndr r) =>
Bind r -> [SrcSpan] -> SrcSpan
catSpans Bind a
b ([SrcSpan] -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Bind a -> [SrcSpan]
forall a. NamedThing a => Bind a -> [SrcSpan]
bindSpans Bind a
b
    vSp :: Maybe (Int, Int)
vSp      = Bind a -> SrcSpan -> Maybe (Int, Int)
forall t. t -> SrcSpan -> Maybe (Int, Int)
lineSpan Bind a
b (SrcSpan -> Maybe (Int, Int)) -> SrcSpan -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ Bind a -> [SrcSpan] -> SrcSpan
forall r.
(NamedThing r, OutputableBndr r) =>
Bind r -> [SrcSpan] -> SrcSpan
catSpans Bind a
b ([SrcSpan] -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a b. (a -> b) -> a -> b
$ a -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan (a -> SrcSpan) -> [a] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bind a -> [a]
forall b. Bind b -> [b]
bindersOf Bind a
b


--------------------------------------------------------------------------------
-- | `meetSpans` cuts off the start-line to be no less than the line at which
--   the binder is defined. Without this, i.e. if we ONLY use the ticks and
--   spans appearing inside the definition of the binder (i.e. just `eSp`)
--   then the generated span can be WAY before the actual definition binder,
--   possibly due to GHC INLINE pragmas or dictionaries OR ...
--   for an example: see the "INCCHECK: Def" generated by
--      liquid -d benchmarks/bytestring-0.9.2.1/Data/ByteString.hs
--   where `spanEnd` is a single line function around 1092 but where
--   the generated span starts mysteriously at 222 where Data.List is imported.

meetSpans :: Ord t1 => t -> Maybe (t1, t2) -> Maybe (t1, t3) -> [(t1, t2)]
meetSpans :: t -> Maybe (t1, t2) -> Maybe (t1, t3) -> [(t1, t2)]
meetSpans t
_ Maybe (t1, t2)
Nothing       Maybe (t1, t3)
_
  = []
meetSpans t
_ (Just (t1
l,t2
l')) Maybe (t1, t3)
Nothing
  = [(t1
l, t2
l')]
meetSpans t
_ (Just (t1
l,t2
l')) (Just (t1
m,t3
_))
  = [(t1 -> t1 -> t1
forall a. Ord a => a -> a -> a
max t1
l t1
m, t2
l')]

lineSpan :: t -> SrcSpan -> Maybe (Int, Int)
lineSpan :: t -> SrcSpan -> Maybe (Int, Int)
lineSpan t
_ (RealSrcSpan RealSrcSpan
sp) = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
sp, RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
sp)
lineSpan t
_ SrcSpan
_                = Maybe (Int, Int)
forall a. Maybe a
Nothing

catSpans :: (NamedThing r, OutputableBndr r)
         => Bind r -> [SrcSpan] -> SrcSpan
catSpans :: Bind r -> [SrcSpan] -> SrcSpan
catSpans Bind r
b []               = Maybe SrcSpan -> String -> SrcSpan
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing (String -> SrcSpan) -> String -> SrcSpan
forall a b. (a -> b) -> a -> b
$ String
"DIFFCHECK: catSpans: no spans found for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bind r -> String
forall a. Outputable a => a -> String
showPpr Bind r
b
catSpans Bind r
b [SrcSpan]
xs               = (SrcSpan -> SrcSpan -> SrcSpan) -> SrcSpan -> [SrcSpan] -> SrcSpan
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
noSrcSpan [SrcSpan
x | x :: SrcSpan
x@(RealSrcSpan RealSrcSpan
z) <- [SrcSpan]
xs, Bind r -> FastString
forall r. (Outputable r, NamedThing r) => Bind r -> FastString
bindFile Bind r
b FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
z]

bindFile
  :: (Outputable r, NamedThing r) =>
     Bind r -> FastString
bindFile :: Bind r -> FastString
bindFile (NonRec r
x Expr r
_) = r -> FastString
forall a. (Outputable a, NamedThing a) => a -> FastString
varFile r
x
bindFile (Rec [(r, Expr r)]
xes)    = r -> FastString
forall a. (Outputable a, NamedThing a) => a -> FastString
varFile (r -> FastString) -> r -> FastString
forall a b. (a -> b) -> a -> b
$ (r, Expr r) -> r
forall a b. (a, b) -> a
fst ((r, Expr r) -> r) -> (r, Expr r) -> r
forall a b. (a -> b) -> a -> b
$ [(r, Expr r)] -> (r, Expr r)
forall a. [a] -> a
head [(r, Expr r)]
xes

varFile :: (Outputable a, NamedThing a) => a -> FastString
varFile :: a -> FastString
varFile a
b = case a -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan a
b of
              RealSrcSpan RealSrcSpan
z -> RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
z
              SrcSpan
_             -> Maybe SrcSpan -> String -> FastString
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing (String -> FastString) -> String -> FastString
forall a b. (a -> b) -> a -> b
$ String
"DIFFCHECK: getFile: no file found for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Outputable a => a -> String
showPpr a
b


bindSpans :: NamedThing a => Bind a -> [SrcSpan]
bindSpans :: Bind a -> [SrcSpan]
bindSpans (NonRec a
x Expr a
e)    = a -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan a
x SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a
e
bindSpans (Rec    [(a, Expr a)]
xes)    = (a -> SrcSpan) -> [a] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map a -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan [a]
xs [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ (Expr a -> [SrcSpan]) -> [Expr a] -> [SrcSpan]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans [Expr a]
es
  where
    ([a]
xs, [Expr a]
es)              = [(a, Expr a)] -> ([a], [Expr a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, Expr a)]
xes

exprSpans :: NamedThing a => Expr a -> [SrcSpan]
exprSpans :: Expr a -> [SrcSpan]
exprSpans (Tick Tickish Var
t Expr a
e)
  | SrcSpan -> Bool
isJunkSpan SrcSpan
sp         = Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a
e
  | Bool
otherwise             = [SrcSpan
sp]
  where
    sp :: SrcSpan
sp                    = Tickish Var -> SrcSpan
forall a. Outputable a => Tickish a -> SrcSpan
tickSrcSpan Tickish Var
t

exprSpans (Var Var
x)         = [Var -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Var
x]
exprSpans (Lam a
x Expr a
e)       = a -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan a
x SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a
e
exprSpans (App Expr a
e Expr a
a)       = Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a
e [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a
a
exprSpans (Let Bind a
b Expr a
e)       = Bind a -> [SrcSpan]
forall a. NamedThing a => Bind a -> [SrcSpan]
bindSpans Bind a
b [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a
e
exprSpans (Cast Expr a
e Coercion
_)      = Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a
e
exprSpans (Case Expr a
e a
x Type
_ [Alt a]
cs) = a -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan a
x SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: Expr a -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a
e [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ (Alt a -> [SrcSpan]) -> [Alt a] -> [SrcSpan]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Alt a -> [SrcSpan]
forall a a1 t.
(NamedThing a, NamedThing a1) =>
(t, [a], Expr a1) -> [SrcSpan]
altSpans [Alt a]
cs
exprSpans Expr a
_               = []

altSpans :: (NamedThing a, NamedThing a1) => (t, [a], Expr a1) -> [SrcSpan]
altSpans :: (t, [a], Expr a1) -> [SrcSpan]
altSpans (t
_, [a]
xs, Expr a1
e)       = (a -> SrcSpan) -> [a] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map a -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan [a]
xs [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ Expr a1 -> [SrcSpan]
forall a. NamedThing a => Expr a -> [SrcSpan]
exprSpans Expr a1
e

isJunkSpan :: SrcSpan -> Bool
isJunkSpan :: SrcSpan -> Bool
isJunkSpan (RealSrcSpan RealSrcSpan
_) = Bool
False
isJunkSpan SrcSpan
_               = Bool
True

--------------------------------------------------------------------------------
-- | Diff Interface ------------------------------------------------------------
--------------------------------------------------------------------------------
-- | `lineDiff new old` compares the contents of `src` with `dst`
--   and returns the lines of `src` that are different.
--------------------------------------------------------------------------------
lineDiff :: FilePath -> FilePath -> IO ([Int], LMap)
--------------------------------------------------------------------------------
lineDiff :: String -> String -> IO ([Int], LMap)
lineDiff String
new String
old  = [String] -> [String] -> ([Int], LMap)
lineDiff' ([String] -> [String] -> ([Int], LMap))
-> IO [String] -> IO ([String] -> ([Int], LMap))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getLines String
new IO ([String] -> ([Int], LMap)) -> IO [String] -> IO ([Int], LMap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO [String]
getLines String
old
  where
    getLines :: String -> IO [String]
getLines      = (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> [String]
lines (IO String -> IO [String])
-> (String -> IO String) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

lineDiff' :: [String] -> [String] -> ([Int], LMap)
lineDiff' :: [String] -> [String] -> ([Int], LMap)
lineDiff' [String]
new [String]
old = ([Int]
changedLines, LMap
lm)
  where
    changedLines :: [Int]
changedLines  = Int -> [Diff Int] -> [Int]
diffLines Int
1 [Diff Int]
diffLineCount
    lm :: LMap
lm            = ((Int, Int, Int) -> LMap -> LMap)
-> LMap -> [(Int, Int, Int)] -> LMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int, Int) -> LMap -> LMap
setShift LMap
forall v a. Ord v => IntervalMap v a
IM.empty ([(Int, Int, Int)] -> LMap) -> [(Int, Int, Int)] -> LMap
forall a b. (a -> b) -> a -> b
$ [Diff Int] -> [(Int, Int, Int)]
diffShifts [Diff Int]
diffLineCount
    diffLineCount :: [Diff Int]
diffLineCount = ([String] -> Int) -> Diff [String] -> Diff Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Diff [String] -> Diff Int) -> [Diff [String]] -> [Diff Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String] -> [Diff [String]]
forall t. Eq t => [t] -> [t] -> [Diff [t]]
getGroupedDiff [String]
new [String]
old

-- | Identifies lines that have changed
diffLines :: Int        -- ^ Starting line
          -> [Diff Int] -- ^ List of lengths of diffs
          -> [Int]      -- ^ List of changed line numbers
diffLines :: Int -> [Diff Int] -> [Int]
diffLines Int
_ []                        = []
diffLines Int
curr (Both Int
lnsUnchgd Int
_ : [Diff Int]
d) = Int -> [Diff Int] -> [Int]
diffLines Int
toSkip [Diff Int]
d
   where toSkip :: Int
toSkip = Int
curr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lnsUnchgd
diffLines Int
curr (First Int
lnsChgd : [Diff Int]
d)    = [Int
curr..(Int
toTakeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Diff Int] -> [Int]
diffLines Int
toTake [Diff Int]
d
   where toTake :: Int
toTake = Int
curr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lnsChgd
diffLines Int
curr (Diff Int
_ : [Diff Int]
d)                = Int -> [Diff Int] -> [Int]
diffLines Int
curr [Diff Int]
d

diffShifts :: [Diff Int] -> [(Int, Int, Int)]
diffShifts :: [Diff Int] -> [(Int, Int, Int)]
diffShifts = Int -> Int -> [Diff Int] -> [(Int, Int, Int)]
forall a. Num a => a -> a -> [Diff a] -> [(a, a, a)]
go Int
1 Int
1
  where
    go :: a -> a -> [Diff a] -> [(a, a, a)]
go a
old a
new (Both a
n a
_ : [Diff a]
d) = (a
old, a
old a -> a -> a
forall a. Num a => a -> a -> a
+ a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1, a
new a -> a -> a
forall a. Num a => a -> a -> a
- a
old) (a, a, a) -> [(a, a, a)] -> [(a, a, a)]
forall a. a -> [a] -> [a]
: a -> a -> [Diff a] -> [(a, a, a)]
go (a
old a -> a -> a
forall a. Num a => a -> a -> a
+ a
n)
                                                                   (a
new a -> a -> a
forall a. Num a => a -> a -> a
+ a
n)
                                                                   [Diff a]
d
    go a
old a
new (Second a
n : [Diff a]
d) = a -> a -> [Diff a] -> [(a, a, a)]
go (a
old a -> a -> a
forall a. Num a => a -> a -> a
+ a
n) a
new [Diff a]
d
    go a
old a
new (First a
n  : [Diff a]
d) = a -> a -> [Diff a] -> [(a, a, a)]
go a
old (a
new a -> a -> a
forall a. Num a => a -> a -> a
+ a
n) [Diff a]
d
    go a
_   a
_   []             = []

instance Functor Diff where
  fmap :: (a -> b) -> Diff a -> Diff b
fmap a -> b
f (First a
x)  = b -> Diff b
forall a. a -> Diff a
First (a -> b
f a
x)
  fmap a -> b
f (Second a
x) = b -> Diff b
forall a. a -> Diff a
Second (a -> b
f a
x)
  fmap a -> b
f (Both a
x a
y) = b -> b -> Diff b
forall a. a -> a -> Diff a
Both (a -> b
f a
x) (a -> b
f a
y)

-- | @save@ creates an .saved version of the @target@ file, which will be
--    used to find what has changed the /next time/ @target@ is checked.
--------------------------------------------------------------------------------
saveResult :: FilePath -> Output Doc -> IO ()
--------------------------------------------------------------------------------
saveResult :: String -> Output Doc -> IO ()
saveResult String
target Output Doc
res
  = do String -> String -> IO ()
copyFile String
target String
saveF
       String -> ByteString -> IO ()
B.writeFile String
errF (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Output Doc -> ByteString
forall a. ToJSON a => a -> ByteString
encode Output Doc
res
    where
       saveF :: String
saveF = Ext -> ShowS
extFileName Ext
Saved  String
target
       errF :: String
errF  = Ext -> ShowS
extFileName Ext
Cache  String
target

--------------------------------------------------------------------------------
loadResult   :: FilePath -> IO (Output Doc)
--------------------------------------------------------------------------------
loadResult :: String -> IO (Output Doc)
loadResult String
f = IO Bool -> IO (Output Doc) -> IO (Output Doc) -> IO (Output Doc)
forall (m :: * -> *) b. Monad m => m Bool -> m b -> m b -> m b
ifM (String -> IO Bool
doesFileExist String
jsonF) IO (Output Doc)
out (Output Doc -> IO (Output Doc)
forall (m :: * -> *) a. Monad m => a -> m a
return Output Doc
forall a. Monoid a => a
mempty)
  where
    jsonF :: String
jsonF    = Ext -> ShowS
extFileName Ext
Cache String
f
    out :: IO (Output Doc)
out      = (Output Doc -> Maybe (Output Doc) -> Output Doc
forall a. a -> Maybe a -> a
fromMaybe Output Doc
forall a. Monoid a => a
mempty (Maybe (Output Doc) -> Output Doc)
-> (ByteString -> Maybe (Output Doc)) -> ByteString -> Output Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Output Doc)
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe (Output Doc))
-> (ByteString -> ByteString) -> ByteString -> Maybe (Output Doc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.fromStrict) (ByteString -> Output Doc) -> IO ByteString -> IO (Output Doc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
jsonF

--------------------------------------------------------------------------------
adjustOutput :: LMap -> ChkItv -> Output Doc -> Output Doc
--------------------------------------------------------------------------------
adjustOutput :: LMap -> ChkItv -> Output Doc -> Output Doc
adjustOutput LMap
lm ChkItv
cm Output Doc
o  = Output Doc
forall a. Monoid a => a
mempty { o_types :: AnnInfo Doc
o_types  = LMap -> ChkItv -> AnnInfo Doc -> AnnInfo Doc
forall a. LMap -> ChkItv -> AnnInfo a -> AnnInfo a
adjustTypes  LMap
lm ChkItv
cm (Output Doc -> AnnInfo Doc
forall a. Output a -> AnnInfo a
o_types  Output Doc
o) }
                               { o_result :: ErrorResult
o_result = LMap -> ChkItv -> ErrorResult -> ErrorResult
adjustResult LMap
lm ChkItv
cm (Output Doc -> ErrorResult
forall a. Output a -> ErrorResult
o_result Output Doc
o) }

adjustTypes :: LMap -> ChkItv -> AnnInfo a -> AnnInfo a
adjustTypes :: LMap -> ChkItv -> AnnInfo a -> AnnInfo a
adjustTypes LMap
lm ChkItv
cm (AI HashMap SrcSpan [(Maybe Text, a)]
m)          = HashMap SrcSpan [(Maybe Text, a)] -> AnnInfo a
forall a. HashMap SrcSpan [(Maybe Text, a)] -> AnnInfo a
AI (HashMap SrcSpan [(Maybe Text, a)] -> AnnInfo a)
-> HashMap SrcSpan [(Maybe Text, a)] -> AnnInfo a
forall a b. (a -> b) -> a -> b
$ [(SrcSpan, [(Maybe Text, a)])] -> HashMap SrcSpan [(Maybe Text, a)]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList
                                    [(SrcSpan
sp', [(Maybe Text, a)]
v) | (SrcSpan
sp, [(Maybe Text, a)]
v)  <- HashMap SrcSpan [(Maybe Text, a)] -> [(SrcSpan, [(Maybe Text, a)])]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap SrcSpan [(Maybe Text, a)]
m
                                              , Just SrcSpan
sp' <- [LMap -> ChkItv -> SrcSpan -> Maybe SrcSpan
adjustSrcSpan LMap
lm ChkItv
cm SrcSpan
sp]]

adjustResult :: LMap -> ChkItv -> ErrorResult -> ErrorResult
adjustResult :: LMap -> ChkItv -> ErrorResult -> ErrorResult
adjustResult LMap
lm ChkItv
cm (Unsafe Stats
s [UserError]
es)  = ([UserError] -> ErrorResult) -> [UserError] -> ErrorResult
forall a b. ([a] -> FixResult b) -> [a] -> FixResult b
errorsResult (Stats -> [UserError] -> ErrorResult
forall a. Stats -> [a] -> FixResult a
Unsafe Stats
s)  ([UserError] -> ErrorResult) -> [UserError] -> ErrorResult
forall a b. (a -> b) -> a -> b
$ LMap -> ChkItv -> [UserError] -> [UserError]
forall a. LMap -> ChkItv -> [TError a] -> [TError a]
adjustErrors LMap
lm ChkItv
cm [UserError]
es
adjustResult LMap
lm ChkItv
cm (Crash [UserError]
es String
z)   = ([UserError] -> ErrorResult) -> [UserError] -> ErrorResult
forall a b. ([a] -> FixResult b) -> [a] -> FixResult b
errorsResult ([UserError] -> String -> ErrorResult
forall a. [a] -> String -> FixResult a
`Crash` String
z) ([UserError] -> ErrorResult) -> [UserError] -> ErrorResult
forall a b. (a -> b) -> a -> b
$ LMap -> ChkItv -> [UserError] -> [UserError]
forall a. LMap -> ChkItv -> [TError a] -> [TError a]
adjustErrors LMap
lm ChkItv
cm [UserError]
es
adjustResult LMap
_  ChkItv
_  ErrorResult
r              = ErrorResult
r

errorsResult :: ([a] -> FixResult b) -> [a] -> FixResult b
errorsResult :: ([a] -> FixResult b) -> [a] -> FixResult b
errorsResult [a] -> FixResult b
_ []                 = Stats -> FixResult b
forall a. Stats -> FixResult a
Safe Stats
forall a. Monoid a => a
mempty
errorsResult [a] -> FixResult b
f [a]
es                 = [a] -> FixResult b
f [a]
es

adjustErrors :: LMap -> ChkItv -> [TError a] -> [TError a]
adjustErrors :: LMap -> ChkItv -> [TError a] -> [TError a]
adjustErrors LMap
lm ChkItv
cm                = (TError a -> Maybe (TError a)) -> [TError a] -> [TError a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TError a -> Maybe (TError a)
forall t. TError t -> Maybe (TError t)
adjustError
  where
    adjustError :: TError t -> Maybe (TError t)
adjustError TError t
e                 = case LMap -> ChkItv -> SrcSpan -> Maybe SrcSpan
adjustSrcSpan LMap
lm ChkItv
cm (TError t -> SrcSpan
forall t. TError t -> SrcSpan
pos TError t
e) of
                                      Just SrcSpan
sp' -> TError t -> Maybe (TError t)
forall a. a -> Maybe a
Just (TError t
e {pos :: SrcSpan
pos = SrcSpan
sp'})
                                      Maybe SrcSpan
Nothing  -> Maybe (TError t)
forall a. Maybe a
Nothing

    -- adjustError (ErrSaved sp m)   =  (`ErrSaved` m) <$>
    -- adjustError e                 = Just e

--------------------------------------------------------------------------------
adjustSrcSpan :: LMap -> ChkItv -> SrcSpan -> Maybe SrcSpan
--------------------------------------------------------------------------------
adjustSrcSpan :: LMap -> ChkItv -> SrcSpan -> Maybe SrcSpan
adjustSrcSpan LMap
lm ChkItv
cm SrcSpan
sp
  = do SrcSpan
sp' <- LMap -> SrcSpan -> Maybe SrcSpan
adjustSpan LMap
lm SrcSpan
sp
       if ChkItv -> SrcSpan -> Bool
forall a. IntervalMap Int a -> SrcSpan -> Bool
isCheckedSpan ChkItv
cm SrcSpan
sp'
         then Maybe SrcSpan
forall a. Maybe a
Nothing
         else SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
sp'

isCheckedSpan :: IM.IntervalMap Int a -> SrcSpan -> Bool
isCheckedSpan :: IntervalMap Int a -> SrcSpan -> Bool
isCheckedSpan IntervalMap Int a
cm (RealSrcSpan RealSrcSpan
sp) = IntervalMap Int a -> RealSrcSpan -> Bool
forall a. IntervalMap Int a -> RealSrcSpan -> Bool
isCheckedRealSpan IntervalMap Int a
cm RealSrcSpan
sp
isCheckedSpan IntervalMap Int a
_  SrcSpan
_                = Bool
False

isCheckedRealSpan :: IM.IntervalMap Int a -> RealSrcSpan -> Bool
isCheckedRealSpan :: IntervalMap Int a -> RealSrcSpan -> Bool
isCheckedRealSpan IntervalMap Int a
cm              = Bool -> Bool
not (Bool -> Bool) -> (RealSrcSpan -> Bool) -> RealSrcSpan -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Interval Int, a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Interval Int, a)] -> Bool)
-> (RealSrcSpan -> [(Interval Int, a)]) -> RealSrcSpan -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IntervalMap Int a -> [(Interval Int, a)]
forall v a. Ord v => v -> IntervalMap v a -> [(Interval v, a)]
`IM.search` IntervalMap Int a
cm) (Int -> [(Interval Int, a)])
-> (RealSrcSpan -> Int) -> RealSrcSpan -> [(Interval Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> Int
srcSpanStartLine

adjustSpan :: LMap -> SrcSpan -> Maybe SrcSpan
adjustSpan :: LMap -> SrcSpan -> Maybe SrcSpan
adjustSpan LMap
lm (RealSrcSpan RealSrcSpan
rsp)   = RealSrcSpan -> SrcSpan
RealSrcSpan (RealSrcSpan -> SrcSpan) -> Maybe RealSrcSpan -> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LMap -> RealSrcSpan -> Maybe RealSrcSpan
adjustReal LMap
lm RealSrcSpan
rsp
adjustSpan LMap
_  SrcSpan
sp                  = SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
sp

adjustReal :: LMap -> RealSrcSpan -> Maybe RealSrcSpan
adjustReal :: LMap -> RealSrcSpan -> Maybe RealSrcSpan
adjustReal LMap
lm RealSrcSpan
rsp
  | Just Int
δ <- Int -> LMap -> Maybe Int
getShift Int
l1 LMap
lm      = RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
Just (RealSrcSpan -> Maybe RealSrcSpan)
-> RealSrcSpan -> Maybe RealSrcSpan
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Int -> Int -> RealSrcSpan
realSrcSpan String
f (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
δ) Int
c1 (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
δ) Int
c2
  | Bool
otherwise                     = Maybe RealSrcSpan
forall a. Maybe a
Nothing
  where
    (String
f, Int
l1, Int
c1, Int
l2, Int
c2)           = RealSrcSpan -> (String, Int, Int, Int, Int)
unpackRealSrcSpan RealSrcSpan
rsp


-- | @getShift lm old@ returns @Just δ@ if the line number @old@ shifts by @δ@
-- in the diff and returns @Nothing@ otherwise.
getShift     :: Int -> LMap -> Maybe Int
getShift :: Int -> LMap -> Maybe Int
getShift Int
old = ((Interval Int, Int) -> Int)
-> Maybe (Interval Int, Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Interval Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Interval Int, Int) -> Maybe Int)
-> (LMap -> Maybe (Interval Int, Int)) -> LMap -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Interval Int, Int)] -> Maybe (Interval Int, Int)
forall a. [a] -> Maybe a
listToMaybe ([(Interval Int, Int)] -> Maybe (Interval Int, Int))
-> (LMap -> [(Interval Int, Int)])
-> LMap
-> Maybe (Interval Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LMap -> [(Interval Int, Int)]
forall v a. Ord v => v -> IntervalMap v a -> [(Interval v, a)]
IM.search Int
old

-- | @setShift (lo, hi, δ) lm@ updates the interval map @lm@ appropriately
setShift             :: (Int, Int, Int) -> LMap -> LMap
setShift :: (Int, Int, Int) -> LMap -> LMap
setShift (Int
l1, Int
l2, Int
δ) = Interval Int -> Int -> LMap -> LMap
forall v a.
Ord v =>
Interval v -> a -> IntervalMap v a -> IntervalMap v a
IM.insert (Int -> Int -> Interval Int
forall v. v -> v -> Interval v
IM.Interval Int
l1 Int
l2) Int
δ


checkedItv :: [Def] -> ChkItv
checkedItv :: [Def] -> ChkItv
checkedItv [Def]
chDefs = (Interval Int -> ChkItv -> ChkItv)
-> ChkItv -> [Interval Int] -> ChkItv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Interval Int -> () -> ChkItv -> ChkItv
forall v a.
Ord v =>
Interval v -> a -> IntervalMap v a -> IntervalMap v a
`IM.insert` ()) ChkItv
forall v a. Ord v => IntervalMap v a
IM.empty [Interval Int]
is
  where
    is :: [Interval Int]
is            = [Int -> Int -> Interval Int
forall v. v -> v -> Interval v
IM.Interval Int
l1 Int
l2 | D Int
l1 Int
l2 Var
_ <- [Def]
chDefs]


--------------------------------------------------------------------------------
-- | Aeson instances -----------------------------------------------------------
--------------------------------------------------------------------------------

instance ToJSON SourcePos where
  toJSON :: SourcePos -> Value
toJSON SourcePos
p = [Pair] -> Value
object [   Text
"sourceName"   Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
f
                      , Text
"sourceLine"   Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
l
                      , Text
"sourceColumn" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
c
                      ]
             where
               f :: String
f    = SourcePos -> String
sourceName   SourcePos
p
               l :: Int
l    = SourcePos -> Int
sourceLine   SourcePos
p
               c :: Int
c    = SourcePos -> Int
sourceColumn SourcePos
p

instance FromJSON SourcePos where
  parseJSON :: Value -> Parser SourcePos
parseJSON (Object Object
v) = String -> Int -> Int -> SourcePos
newPos (String -> Int -> Int -> SourcePos)
-> Parser String -> Parser (Int -> Int -> SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sourceName"
                                Parser (Int -> Int -> SourcePos)
-> Parser Int -> Parser (Int -> SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sourceLine"
                                Parser (Int -> SourcePos) -> Parser Int -> Parser SourcePos
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sourceColumn"
  parseJSON Value
_          = Parser SourcePos
forall a. Monoid a => a
mempty

instance ToJSON Solver.Stats where
  toJSON :: Stats -> Value
toJSON = Options -> Stats -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions
  toEncoding :: Stats -> Encoding
toEncoding = Options -> Stats -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance FromJSON Solver.Stats

instance ToJSON ErrorResult where
  toJSON :: ErrorResult -> Value
toJSON = Options -> ErrorResult -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions
  toEncoding :: ErrorResult -> Encoding
toEncoding = Options -> ErrorResult -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance FromJSON ErrorResult

instance ToJSON Doc where
  toJSON :: Doc -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Doc -> Text) -> Doc -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Doc -> String) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render

instance FromJSON Doc where
  parseJSON :: Value -> Parser Doc
parseJSON (String Text
s) = Doc -> Parser Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> Parser Doc) -> Doc -> Parser Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
  parseJSON Value
_          = Parser Doc
forall a. Monoid a => a
mempty

instance ToJSON a => ToJSON (AnnInfo a) where
  toJSON :: AnnInfo a -> Value
toJSON = Options -> AnnInfo a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions
  toEncoding :: AnnInfo a -> Encoding
toEncoding = Options -> AnnInfo a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance FromJSON a => FromJSON (AnnInfo a)

instance ToJSON (Output Doc) where
  toJSON :: Output Doc -> Value
toJSON = Options -> Output Doc -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions
  toEncoding :: Output Doc -> Encoding
toEncoding = Options -> Output Doc -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance FromJSON (Output Doc)


file :: Located a -> FilePath
file :: Located a -> String
file = SourcePos -> String
sourceName (SourcePos -> String)
-> (Located a -> SourcePos) -> Located a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> SourcePos
forall a. Located a -> SourcePos
loc

line :: Located a -> Int
line :: Located a -> Int
line  = SourcePos -> Int
sourceLine (SourcePos -> Int) -> (Located a -> SourcePos) -> Located a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> SourcePos
forall a. Located a -> SourcePos
loc

lineE :: Located a -> Int
lineE :: Located a -> Int
lineE = SourcePos -> Int
sourceLine (SourcePos -> Int) -> (Located a -> SourcePos) -> Located a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> SourcePos
forall a. Located a -> SourcePos
locE