{-# LANGUAGE CPP #-}
module Agda.Interaction.Highlighting.Precise
(
Aspect(..)
, NameKind(..)
, OtherAspect(..)
, Aspects(..)
, DefinitionSite(..)
, TokenBased(..)
, File(..)
, HighlightingInfo
, parserBased
, singleton
, several
, merge
, smallestPos
, toMap
, CompressedFile(..)
, compressedFileInvariant
, compress
, decompress
, noHighlightingInRange
, singletonC
, severalC
, splitAtC
, selectC
, smallestPosC
, mergeC
) where
import Control.Arrow (second)
import Control.Monad
import Data.Function
import qualified Data.List as List
import Data.Maybe
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Agda.Syntax.Position as P
import qualified Agda.Syntax.Common as Common
import qualified Agda.Syntax.Concrete as SC
import Agda.Interaction.Highlighting.Range
import Agda.Utils.String
import Agda.Utils.List
data Aspect
=
| Keyword
| String
| Number
| Symbol
| PrimitiveType
| Name (Maybe NameKind) Bool
| Pragma
| Background
| Markup
deriving (Aspect -> Aspect -> Bool
(Aspect -> Aspect -> Bool)
-> (Aspect -> Aspect -> Bool) -> Eq Aspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aspect -> Aspect -> Bool
$c/= :: Aspect -> Aspect -> Bool
== :: Aspect -> Aspect -> Bool
$c== :: Aspect -> Aspect -> Bool
Eq, Int -> Aspect -> ShowS
[Aspect] -> ShowS
Aspect -> String
(Int -> Aspect -> ShowS)
-> (Aspect -> String) -> ([Aspect] -> ShowS) -> Show Aspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Aspect] -> ShowS
$cshowList :: [Aspect] -> ShowS
show :: Aspect -> String
$cshow :: Aspect -> String
showsPrec :: Int -> Aspect -> ShowS
$cshowsPrec :: Int -> Aspect -> ShowS
Show)
data NameKind
= Bound
| Generalizable
| Constructor Common.Induction
| Datatype
| Field
| Function
| Module
| Postulate
| Primitive
| Record
| Argument
| Macro
deriving (NameKind -> NameKind -> Bool
(NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool) -> Eq NameKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameKind -> NameKind -> Bool
$c/= :: NameKind -> NameKind -> Bool
== :: NameKind -> NameKind -> Bool
$c== :: NameKind -> NameKind -> Bool
Eq, Int -> NameKind -> ShowS
[NameKind] -> ShowS
NameKind -> String
(Int -> NameKind -> ShowS)
-> (NameKind -> String) -> ([NameKind] -> ShowS) -> Show NameKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameKind] -> ShowS
$cshowList :: [NameKind] -> ShowS
show :: NameKind -> String
$cshow :: NameKind -> String
showsPrec :: Int -> NameKind -> ShowS
$cshowsPrec :: Int -> NameKind -> ShowS
Show)
data OtherAspect
= Error
| DottedPattern
| UnsolvedMeta
| UnsolvedConstraint
| TerminationProblem
| PositivityProblem
| Deadcode
| ShadowingInTelescope
| CoverageProblem
| IncompletePattern
| TypeChecks
| MissingDefinition
| CatchallClause
| ConfluenceProblem
deriving (OtherAspect -> OtherAspect -> Bool
(OtherAspect -> OtherAspect -> Bool)
-> (OtherAspect -> OtherAspect -> Bool) -> Eq OtherAspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherAspect -> OtherAspect -> Bool
$c/= :: OtherAspect -> OtherAspect -> Bool
== :: OtherAspect -> OtherAspect -> Bool
$c== :: OtherAspect -> OtherAspect -> Bool
Eq, Eq OtherAspect
Eq OtherAspect
-> (OtherAspect -> OtherAspect -> Ordering)
-> (OtherAspect -> OtherAspect -> Bool)
-> (OtherAspect -> OtherAspect -> Bool)
-> (OtherAspect -> OtherAspect -> Bool)
-> (OtherAspect -> OtherAspect -> Bool)
-> (OtherAspect -> OtherAspect -> OtherAspect)
-> (OtherAspect -> OtherAspect -> OtherAspect)
-> Ord OtherAspect
OtherAspect -> OtherAspect -> Bool
OtherAspect -> OtherAspect -> Ordering
OtherAspect -> OtherAspect -> OtherAspect
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 :: OtherAspect -> OtherAspect -> OtherAspect
$cmin :: OtherAspect -> OtherAspect -> OtherAspect
max :: OtherAspect -> OtherAspect -> OtherAspect
$cmax :: OtherAspect -> OtherAspect -> OtherAspect
>= :: OtherAspect -> OtherAspect -> Bool
$c>= :: OtherAspect -> OtherAspect -> Bool
> :: OtherAspect -> OtherAspect -> Bool
$c> :: OtherAspect -> OtherAspect -> Bool
<= :: OtherAspect -> OtherAspect -> Bool
$c<= :: OtherAspect -> OtherAspect -> Bool
< :: OtherAspect -> OtherAspect -> Bool
$c< :: OtherAspect -> OtherAspect -> Bool
compare :: OtherAspect -> OtherAspect -> Ordering
$ccompare :: OtherAspect -> OtherAspect -> Ordering
$cp1Ord :: Eq OtherAspect
Ord, Int -> OtherAspect -> ShowS
[OtherAspect] -> ShowS
OtherAspect -> String
(Int -> OtherAspect -> ShowS)
-> (OtherAspect -> String)
-> ([OtherAspect] -> ShowS)
-> Show OtherAspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherAspect] -> ShowS
$cshowList :: [OtherAspect] -> ShowS
show :: OtherAspect -> String
$cshow :: OtherAspect -> String
showsPrec :: Int -> OtherAspect -> ShowS
$cshowsPrec :: Int -> OtherAspect -> ShowS
Show, Int -> OtherAspect
OtherAspect -> Int
OtherAspect -> [OtherAspect]
OtherAspect -> OtherAspect
OtherAspect -> OtherAspect -> [OtherAspect]
OtherAspect -> OtherAspect -> OtherAspect -> [OtherAspect]
(OtherAspect -> OtherAspect)
-> (OtherAspect -> OtherAspect)
-> (Int -> OtherAspect)
-> (OtherAspect -> Int)
-> (OtherAspect -> [OtherAspect])
-> (OtherAspect -> OtherAspect -> [OtherAspect])
-> (OtherAspect -> OtherAspect -> [OtherAspect])
-> (OtherAspect -> OtherAspect -> OtherAspect -> [OtherAspect])
-> Enum OtherAspect
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OtherAspect -> OtherAspect -> OtherAspect -> [OtherAspect]
$cenumFromThenTo :: OtherAspect -> OtherAspect -> OtherAspect -> [OtherAspect]
enumFromTo :: OtherAspect -> OtherAspect -> [OtherAspect]
$cenumFromTo :: OtherAspect -> OtherAspect -> [OtherAspect]
enumFromThen :: OtherAspect -> OtherAspect -> [OtherAspect]
$cenumFromThen :: OtherAspect -> OtherAspect -> [OtherAspect]
enumFrom :: OtherAspect -> [OtherAspect]
$cenumFrom :: OtherAspect -> [OtherAspect]
fromEnum :: OtherAspect -> Int
$cfromEnum :: OtherAspect -> Int
toEnum :: Int -> OtherAspect
$ctoEnum :: Int -> OtherAspect
pred :: OtherAspect -> OtherAspect
$cpred :: OtherAspect -> OtherAspect
succ :: OtherAspect -> OtherAspect
$csucc :: OtherAspect -> OtherAspect
Enum, OtherAspect
OtherAspect -> OtherAspect -> Bounded OtherAspect
forall a. a -> a -> Bounded a
maxBound :: OtherAspect
$cmaxBound :: OtherAspect
minBound :: OtherAspect
$cminBound :: OtherAspect
Bounded)
data Aspects = Aspects
{ Aspects -> Maybe Aspect
aspect :: Maybe Aspect
, Aspects -> Set OtherAspect
otherAspects :: Set OtherAspect
, Aspects -> Maybe String
note :: Maybe String
, Aspects -> Maybe DefinitionSite
definitionSite :: Maybe DefinitionSite
, Aspects -> TokenBased
tokenBased :: !TokenBased
}
deriving Int -> Aspects -> ShowS
[Aspects] -> ShowS
Aspects -> String
(Int -> Aspects -> ShowS)
-> (Aspects -> String) -> ([Aspects] -> ShowS) -> Show Aspects
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Aspects] -> ShowS
$cshowList :: [Aspects] -> ShowS
show :: Aspects -> String
$cshow :: Aspects -> String
showsPrec :: Int -> Aspects -> ShowS
$cshowsPrec :: Int -> Aspects -> ShowS
Show
data DefinitionSite = DefinitionSite
{ DefinitionSite -> TopLevelModuleName
defSiteModule :: SC.TopLevelModuleName
, DefinitionSite -> Int
defSitePos :: Int
, DefinitionSite -> Bool
defSiteHere :: Bool
, DefinitionSite -> Maybe String
defSiteAnchor :: Maybe String
}
deriving Int -> DefinitionSite -> ShowS
[DefinitionSite] -> ShowS
DefinitionSite -> String
(Int -> DefinitionSite -> ShowS)
-> (DefinitionSite -> String)
-> ([DefinitionSite] -> ShowS)
-> Show DefinitionSite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefinitionSite] -> ShowS
$cshowList :: [DefinitionSite] -> ShowS
show :: DefinitionSite -> String
$cshow :: DefinitionSite -> String
showsPrec :: Int -> DefinitionSite -> ShowS
$cshowsPrec :: Int -> DefinitionSite -> ShowS
Show
instance Eq DefinitionSite where
DefinitionSite TopLevelModuleName
m Int
p Bool
_ Maybe String
_ == :: DefinitionSite -> DefinitionSite -> Bool
== DefinitionSite TopLevelModuleName
m' Int
p' Bool
_ Maybe String
_ = TopLevelModuleName
m TopLevelModuleName -> TopLevelModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== TopLevelModuleName
m' Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p'
data TokenBased = TokenBased | NotOnlyTokenBased
deriving (TokenBased -> TokenBased -> Bool
(TokenBased -> TokenBased -> Bool)
-> (TokenBased -> TokenBased -> Bool) -> Eq TokenBased
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenBased -> TokenBased -> Bool
$c/= :: TokenBased -> TokenBased -> Bool
== :: TokenBased -> TokenBased -> Bool
$c== :: TokenBased -> TokenBased -> Bool
Eq, Int -> TokenBased -> ShowS
[TokenBased] -> ShowS
TokenBased -> String
(Int -> TokenBased -> ShowS)
-> (TokenBased -> String)
-> ([TokenBased] -> ShowS)
-> Show TokenBased
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenBased] -> ShowS
$cshowList :: [TokenBased] -> ShowS
show :: TokenBased -> String
$cshow :: TokenBased -> String
showsPrec :: Int -> TokenBased -> ShowS
$cshowsPrec :: Int -> TokenBased -> ShowS
Show)
instance Eq Aspects where
Aspects Maybe Aspect
a Set OtherAspect
o Maybe String
_ Maybe DefinitionSite
d TokenBased
t == :: Aspects -> Aspects -> Bool
== Aspects Maybe Aspect
a' Set OtherAspect
o' Maybe String
_ Maybe DefinitionSite
d' TokenBased
t' =
(Maybe Aspect
a, Set OtherAspect
o, Maybe DefinitionSite
d, TokenBased
t) (Maybe Aspect, Set OtherAspect, Maybe DefinitionSite, TokenBased)
-> (Maybe Aspect, Set OtherAspect, Maybe DefinitionSite,
TokenBased)
-> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Aspect
a', Set OtherAspect
o', Maybe DefinitionSite
d', TokenBased
t')
newtype File = File { File -> IntMap Aspects
mapping :: IntMap Aspects }
deriving (File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq, Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show)
type HighlightingInfo = CompressedFile
parserBased :: Aspects
parserBased :: Aspects
parserBased = Aspects
forall a. Monoid a => a
mempty { tokenBased :: TokenBased
tokenBased = TokenBased
NotOnlyTokenBased }
singleton :: Ranges -> Aspects -> File
singleton :: Ranges -> Aspects -> File
singleton Ranges
rs Aspects
m = File :: IntMap Aspects -> File
File {
mapping :: IntMap Aspects
mapping = [(Int, Aspects)] -> IntMap Aspects
forall a. [(Int, a)] -> IntMap a
IntMap.fromAscList [ (Int
p, Aspects
m) | Int
p <- Ranges -> [Int]
rangesToPositions Ranges
rs ] }
several :: [Ranges] -> Aspects -> File
several :: [Ranges] -> Aspects -> File
several [Ranges]
rs Aspects
m = [File] -> File
forall a. Monoid a => [a] -> a
mconcat ([File] -> File) -> [File] -> File
forall a b. (a -> b) -> a -> b
$ (Ranges -> File) -> [Ranges] -> [File]
forall a b. (a -> b) -> [a] -> [b]
map (\Ranges
r -> Ranges -> Aspects -> File
singleton Ranges
r Aspects
m) [Ranges]
rs
instance Semigroup TokenBased where
b1 :: TokenBased
b1@TokenBased
NotOnlyTokenBased <> :: TokenBased -> TokenBased -> TokenBased
<> TokenBased
b2 = TokenBased
b1
TokenBased
TokenBased <> TokenBased
b2 = TokenBased
b2
instance Monoid TokenBased where
mempty :: TokenBased
mempty = TokenBased
TokenBased
mappend :: TokenBased -> TokenBased -> TokenBased
mappend = TokenBased -> TokenBased -> TokenBased
forall a. Semigroup a => a -> a -> a
(<>)
mergeAspects :: Aspects -> Aspects -> Aspects
mergeAspects :: Aspects -> Aspects -> Aspects
mergeAspects Aspects
m1 Aspects
m2 = Aspects :: Maybe Aspect
-> Set OtherAspect
-> Maybe String
-> Maybe DefinitionSite
-> TokenBased
-> Aspects
Aspects
{ aspect :: Maybe Aspect
aspect = (Maybe Aspect -> Maybe Aspect -> Maybe Aspect
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (Maybe Aspect -> Maybe Aspect -> Maybe Aspect)
-> (Aspects -> Maybe Aspect) -> Aspects -> Aspects -> Maybe Aspect
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Aspects -> Maybe Aspect
aspect) Aspects
m1 Aspects
m2
, otherAspects :: Set OtherAspect
otherAspects = (Set OtherAspect -> Set OtherAspect -> Set OtherAspect
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Set OtherAspect -> Set OtherAspect -> Set OtherAspect)
-> (Aspects -> Set OtherAspect)
-> Aspects
-> Aspects
-> Set OtherAspect
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Aspects -> Set OtherAspect
otherAspects) Aspects
m1 Aspects
m2
, note :: Maybe String
note = case (Aspects -> Maybe String
note Aspects
m1, Aspects -> Maybe String
note Aspects
m2) of
(Just String
n1, Just String
n2) -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
if String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2
then String
n1
else ShowS
addFinalNewLine String
n1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"----\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n2
(Just String
n1, Maybe String
Nothing) -> String -> Maybe String
forall a. a -> Maybe a
Just String
n1
(Maybe String
Nothing, Just String
n2) -> String -> Maybe String
forall a. a -> Maybe a
Just String
n2
(Maybe String
Nothing, Maybe String
Nothing) -> Maybe String
forall a. Maybe a
Nothing
, definitionSite :: Maybe DefinitionSite
definitionSite = (Maybe DefinitionSite
-> Maybe DefinitionSite -> Maybe DefinitionSite
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (Maybe DefinitionSite
-> Maybe DefinitionSite -> Maybe DefinitionSite)
-> (Aspects -> Maybe DefinitionSite)
-> Aspects
-> Aspects
-> Maybe DefinitionSite
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Aspects -> Maybe DefinitionSite
definitionSite) Aspects
m1 Aspects
m2
, tokenBased :: TokenBased
tokenBased = Aspects -> TokenBased
tokenBased Aspects
m1 TokenBased -> TokenBased -> TokenBased
forall a. Semigroup a => a -> a -> a
<> Aspects -> TokenBased
tokenBased Aspects
m2
}
instance Semigroup Aspects where
<> :: Aspects -> Aspects -> Aspects
(<>) = Aspects -> Aspects -> Aspects
mergeAspects
instance Monoid Aspects where
mempty :: Aspects
mempty = Aspects :: Maybe Aspect
-> Set OtherAspect
-> Maybe String
-> Maybe DefinitionSite
-> TokenBased
-> Aspects
Aspects
{ aspect :: Maybe Aspect
aspect = Maybe Aspect
forall a. Maybe a
Nothing
, otherAspects :: Set OtherAspect
otherAspects = Set OtherAspect
forall a. Set a
Set.empty
, note :: Maybe String
note = Maybe String
forall a. Maybe a
Nothing
, definitionSite :: Maybe DefinitionSite
definitionSite = Maybe DefinitionSite
forall a. Maybe a
Nothing
, tokenBased :: TokenBased
tokenBased = TokenBased
forall a. Monoid a => a
mempty
}
mappend :: Aspects -> Aspects -> Aspects
mappend = Aspects -> Aspects -> Aspects
forall a. Semigroup a => a -> a -> a
(<>)
merge :: File -> File -> File
merge :: File -> File -> File
merge File
f1 File
f2 =
File :: IntMap Aspects -> File
File { mapping :: IntMap Aspects
mapping = ((Aspects -> Aspects -> Aspects)
-> IntMap Aspects -> IntMap Aspects -> IntMap Aspects
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith Aspects -> Aspects -> Aspects
forall a. Monoid a => a -> a -> a
mappend (IntMap Aspects -> IntMap Aspects -> IntMap Aspects)
-> (File -> IntMap Aspects) -> File -> File -> IntMap Aspects
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` File -> IntMap Aspects
mapping) File
f1 File
f2 }
instance Semigroup File where
<> :: File -> File -> File
(<>) = File -> File -> File
merge
instance Monoid File where
mempty :: File
mempty = File :: IntMap Aspects -> File
File { mapping :: IntMap Aspects
mapping = IntMap Aspects
forall a. IntMap a
IntMap.empty }
mappend :: File -> File -> File
mappend = File -> File -> File
forall a. Semigroup a => a -> a -> a
(<>)
smallestPos :: File -> Maybe Int
smallestPos :: File -> Maybe Int
smallestPos = (((Int, Aspects), IntMap Aspects) -> Int)
-> Maybe ((Int, Aspects), IntMap Aspects) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Aspects) -> Int
forall a b. (a, b) -> a
fst ((Int, Aspects) -> Int)
-> (((Int, Aspects), IntMap Aspects) -> (Int, Aspects))
-> ((Int, Aspects), IntMap Aspects)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Aspects), IntMap Aspects) -> (Int, Aspects)
forall a b. (a, b) -> a
fst) (Maybe ((Int, Aspects), IntMap Aspects) -> Maybe Int)
-> (File -> Maybe ((Int, Aspects), IntMap Aspects))
-> File
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Aspects -> Maybe ((Int, Aspects), IntMap Aspects)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IntMap.minViewWithKey (IntMap Aspects -> Maybe ((Int, Aspects), IntMap Aspects))
-> (File -> IntMap Aspects)
-> File
-> Maybe ((Int, Aspects), IntMap Aspects)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File -> IntMap Aspects
mapping
toMap :: File -> IntMap Aspects
toMap :: File -> IntMap Aspects
toMap = File -> IntMap Aspects
mapping
newtype CompressedFile =
CompressedFile { CompressedFile -> [(Range, Aspects)]
ranges :: [(Range, Aspects)] }
deriving (CompressedFile -> CompressedFile -> Bool
(CompressedFile -> CompressedFile -> Bool)
-> (CompressedFile -> CompressedFile -> Bool) -> Eq CompressedFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressedFile -> CompressedFile -> Bool
$c/= :: CompressedFile -> CompressedFile -> Bool
== :: CompressedFile -> CompressedFile -> Bool
$c== :: CompressedFile -> CompressedFile -> Bool
Eq, Int -> CompressedFile -> ShowS
[CompressedFile] -> ShowS
CompressedFile -> String
(Int -> CompressedFile -> ShowS)
-> (CompressedFile -> String)
-> ([CompressedFile] -> ShowS)
-> Show CompressedFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressedFile] -> ShowS
$cshowList :: [CompressedFile] -> ShowS
show :: CompressedFile -> String
$cshow :: CompressedFile -> String
showsPrec :: Int -> CompressedFile -> ShowS
$cshowsPrec :: Int -> CompressedFile -> ShowS
Show)
compressedFileInvariant :: CompressedFile -> Bool
compressedFileInvariant :: CompressedFile -> Bool
compressedFileInvariant (CompressedFile []) = Bool
True
compressedFileInvariant (CompressedFile [(Range, Aspects)]
f) =
(Range -> Bool) -> [Range] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Range -> Bool
rangeInvariant [Range]
rs Bool -> Bool -> Bool
&&
(Range -> Bool) -> [Range] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Range -> Bool) -> Range -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Bool
empty) [Range]
rs Bool -> Bool -> Bool
&&
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=) ((Range -> Int) -> [Range] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Int
to ([Range] -> [Int]) -> [Range] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Range] -> [Range]
forall a. [a] -> [a]
init [Range]
rs) ((Range -> Int) -> [Range] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Int
from ([Range] -> [Int]) -> [Range] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Range] -> [Range]
forall a. [a] -> [a]
tail [Range]
rs))
where rs :: [Range]
rs = ((Range, Aspects) -> Range) -> [(Range, Aspects)] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map (Range, Aspects) -> Range
forall a b. (a, b) -> a
fst [(Range, Aspects)]
f
compress :: File -> CompressedFile
compress :: File -> CompressedFile
compress File
f =
[(Range, Aspects)] -> CompressedFile
CompressedFile ([(Range, Aspects)] -> CompressedFile)
-> [(Range, Aspects)] -> CompressedFile
forall a b. (a -> b) -> a -> b
$ ([(Int, Aspects)] -> (Range, Aspects))
-> [[(Int, Aspects)]] -> [(Range, Aspects)]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, Aspects)] -> (Range, Aspects)
forall b. [(Int, b)] -> (Range, b)
join ([[(Int, Aspects)]] -> [(Range, Aspects)])
-> [[(Int, Aspects)]] -> [(Range, Aspects)]
forall a b. (a -> b) -> a -> b
$ ((Int, Aspects) -> (Int, Aspects) -> Bool)
-> [(Int, Aspects)] -> [[(Int, Aspects)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy' (Int, Aspects) -> (Int, Aspects) -> Bool
forall a a. (Num a, Eq a, Eq a) => (a, a) -> (a, a) -> Bool
p (IntMap Aspects -> [(Int, Aspects)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList (IntMap Aspects -> [(Int, Aspects)])
-> IntMap Aspects -> [(Int, Aspects)]
forall a b. (a -> b) -> a -> b
$ File -> IntMap Aspects
mapping File
f)
where
p :: (a, a) -> (a, a) -> Bool
p (a
pos1, a
m1) (a
pos2, a
m2) = a
pos2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
pos1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 Bool -> Bool -> Bool
&& a
m1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
m2
join :: [(Int, b)] -> (Range, b)
join [(Int, b)]
pms = ( Range :: Int -> Int -> Range
Range { from :: Int
from = [Int] -> Int
forall a. [a] -> a
head [Int]
ps, to :: Int
to = [Int] -> Int
forall a. [a] -> a
last [Int]
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
, [b] -> b
forall a. [a] -> a
head [b]
ms
)
where ([Int]
ps, [b]
ms) = [(Int, b)] -> ([Int], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Int, b)]
pms
decompress :: CompressedFile -> File
decompress :: CompressedFile -> File
decompress =
IntMap Aspects -> File
File (IntMap Aspects -> File)
-> (CompressedFile -> IntMap Aspects) -> CompressedFile -> File
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(Int, Aspects)] -> IntMap Aspects
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Aspects)] -> IntMap Aspects)
-> (CompressedFile -> [(Int, Aspects)])
-> CompressedFile
-> IntMap Aspects
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[[(Int, Aspects)]] -> [(Int, Aspects)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Int, Aspects)]] -> [(Int, Aspects)])
-> (CompressedFile -> [[(Int, Aspects)]])
-> CompressedFile
-> [(Int, Aspects)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((Range, Aspects) -> [(Int, Aspects)])
-> [(Range, Aspects)] -> [[(Int, Aspects)]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Range
r, Aspects
m) -> [ (Int
p, Aspects
m) | Int
p <- Range -> [Int]
rangeToPositions Range
r ]) ([(Range, Aspects)] -> [[(Int, Aspects)]])
-> (CompressedFile -> [(Range, Aspects)])
-> CompressedFile
-> [[(Int, Aspects)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CompressedFile -> [(Range, Aspects)]
ranges
noHighlightingInRange :: Ranges -> CompressedFile -> CompressedFile
noHighlightingInRange :: Ranges -> CompressedFile -> CompressedFile
noHighlightingInRange Ranges
rs (CompressedFile [(Range, Aspects)]
hs) =
[(Range, Aspects)] -> CompressedFile
CompressedFile ([(Range, Aspects)] -> CompressedFile)
-> [(Range, Aspects)] -> CompressedFile
forall a b. (a -> b) -> a -> b
$ ((Range, Aspects) -> [(Range, Aspects)])
-> [(Range, Aspects)] -> [(Range, Aspects)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Range, Aspects) -> [(Range, Aspects)]
forall b. (Range, b) -> [(Range, b)]
clear [(Range, Aspects)]
hs
where
clear :: (Range, b) -> [(Range, b)]
clear (Range
r, b
i) =
case Ranges -> Ranges -> Ranges
minus ([Range] -> Ranges
Ranges [Range
r]) Ranges
rs of
Ranges [] -> []
Ranges [Range]
rs -> [ (Range
r, b
i) | Range
r <- [Range]
rs ]
singletonC :: Ranges -> Aspects -> CompressedFile
singletonC :: Ranges -> Aspects -> CompressedFile
singletonC (Ranges [Range]
rs) Aspects
m =
[(Range, Aspects)] -> CompressedFile
CompressedFile [(Range
r, Aspects
m) | Range
r <- [Range]
rs, Bool -> Bool
not (Range -> Bool
empty Range
r)]
severalC :: [Ranges] -> Aspects -> CompressedFile
severalC :: [Ranges] -> Aspects -> CompressedFile
severalC [Ranges]
rss Aspects
m = [CompressedFile] -> CompressedFile
forall a. Monoid a => [a] -> a
mconcat ([CompressedFile] -> CompressedFile)
-> [CompressedFile] -> CompressedFile
forall a b. (a -> b) -> a -> b
$ (Ranges -> CompressedFile) -> [Ranges] -> [CompressedFile]
forall a b. (a -> b) -> [a] -> [b]
map (\Ranges
rs -> Ranges -> Aspects -> CompressedFile
singletonC Ranges
rs Aspects
m) [Ranges]
rss
mergeC :: CompressedFile -> CompressedFile -> CompressedFile
mergeC :: CompressedFile -> CompressedFile -> CompressedFile
mergeC (CompressedFile [(Range, Aspects)]
f1) (CompressedFile [(Range, Aspects)]
f2) =
[(Range, Aspects)] -> CompressedFile
CompressedFile ([(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
mrg [(Range, Aspects)]
f1 [(Range, Aspects)]
f2)
where
mrg :: [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
mrg [] [(Range, Aspects)]
f2 = [(Range, Aspects)]
f2
mrg [(Range, Aspects)]
f1 [] = [(Range, Aspects)]
f1
mrg (p1 :: (Range, Aspects)
p1@(Range
i1,Aspects
_):[(Range, Aspects)]
f1) (p2 :: (Range, Aspects)
p2@(Range
i2,Aspects
_):[(Range, Aspects)]
f2)
| Range -> Int
to Range
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Range -> Int
from Range
i2 = (Range, Aspects)
p1 (Range, Aspects) -> [(Range, Aspects)] -> [(Range, Aspects)]
forall a. a -> [a] -> [a]
: [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
mrg [(Range, Aspects)]
f1 ((Range, Aspects)
p2(Range, Aspects) -> [(Range, Aspects)] -> [(Range, Aspects)]
forall a. a -> [a] -> [a]
:[(Range, Aspects)]
f2)
| Range -> Int
to Range
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Range -> Int
from Range
i1 = (Range, Aspects)
p2 (Range, Aspects) -> [(Range, Aspects)] -> [(Range, Aspects)]
forall a. a -> [a] -> [a]
: [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
mrg ((Range, Aspects)
p1(Range, Aspects) -> [(Range, Aspects)] -> [(Range, Aspects)]
forall a. a -> [a] -> [a]
:[(Range, Aspects)]
f1) [(Range, Aspects)]
f2
| Range -> Int
to Range
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Range -> Int
to Range
i2 = [(Range, Aspects)]
ps1 [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
forall a. [a] -> [a] -> [a]
++ [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
mrg [(Range, Aspects)]
f1 ([(Range, Aspects)]
ps2 [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
forall a. [a] -> [a] -> [a]
++ [(Range, Aspects)]
f2)
| Bool
otherwise = [(Range, Aspects)]
ps1 [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
forall a. [a] -> [a] -> [a]
++ [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
mrg ([(Range, Aspects)]
ps2 [(Range, Aspects)] -> [(Range, Aspects)] -> [(Range, Aspects)]
forall a. [a] -> [a] -> [a]
++ [(Range, Aspects)]
f1) [(Range, Aspects)]
f2
where ([(Range, Aspects)]
ps1, [(Range, Aspects)]
ps2) = (Range, Aspects)
-> (Range, Aspects) -> ([(Range, Aspects)], [(Range, Aspects)])
fuse (Range, Aspects)
p1 (Range, Aspects)
p2
fuse :: (Range, Aspects)
-> (Range, Aspects) -> ([(Range, Aspects)], [(Range, Aspects)])
fuse (Range
i1, Aspects
m1) (Range
i2, Aspects
m2) =
( [(Range, Aspects)] -> [(Range, Aspects)]
forall b. [(Range, b)] -> [(Range, b)]
fix [ (Range :: Int -> Int -> Range
Range { from :: Int
from = Int
a, to :: Int
to = Int
b }, Aspects
ma)
, (Range :: Int -> Int -> Range
Range { from :: Int
from = Int
b, to :: Int
to = Int
c }, Aspects -> Aspects -> Aspects
mergeAspects Aspects
m1 Aspects
m2)
]
, [(Range, Aspects)] -> [(Range, Aspects)]
forall b. [(Range, b)] -> [(Range, b)]
fix [ (Range :: Int -> Int -> Range
Range { from :: Int
from = Int
c, to :: Int
to = Int
d }, Aspects
md)
]
)
where
[(Int
a, Aspects
ma), (Int
b, Aspects
_), (Int
c, Aspects
_), (Int
d, Aspects
md)] =
((Int, Aspects) -> (Int, Aspects) -> Ordering)
-> [(Int, Aspects)] -> [(Int, Aspects)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, Aspects) -> Int)
-> (Int, Aspects)
-> (Int, Aspects)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Aspects) -> Int
forall a b. (a, b) -> a
fst)
[(Range -> Int
from Range
i1, Aspects
m1), (Range -> Int
to Range
i1, Aspects
m1), (Range -> Int
from Range
i2, Aspects
m2), (Range -> Int
to Range
i2, Aspects
m2)]
fix :: [(Range, b)] -> [(Range, b)]
fix = ((Range, b) -> Bool) -> [(Range, b)] -> [(Range, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Range, b) -> Bool) -> (Range, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Bool
empty (Range -> Bool) -> ((Range, b) -> Range) -> (Range, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range, b) -> Range
forall a b. (a, b) -> a
fst)
instance Semigroup CompressedFile where
<> :: CompressedFile -> CompressedFile -> CompressedFile
(<>) = CompressedFile -> CompressedFile -> CompressedFile
mergeC
instance Monoid CompressedFile where
mempty :: CompressedFile
mempty = [(Range, Aspects)] -> CompressedFile
CompressedFile []
mappend :: CompressedFile -> CompressedFile -> CompressedFile
mappend = CompressedFile -> CompressedFile -> CompressedFile
forall a. Semigroup a => a -> a -> a
(<>)
splitAtC :: Int -> CompressedFile ->
(CompressedFile, CompressedFile)
splitAtC :: Int -> CompressedFile -> (CompressedFile, CompressedFile)
splitAtC Int
p CompressedFile
f = ([(Range, Aspects)] -> CompressedFile
CompressedFile [(Range, Aspects)]
f1, [(Range, Aspects)] -> CompressedFile
CompressedFile [(Range, Aspects)]
f2)
where
([(Range, Aspects)]
f1, [(Range, Aspects)]
f2) = [(Range, Aspects)] -> ([(Range, Aspects)], [(Range, Aspects)])
forall b. [(Range, b)] -> ([(Range, b)], [(Range, b)])
split ([(Range, Aspects)] -> ([(Range, Aspects)], [(Range, Aspects)]))
-> [(Range, Aspects)] -> ([(Range, Aspects)], [(Range, Aspects)])
forall a b. (a -> b) -> a -> b
$ CompressedFile -> [(Range, Aspects)]
ranges CompressedFile
f
split :: [(Range, b)] -> ([(Range, b)], [(Range, b)])
split [] = ([], [])
split (rx :: (Range, b)
rx@(Range
r,b
x) : [(Range, b)]
f)
| Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Range -> Int
from Range
r = ([], (Range, b)
rx(Range, b) -> [(Range, b)] -> [(Range, b)]
forall a. a -> [a] -> [a]
:[(Range, b)]
f)
| Range -> Int
to Range
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
p = ((Range, b)
rx(Range, b) -> [(Range, b)] -> [(Range, b)]
forall a. a -> [a] -> [a]
:[(Range, b)]
f1, [(Range, b)]
f2)
| Bool
otherwise = ([ (Range
toP, b
x) ], (Range
fromP, b
x) (Range, b) -> [(Range, b)] -> [(Range, b)]
forall a. a -> [a] -> [a]
: [(Range, b)]
f)
where ([(Range, b)]
f1, [(Range, b)]
f2) = [(Range, b)] -> ([(Range, b)], [(Range, b)])
split [(Range, b)]
f
toP :: Range
toP = Range :: Int -> Int -> Range
Range { from :: Int
from = Range -> Int
from Range
r, to :: Int
to = Int
p }
fromP :: Range
fromP = Range :: Int -> Int -> Range
Range { from :: Int
from = Int
p, to :: Int
to = Range -> Int
to Range
r }
selectC :: P.Range -> CompressedFile -> CompressedFile
selectC :: Range -> CompressedFile -> CompressedFile
selectC Range
r CompressedFile
cf = CompressedFile
cf'
where
empty :: (Int, Int)
empty = (Int
0,Int
0)
(Int
from, Int
to) = (Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (Int, Int)
empty (Range -> Maybe (Int, Int)
rangeToEndPoints Range
r)
(CompressedFile
_, (CompressedFile
cf', CompressedFile
_)) = ((CompressedFile -> (CompressedFile, CompressedFile))
-> (CompressedFile, CompressedFile)
-> (CompressedFile, (CompressedFile, CompressedFile))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Int -> CompressedFile -> (CompressedFile, CompressedFile)
splitAtC Int
to)) ((CompressedFile, CompressedFile)
-> (CompressedFile, (CompressedFile, CompressedFile)))
-> (CompressedFile -> (CompressedFile, CompressedFile))
-> CompressedFile
-> (CompressedFile, (CompressedFile, CompressedFile))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CompressedFile -> (CompressedFile, CompressedFile)
splitAtC Int
from (CompressedFile
-> (CompressedFile, (CompressedFile, CompressedFile)))
-> CompressedFile
-> (CompressedFile, (CompressedFile, CompressedFile))
forall a b. (a -> b) -> a -> b
$ CompressedFile
cf
smallestPosC :: CompressedFile -> Maybe Int
smallestPosC :: CompressedFile -> Maybe Int
smallestPosC (CompressedFile []) = Maybe Int
forall a. Maybe a
Nothing
smallestPosC (CompressedFile ((Range
r, Aspects
_) : [(Range, Aspects)]
_)) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Range -> Int
from Range
r)