{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}

module HsDev.Symbols.Location (
	ModulePackage(..), mkPackage, PackageConfig(..),
	ModuleLocation(..), locationId, noLocation,
	ModuleId(..), moduleName, moduleLocation,
	SymbolId(..), symbolName, symbolModule,
	Position(..), Region(..), region, regionAt, regionLines, regionStr,
	Location(..),

	packageName, packageVersion,
	package, packageModules, packageExposed,
	moduleFile, moduleProject, moduleInstallDirs, modulePackage, installedModuleName, installedModuleExposed, otherLocationName,
	positionLine, positionColumn,
	regionFrom, regionTo,
	locationModule, locationPosition,

	sourceModuleRoot,
	importPath,
	sourceRoot, sourceRoot_,
	RecalcTabs(..),

	module HsDev.PackageDb.Types
	) where

import Control.Applicative
import Control.DeepSeq (NFData(..))
import Control.Lens (makeLenses, view, preview, over)
import Data.Aeson
import Data.Char (isSpace, isDigit)
import Data.List (findIndex)
import Data.Maybe
import Data.Text (Text, pack, unpack)
import Data.Text.Lens (unpacked)
import qualified Data.Text as T
import System.FilePath
import Text.Read (readMaybe)
import Text.Format

import System.Directory.Paths
import HsDev.Display
import HsDev.PackageDb.Types
import HsDev.Project.Types
import HsDev.Util ((.::), (.::?), (.::?!), objectUnion, noNulls)

-- | Just package name and version without its location
data ModulePackage = ModulePackage {
	ModulePackage -> Text
_packageName :: Text,
	ModulePackage -> Text
_packageVersion :: Text }
		deriving (ModulePackage -> ModulePackage -> Bool
(ModulePackage -> ModulePackage -> Bool)
-> (ModulePackage -> ModulePackage -> Bool) -> Eq ModulePackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModulePackage -> ModulePackage -> Bool
$c/= :: ModulePackage -> ModulePackage -> Bool
== :: ModulePackage -> ModulePackage -> Bool
$c== :: ModulePackage -> ModulePackage -> Bool
Eq, Eq ModulePackage
Eq ModulePackage
-> (ModulePackage -> ModulePackage -> Ordering)
-> (ModulePackage -> ModulePackage -> Bool)
-> (ModulePackage -> ModulePackage -> Bool)
-> (ModulePackage -> ModulePackage -> Bool)
-> (ModulePackage -> ModulePackage -> Bool)
-> (ModulePackage -> ModulePackage -> ModulePackage)
-> (ModulePackage -> ModulePackage -> ModulePackage)
-> Ord ModulePackage
ModulePackage -> ModulePackage -> Bool
ModulePackage -> ModulePackage -> Ordering
ModulePackage -> ModulePackage -> ModulePackage
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 :: ModulePackage -> ModulePackage -> ModulePackage
$cmin :: ModulePackage -> ModulePackage -> ModulePackage
max :: ModulePackage -> ModulePackage -> ModulePackage
$cmax :: ModulePackage -> ModulePackage -> ModulePackage
>= :: ModulePackage -> ModulePackage -> Bool
$c>= :: ModulePackage -> ModulePackage -> Bool
> :: ModulePackage -> ModulePackage -> Bool
$c> :: ModulePackage -> ModulePackage -> Bool
<= :: ModulePackage -> ModulePackage -> Bool
$c<= :: ModulePackage -> ModulePackage -> Bool
< :: ModulePackage -> ModulePackage -> Bool
$c< :: ModulePackage -> ModulePackage -> Bool
compare :: ModulePackage -> ModulePackage -> Ordering
$ccompare :: ModulePackage -> ModulePackage -> Ordering
$cp1Ord :: Eq ModulePackage
Ord)

makeLenses ''ModulePackage

mkPackage :: Text -> ModulePackage
mkPackage :: Text -> ModulePackage
mkPackage Text
n = Text -> Text -> ModulePackage
ModulePackage Text
n Text
""

instance NFData ModulePackage where
	rnf :: ModulePackage -> ()
rnf (ModulePackage Text
n Text
v) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
n () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
v

instance Show ModulePackage where
	show :: ModulePackage -> String
show (ModulePackage Text
n Text
"") = Text -> String
unpack Text
n
	show (ModulePackage Text
n Text
v) = Text -> String
unpack Text
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
v

instance Read ModulePackage where
	readsPrec :: Int -> ReadS ModulePackage
readsPrec Int
_ String
str = case String
pkg of
		String
"" -> []
		String
_ -> [(Text -> Text -> ModulePackage
ModulePackage (String -> Text
pack String
n) (String -> Text
pack String
v), String
str')]
		where
			(String
pkg, String
str') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
str
			(String
rv, String
rn) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
versionChar (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
pkg
			v :: String
v = ShowS
forall a. [a] -> [a]
reverse String
rv
			n :: String
n = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') String
rn

			versionChar :: Char -> Bool
versionChar Char
ch = Char -> Bool
isDigit Char
ch Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'

instance ToJSON ModulePackage where
	toJSON :: ModulePackage -> Value
toJSON (ModulePackage Text
n Text
v) = [Pair] -> Value
object [
		Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
n,
		Text
"version" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
v]

instance FromJSON ModulePackage where
	parseJSON :: Value -> Parser ModulePackage
parseJSON = String
-> (Object -> Parser ModulePackage)
-> Value
-> Parser ModulePackage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"module package" ((Object -> Parser ModulePackage) -> Value -> Parser ModulePackage)
-> (Object -> Parser ModulePackage)
-> Value
-> Parser ModulePackage
forall a b. (a -> b) -> a -> b
$ \Object
v ->
		Text -> Text -> ModulePackage
ModulePackage (Text -> Text -> ModulePackage)
-> Parser Text -> Parser (Text -> ModulePackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"name") Parser (Text -> ModulePackage)
-> Parser Text -> Parser ModulePackage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"version")

data PackageConfig = PackageConfig {
	PackageConfig -> ModulePackage
_package :: ModulePackage,
	PackageConfig -> [Text]
_packageModules :: [Text],
	PackageConfig -> Bool
_packageExposed :: Bool }
		deriving (PackageConfig -> PackageConfig -> Bool
(PackageConfig -> PackageConfig -> Bool)
-> (PackageConfig -> PackageConfig -> Bool) -> Eq PackageConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageConfig -> PackageConfig -> Bool
$c/= :: PackageConfig -> PackageConfig -> Bool
== :: PackageConfig -> PackageConfig -> Bool
$c== :: PackageConfig -> PackageConfig -> Bool
Eq, Eq PackageConfig
Eq PackageConfig
-> (PackageConfig -> PackageConfig -> Ordering)
-> (PackageConfig -> PackageConfig -> Bool)
-> (PackageConfig -> PackageConfig -> Bool)
-> (PackageConfig -> PackageConfig -> Bool)
-> (PackageConfig -> PackageConfig -> Bool)
-> (PackageConfig -> PackageConfig -> PackageConfig)
-> (PackageConfig -> PackageConfig -> PackageConfig)
-> Ord PackageConfig
PackageConfig -> PackageConfig -> Bool
PackageConfig -> PackageConfig -> Ordering
PackageConfig -> PackageConfig -> PackageConfig
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 :: PackageConfig -> PackageConfig -> PackageConfig
$cmin :: PackageConfig -> PackageConfig -> PackageConfig
max :: PackageConfig -> PackageConfig -> PackageConfig
$cmax :: PackageConfig -> PackageConfig -> PackageConfig
>= :: PackageConfig -> PackageConfig -> Bool
$c>= :: PackageConfig -> PackageConfig -> Bool
> :: PackageConfig -> PackageConfig -> Bool
$c> :: PackageConfig -> PackageConfig -> Bool
<= :: PackageConfig -> PackageConfig -> Bool
$c<= :: PackageConfig -> PackageConfig -> Bool
< :: PackageConfig -> PackageConfig -> Bool
$c< :: PackageConfig -> PackageConfig -> Bool
compare :: PackageConfig -> PackageConfig -> Ordering
$ccompare :: PackageConfig -> PackageConfig -> Ordering
$cp1Ord :: Eq PackageConfig
Ord, ReadPrec [PackageConfig]
ReadPrec PackageConfig
Int -> ReadS PackageConfig
ReadS [PackageConfig]
(Int -> ReadS PackageConfig)
-> ReadS [PackageConfig]
-> ReadPrec PackageConfig
-> ReadPrec [PackageConfig]
-> Read PackageConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackageConfig]
$creadListPrec :: ReadPrec [PackageConfig]
readPrec :: ReadPrec PackageConfig
$creadPrec :: ReadPrec PackageConfig
readList :: ReadS [PackageConfig]
$creadList :: ReadS [PackageConfig]
readsPrec :: Int -> ReadS PackageConfig
$creadsPrec :: Int -> ReadS PackageConfig
Read, Int -> PackageConfig -> ShowS
[PackageConfig] -> ShowS
PackageConfig -> String
(Int -> PackageConfig -> ShowS)
-> (PackageConfig -> String)
-> ([PackageConfig] -> ShowS)
-> Show PackageConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageConfig] -> ShowS
$cshowList :: [PackageConfig] -> ShowS
show :: PackageConfig -> String
$cshow :: PackageConfig -> String
showsPrec :: Int -> PackageConfig -> ShowS
$cshowsPrec :: Int -> PackageConfig -> ShowS
Show)

makeLenses ''PackageConfig

instance NFData PackageConfig where
	rnf :: PackageConfig -> ()
rnf (PackageConfig ModulePackage
p [Text]
ms Bool
e) = ModulePackage -> ()
forall a. NFData a => a -> ()
rnf ModulePackage
p () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
ms () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
e

instance ToJSON PackageConfig where
	toJSON :: PackageConfig -> Value
toJSON (PackageConfig ModulePackage
p [Text]
ms Bool
e) = ModulePackage -> Value
forall a. ToJSON a => a -> Value
toJSON ModulePackage
p Value -> Value -> Value
`objectUnion` [Pair] -> Value
object [Text
"modules" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
ms, Text
"exposed" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
e]

instance FromJSON PackageConfig where
	parseJSON :: Value -> Parser PackageConfig
parseJSON = String
-> (Object -> Parser PackageConfig)
-> Value
-> Parser PackageConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"package-config" ((Object -> Parser PackageConfig) -> Value -> Parser PackageConfig)
-> (Object -> Parser PackageConfig)
-> Value
-> Parser PackageConfig
forall a b. (a -> b) -> a -> b
$ \Object
v -> ModulePackage -> [Text] -> Bool -> PackageConfig
PackageConfig (ModulePackage -> [Text] -> Bool -> PackageConfig)
-> Parser ModulePackage -> Parser ([Text] -> Bool -> PackageConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Value -> Parser ModulePackage
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v) Parser ([Text] -> Bool -> PackageConfig)
-> Parser [Text] -> Parser (Bool -> PackageConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"modules") Parser (Bool -> PackageConfig)
-> Parser Bool -> Parser PackageConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"exposed" Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)

-- | Location of module
data ModuleLocation =
	FileModule { ModuleLocation -> Text
_moduleFile :: Path, ModuleLocation -> Maybe Project
_moduleProject :: Maybe Project } |
	InstalledModule { ModuleLocation -> [Text]
_moduleInstallDirs :: [Path], ModuleLocation -> ModulePackage
_modulePackage :: ModulePackage, ModuleLocation -> Text
_installedModuleName :: Text, ModuleLocation -> Bool
_installedModuleExposed :: Bool } |
	OtherLocation { ModuleLocation -> Text
_otherLocationName :: Text } |
	NoLocation

instance Eq ModuleLocation where
	FileModule Text
lfile Maybe Project
_ == :: ModuleLocation -> ModuleLocation -> Bool
== FileModule Text
rfile Maybe Project
_ = Text
lfile Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rfile
	InstalledModule [Text]
ldirs ModulePackage
_ Text
lname Bool
_ == InstalledModule [Text]
rdirs ModulePackage
_ Text
rname Bool
_ = [Text]
ldirs [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
rdirs Bool -> Bool -> Bool
&& Text
lname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rname
	OtherLocation Text
l == OtherLocation Text
r = Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
r
	ModuleLocation
NoLocation == ModuleLocation
NoLocation = Bool
True
	ModuleLocation
_ == ModuleLocation
_ = Bool
False

instance Ord ModuleLocation where
	compare :: ModuleLocation -> ModuleLocation -> Ordering
compare ModuleLocation
l ModuleLocation
r = (Int, [Text]) -> (Int, [Text]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ModuleLocation -> Int
locType ModuleLocation
l, ModuleLocation -> [Text]
locNames ModuleLocation
l) (ModuleLocation -> Int
locType ModuleLocation
r, ModuleLocation -> [Text]
locNames ModuleLocation
r) where
		locType :: ModuleLocation -> Int
		locType :: ModuleLocation -> Int
locType FileModule{} = Int
0
		locType InstalledModule{} = Int
1
		locType OtherLocation{} = Int
2
		locType ModuleLocation
NoLocation = Int
3
		locNames :: ModuleLocation -> [Text]
locNames (FileModule Text
f Maybe Project
_) = [Text
f]
		locNames (InstalledModule [Text]
dirs ModulePackage
_ Text
nm Bool
_) = Text
nm Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
dirs  -- dirs already includes name of package
		locNames (OtherLocation Text
n) = [Text
n]
		locNames ModuleLocation
NoLocation = []

makeLenses ''ModuleLocation

locationId :: ModuleLocation -> Text
locationId :: ModuleLocation -> Text
locationId (FileModule Text
fpath Maybe Project
_) = Text
fpath
locationId (InstalledModule [Text]
dirs ModulePackage
mpack Text
nm Bool
_) = Text -> [Text] -> Text
T.intercalate Text
":" (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
1 [Text]
dirs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [String -> Text
pack (ModulePackage -> String
forall a. Show a => a -> String
show ModulePackage
mpack), Text
nm])
locationId (OtherLocation Text
src) = Text
src
locationId ModuleLocation
NoLocation = Text
"<no-location>"

instance NFData ModuleLocation where
	rnf :: ModuleLocation -> ()
rnf (FileModule Text
f Maybe Project
p) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
f () -> () -> ()
`seq` Maybe Project -> ()
forall a. NFData a => a -> ()
rnf Maybe Project
p
	rnf (InstalledModule [Text]
d ModulePackage
p Text
n Bool
e) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
d () -> () -> ()
`seq` ModulePackage -> ()
forall a. NFData a => a -> ()
rnf ModulePackage
p () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
n () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
e
	rnf (OtherLocation Text
s) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
s
	rnf ModuleLocation
NoLocation = ()

instance Show ModuleLocation where
	show :: ModuleLocation -> String
show = Text -> String
unpack (Text -> String)
-> (ModuleLocation -> Text) -> ModuleLocation -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleLocation -> Text
locationId

instance Display ModuleLocation where
	display :: ModuleLocation -> String
display (FileModule Text
f Maybe Project
_) = Text -> String
forall a. Display a => a -> String
display Text
f
	display (InstalledModule [Text]
_ ModulePackage
_ Text
n Bool
_) = Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
forall t. IsText t => Iso' t String
unpacked Text
n
	display (OtherLocation Text
s) = Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
forall t. IsText t => Iso' t String
unpacked Text
s
	display ModuleLocation
NoLocation = String
"<no-location>"
	displayType :: ModuleLocation -> String
displayType ModuleLocation
_ = String
"module"

instance Formattable ModuleLocation where
	formattable :: ModuleLocation -> FormatFlags -> Formatted
formattable = String -> FormatFlags -> Formatted
forall a. Formattable a => a -> FormatFlags -> Formatted
formattable (String -> FormatFlags -> Formatted)
-> (ModuleLocation -> String)
-> ModuleLocation
-> FormatFlags
-> Formatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleLocation -> String
forall a. Display a => a -> String
display

instance ToJSON ModuleLocation where
	toJSON :: ModuleLocation -> Value
toJSON (FileModule Text
f Maybe Project
p) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [Text
"file" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
f, Text
"project" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Project -> Text) -> Maybe Project -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting Text Project Text -> Project -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Project Text
Lens' Project Text
projectCabal) Maybe Project
p]
	toJSON (InstalledModule [Text]
c ModulePackage
p Text
n Bool
e) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [Text
"dirs" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
c, Text
"package" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ModulePackage -> String
forall a. Show a => a -> String
show ModulePackage
p, Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
n, Text
"exposed" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
e]
	toJSON (OtherLocation Text
s) = [Pair] -> Value
object [Text
"source" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
s]
	toJSON ModuleLocation
NoLocation = [Pair] -> Value
object []

instance FromJSON ModuleLocation where
	parseJSON :: Value -> Parser ModuleLocation
parseJSON = String
-> (Object -> Parser ModuleLocation)
-> Value
-> Parser ModuleLocation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"module location" ((Object -> Parser ModuleLocation)
 -> Value -> Parser ModuleLocation)
-> (Object -> Parser ModuleLocation)
-> Value
-> Parser ModuleLocation
forall a b. (a -> b) -> a -> b
$ \Object
v ->
		(Text -> Maybe Project -> ModuleLocation
FileModule (Text -> Maybe Project -> ModuleLocation)
-> Parser Text -> Parser (Maybe Project -> ModuleLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"file" Parser (Maybe Project -> ModuleLocation)
-> Parser (Maybe Project) -> Parser ModuleLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((String -> Project) -> Maybe String -> Maybe Project
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Project
project (Maybe String -> Maybe Project)
-> Parser (Maybe String) -> Parser (Maybe Project)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"project"))) Parser ModuleLocation
-> Parser ModuleLocation -> Parser ModuleLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
		([Text] -> ModulePackage -> Text -> Bool -> ModuleLocation
InstalledModule ([Text] -> ModulePackage -> Text -> Bool -> ModuleLocation)
-> Parser [Text]
-> Parser (ModulePackage -> Text -> Bool -> ModuleLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"dirs" Parser (ModulePackage -> Text -> Bool -> ModuleLocation)
-> Parser ModulePackage -> Parser (Text -> Bool -> ModuleLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Parser ModulePackage
forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readPackage (String -> Parser ModulePackage)
-> Parser String -> Parser ModulePackage
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"package")) Parser (Text -> Bool -> ModuleLocation)
-> Parser Text -> Parser (Bool -> ModuleLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"name" Parser (Bool -> ModuleLocation)
-> Parser Bool -> Parser ModuleLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"exposed") Parser ModuleLocation
-> Parser ModuleLocation -> Parser ModuleLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
		(Text -> ModuleLocation
OtherLocation (Text -> ModuleLocation) -> Parser Text -> Parser ModuleLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"source") Parser ModuleLocation
-> Parser ModuleLocation -> Parser ModuleLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
		(ModuleLocation -> Parser ModuleLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleLocation
NoLocation)
		where
			readPackage :: String -> m a
readPackage String
s = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"can't parse package: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m a) -> (String -> Maybe a) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
s

instance Paths ModuleLocation where
	paths :: (String -> f String) -> ModuleLocation -> f ModuleLocation
paths String -> f String
f (FileModule Text
fpath Maybe Project
p) = Text -> Maybe Project -> ModuleLocation
FileModule (Text -> Maybe Project -> ModuleLocation)
-> f Text -> f (Maybe Project -> ModuleLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> f String) -> Text -> f Text
forall a. Paths a => Traversal' a String
paths String -> f String
f Text
fpath f (Maybe Project -> ModuleLocation)
-> f (Maybe Project) -> f ModuleLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Project -> f Project) -> Maybe Project -> f (Maybe Project)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Project -> f Project
forall a. Paths a => Traversal' a String
paths String -> f String
f) Maybe Project
p
	paths String -> f String
f (InstalledModule [Text]
c ModulePackage
p Text
n Bool
e) = [Text] -> ModulePackage -> Text -> Bool -> ModuleLocation
InstalledModule ([Text] -> ModulePackage -> Text -> Bool -> ModuleLocation)
-> f [Text] -> f (ModulePackage -> Text -> Bool -> ModuleLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> f Text) -> [Text] -> f [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> f String) -> Text -> f Text
forall a. Paths a => Traversal' a String
paths String -> f String
f) [Text]
c f (ModulePackage -> Text -> Bool -> ModuleLocation)
-> f ModulePackage -> f (Text -> Bool -> ModuleLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ModulePackage -> f ModulePackage
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModulePackage
p f (Text -> Bool -> ModuleLocation)
-> f Text -> f (Bool -> ModuleLocation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n f (Bool -> ModuleLocation) -> f Bool -> f ModuleLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
e
	paths String -> f String
_ (OtherLocation Text
s) = ModuleLocation -> f ModuleLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleLocation -> f ModuleLocation)
-> ModuleLocation -> f ModuleLocation
forall a b. (a -> b) -> a -> b
$ Text -> ModuleLocation
OtherLocation Text
s
	paths String -> f String
_ ModuleLocation
NoLocation = ModuleLocation -> f ModuleLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModuleLocation
NoLocation

noLocation :: ModuleLocation
noLocation :: ModuleLocation
noLocation = ModuleLocation
NoLocation

data ModuleId = ModuleId {
	ModuleId -> Text
_moduleName :: Text,
	ModuleId -> ModuleLocation
_moduleLocation :: ModuleLocation }
		deriving (ModuleId -> ModuleId -> Bool
(ModuleId -> ModuleId -> Bool)
-> (ModuleId -> ModuleId -> Bool) -> Eq ModuleId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleId -> ModuleId -> Bool
$c/= :: ModuleId -> ModuleId -> Bool
== :: ModuleId -> ModuleId -> Bool
$c== :: ModuleId -> ModuleId -> Bool
Eq, Eq ModuleId
Eq ModuleId
-> (ModuleId -> ModuleId -> Ordering)
-> (ModuleId -> ModuleId -> Bool)
-> (ModuleId -> ModuleId -> Bool)
-> (ModuleId -> ModuleId -> Bool)
-> (ModuleId -> ModuleId -> Bool)
-> (ModuleId -> ModuleId -> ModuleId)
-> (ModuleId -> ModuleId -> ModuleId)
-> Ord ModuleId
ModuleId -> ModuleId -> Bool
ModuleId -> ModuleId -> Ordering
ModuleId -> ModuleId -> ModuleId
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 :: ModuleId -> ModuleId -> ModuleId
$cmin :: ModuleId -> ModuleId -> ModuleId
max :: ModuleId -> ModuleId -> ModuleId
$cmax :: ModuleId -> ModuleId -> ModuleId
>= :: ModuleId -> ModuleId -> Bool
$c>= :: ModuleId -> ModuleId -> Bool
> :: ModuleId -> ModuleId -> Bool
$c> :: ModuleId -> ModuleId -> Bool
<= :: ModuleId -> ModuleId -> Bool
$c<= :: ModuleId -> ModuleId -> Bool
< :: ModuleId -> ModuleId -> Bool
$c< :: ModuleId -> ModuleId -> Bool
compare :: ModuleId -> ModuleId -> Ordering
$ccompare :: ModuleId -> ModuleId -> Ordering
$cp1Ord :: Eq ModuleId
Ord)

makeLenses ''ModuleId

instance NFData ModuleId where
	rnf :: ModuleId -> ()
rnf (ModuleId Text
n ModuleLocation
l) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
n () -> () -> ()
`seq` ModuleLocation -> ()
forall a. NFData a => a -> ()
rnf ModuleLocation
l

instance Show ModuleId where
	show :: ModuleId -> String
show (ModuleId Text
n ModuleLocation
l) = ModuleLocation -> String
forall a. Show a => a -> String
show ModuleLocation
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
n

instance ToJSON ModuleId where
	toJSON :: ModuleId -> Value
toJSON ModuleId
m = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [
		Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ModuleId -> Text
_moduleName ModuleId
m,
		Text
"location" Text -> ModuleLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ModuleId -> ModuleLocation
_moduleLocation ModuleId
m]

instance FromJSON ModuleId where
	parseJSON :: Value -> Parser ModuleId
parseJSON = String -> (Object -> Parser ModuleId) -> Value -> Parser ModuleId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"module-id" ((Object -> Parser ModuleId) -> Value -> Parser ModuleId)
-> (Object -> Parser ModuleId) -> Value -> Parser ModuleId
forall a b. (a -> b) -> a -> b
$ \Object
v -> Text -> ModuleLocation -> ModuleId
ModuleId (Text -> ModuleLocation -> ModuleId)
-> Parser Text -> Parser (ModuleLocation -> ModuleId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		(Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Parser (Maybe Text) -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"name")) Parser (ModuleLocation -> ModuleId)
-> Parser ModuleLocation -> Parser ModuleId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(ModuleLocation -> Maybe ModuleLocation -> ModuleLocation
forall a. a -> Maybe a -> a
fromMaybe ModuleLocation
NoLocation (Maybe ModuleLocation -> ModuleLocation)
-> Parser (Maybe ModuleLocation) -> Parser ModuleLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe ModuleLocation)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"location"))

-- | Symbol
data SymbolId = SymbolId {
	SymbolId -> Text
_symbolName :: Text,
	SymbolId -> ModuleId
_symbolModule :: ModuleId }
		deriving (SymbolId -> SymbolId -> Bool
(SymbolId -> SymbolId -> Bool)
-> (SymbolId -> SymbolId -> Bool) -> Eq SymbolId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolId -> SymbolId -> Bool
$c/= :: SymbolId -> SymbolId -> Bool
== :: SymbolId -> SymbolId -> Bool
$c== :: SymbolId -> SymbolId -> Bool
Eq, Eq SymbolId
Eq SymbolId
-> (SymbolId -> SymbolId -> Ordering)
-> (SymbolId -> SymbolId -> Bool)
-> (SymbolId -> SymbolId -> Bool)
-> (SymbolId -> SymbolId -> Bool)
-> (SymbolId -> SymbolId -> Bool)
-> (SymbolId -> SymbolId -> SymbolId)
-> (SymbolId -> SymbolId -> SymbolId)
-> Ord SymbolId
SymbolId -> SymbolId -> Bool
SymbolId -> SymbolId -> Ordering
SymbolId -> SymbolId -> SymbolId
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 :: SymbolId -> SymbolId -> SymbolId
$cmin :: SymbolId -> SymbolId -> SymbolId
max :: SymbolId -> SymbolId -> SymbolId
$cmax :: SymbolId -> SymbolId -> SymbolId
>= :: SymbolId -> SymbolId -> Bool
$c>= :: SymbolId -> SymbolId -> Bool
> :: SymbolId -> SymbolId -> Bool
$c> :: SymbolId -> SymbolId -> Bool
<= :: SymbolId -> SymbolId -> Bool
$c<= :: SymbolId -> SymbolId -> Bool
< :: SymbolId -> SymbolId -> Bool
$c< :: SymbolId -> SymbolId -> Bool
compare :: SymbolId -> SymbolId -> Ordering
$ccompare :: SymbolId -> SymbolId -> Ordering
$cp1Ord :: Eq SymbolId
Ord)

makeLenses ''SymbolId

instance NFData SymbolId where
	rnf :: SymbolId -> ()
rnf (SymbolId Text
n ModuleId
m) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
n () -> () -> ()
`seq` ModuleId -> ()
forall a. NFData a => a -> ()
rnf ModuleId
m

instance Show SymbolId where
	show :: SymbolId -> String
show (SymbolId Text
n ModuleId
m) = ModuleId -> String
forall a. Show a => a -> String
show ModuleId
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
n

instance ToJSON SymbolId where
	toJSON :: SymbolId -> Value
toJSON SymbolId
s = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [
		Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SymbolId -> Text
_symbolName SymbolId
s,
		Text
"module" Text -> ModuleId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SymbolId -> ModuleId
_symbolModule SymbolId
s]

instance FromJSON SymbolId where
	parseJSON :: Value -> Parser SymbolId
parseJSON = String -> (Object -> Parser SymbolId) -> Value -> Parser SymbolId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"symbol-id" ((Object -> Parser SymbolId) -> Value -> Parser SymbolId)
-> (Object -> Parser SymbolId) -> Value -> Parser SymbolId
forall a b. (a -> b) -> a -> b
$ \Object
v -> Text -> ModuleId -> SymbolId
SymbolId (Text -> ModuleId -> SymbolId)
-> Parser Text -> Parser (ModuleId -> SymbolId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		(Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Parser (Maybe Text) -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"name")) Parser (ModuleId -> SymbolId) -> Parser ModuleId -> Parser SymbolId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(ModuleId -> Maybe ModuleId -> ModuleId
forall a. a -> Maybe a -> a
fromMaybe (Text -> ModuleLocation -> ModuleId
ModuleId Text
"" ModuleLocation
NoLocation) (Maybe ModuleId -> ModuleId)
-> Parser (Maybe ModuleId) -> Parser ModuleId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe ModuleId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"module"))

data Position = Position {
	Position -> Int
_positionLine :: Int,
	Position -> Int
_positionColumn :: Int }
		deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Eq Position
-> (Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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 :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord, ReadPrec [Position]
ReadPrec Position
Int -> ReadS Position
ReadS [Position]
(Int -> ReadS Position)
-> ReadS [Position]
-> ReadPrec Position
-> ReadPrec [Position]
-> Read Position
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Position]
$creadListPrec :: ReadPrec [Position]
readPrec :: ReadPrec Position
$creadPrec :: ReadPrec Position
readList :: ReadS [Position]
$creadList :: ReadS [Position]
readsPrec :: Int -> ReadS Position
$creadsPrec :: Int -> ReadS Position
Read)

makeLenses ''Position

instance NFData Position where
	rnf :: Position -> ()
rnf (Position Int
l Int
c) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
l () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
c

instance Show Position where
 	show :: Position -> String
show (Position Int
l Int
c) = Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c

instance ToJSON Position where
	toJSON :: Position -> Value
toJSON (Position Int
l Int
c) = [Pair] -> Value
object [
		Text
"line" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
l,
		Text
"column" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
c]

instance FromJSON Position where
	parseJSON :: Value -> Parser Position
parseJSON = String -> (Object -> Parser Position) -> Value -> Parser Position
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"position" ((Object -> Parser Position) -> Value -> Parser Position)
-> (Object -> Parser Position) -> Value -> Parser Position
forall a b. (a -> b) -> a -> b
$ \Object
v -> Int -> Int -> Position
Position (Int -> Int -> Position) -> Parser Int -> Parser (Int -> Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"line" Parser (Int -> Position) -> Parser Int -> Parser Position
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
"column"

data Region = Region {
	Region -> Position
_regionFrom :: Position,
	Region -> Position
_regionTo :: Position }
		deriving (Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq, Eq Region
Eq Region
-> (Region -> Region -> Ordering)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Region)
-> (Region -> Region -> Region)
-> Ord Region
Region -> Region -> Bool
Region -> Region -> Ordering
Region -> Region -> Region
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 :: Region -> Region -> Region
$cmin :: Region -> Region -> Region
max :: Region -> Region -> Region
$cmax :: Region -> Region -> Region
>= :: Region -> Region -> Bool
$c>= :: Region -> Region -> Bool
> :: Region -> Region -> Bool
$c> :: Region -> Region -> Bool
<= :: Region -> Region -> Bool
$c<= :: Region -> Region -> Bool
< :: Region -> Region -> Bool
$c< :: Region -> Region -> Bool
compare :: Region -> Region -> Ordering
$ccompare :: Region -> Region -> Ordering
$cp1Ord :: Eq Region
Ord, ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
(Int -> ReadS Region)
-> ReadS [Region]
-> ReadPrec Region
-> ReadPrec [Region]
-> Read Region
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Region]
$creadListPrec :: ReadPrec [Region]
readPrec :: ReadPrec Region
$creadPrec :: ReadPrec Region
readList :: ReadS [Region]
$creadList :: ReadS [Region]
readsPrec :: Int -> ReadS Region
$creadsPrec :: Int -> ReadS Region
Read)

makeLenses ''Region

region :: Position -> Position -> Region
region :: Position -> Position -> Region
region Position
f Position
t = Position -> Position -> Region
Region (Position -> Position -> Position
forall a. Ord a => a -> a -> a
min Position
f Position
t) (Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
f Position
t)

regionAt :: Position -> Region
regionAt :: Position -> Region
regionAt Position
f = Position -> Position -> Region
region Position
f Position
f

regionLines :: Region -> Int
regionLines :: Region -> Int
regionLines (Region Position
f Position
t) = Int -> Int
forall a. Enum a => a -> a
succ (Getting Int Position Int -> Position -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Position Int
Lens' Position Int
positionLine Position
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Getting Int Position Int -> Position -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Position Int
Lens' Position Int
positionLine Position
f)

-- | Get string at region
regionStr :: Region -> Text -> Text
regionStr :: Region -> Text -> Text
regionStr r :: Region
r@(Region Position
f Position
t) Text
s = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Getting Int Position Int -> Position -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Position Int
Lens' Position Int
positionColumn Position
f) Text
fline Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
tl where
	s' :: [Text]
s' = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Region -> Int
regionLines Region
r) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int -> Int
forall a. Enum a => a -> a
pred (Getting Int Position Int -> Position -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Position Int
Lens' Position Int
positionLine Position
f)) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
	(Text
fline:[Text]
tl) = [Text] -> [Text]
forall a. [a] -> [a]
init [Text]
s' [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Int -> Text -> Text
T.take (Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Getting Int Position Int -> Position -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Position Int
Lens' Position Int
positionColumn Position
t) ([Text] -> Text
forall a. [a] -> a
last [Text]
s')]

instance NFData Region where
	rnf :: Region -> ()
rnf (Region Position
f Position
t) = Position -> ()
forall a. NFData a => a -> ()
rnf Position
f () -> () -> ()
`seq` Position -> ()
forall a. NFData a => a -> ()
rnf Position
t

instance Show Region where
	show :: Region -> String
show (Region Position
f Position
t) = Position -> String
forall a. Show a => a -> String
show Position
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
t

instance ToJSON Region where
	toJSON :: Region -> Value
toJSON (Region Position
f Position
t) = [Pair] -> Value
object [
		Text
"from" Text -> Position -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position
f,
		Text
"to" Text -> Position -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position
t]

instance FromJSON Region where
	parseJSON :: Value -> Parser Region
parseJSON = String -> (Object -> Parser Region) -> Value -> Parser Region
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"region" ((Object -> Parser Region) -> Value -> Parser Region)
-> (Object -> Parser Region) -> Value -> Parser Region
forall a b. (a -> b) -> a -> b
$ \Object
v -> Position -> Position -> Region
Region (Position -> Position -> Region)
-> Parser Position -> Parser (Position -> Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser Position
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"from" Parser (Position -> Region) -> Parser Position -> Parser Region
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser Position
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"to"

-- | Location of symbol
data Location = Location {
	Location -> ModuleLocation
_locationModule :: ModuleLocation,
	Location -> Maybe Position
_locationPosition :: Maybe Position }
		deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Eq Location
Eq Location
-> (Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
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 :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c< :: Location -> Location -> Bool
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
$cp1Ord :: Eq Location
Ord)

makeLenses ''Location

instance NFData Location where
	rnf :: Location -> ()
rnf (Location ModuleLocation
m Maybe Position
p) = ModuleLocation -> ()
forall a. NFData a => a -> ()
rnf ModuleLocation
m () -> () -> ()
`seq` Maybe Position -> ()
forall a. NFData a => a -> ()
rnf Maybe Position
p

instance Show Location where
	show :: Location -> String
show (Location ModuleLocation
m Maybe Position
p) = ModuleLocation -> String
forall a. Show a => a -> String
show ModuleLocation
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Position -> String
forall a. Show a => a -> String
show Maybe Position
p

instance ToJSON Location where
	toJSON :: Location -> Value
toJSON (Location ModuleLocation
ml Maybe Position
p) = [Pair] -> Value
object [
		Text
"module" Text -> ModuleLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ModuleLocation
ml,
		Text
"pos" Text -> Maybe Position -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Position
p]

instance FromJSON Location where
	parseJSON :: Value -> Parser Location
parseJSON = String -> (Object -> Parser Location) -> Value -> Parser Location
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"location" ((Object -> Parser Location) -> Value -> Parser Location)
-> (Object -> Parser Location) -> Value -> Parser Location
forall a b. (a -> b) -> a -> b
$ \Object
v -> ModuleLocation -> Maybe Position -> Location
Location (ModuleLocation -> Maybe Position -> Location)
-> Parser ModuleLocation -> Parser (Maybe Position -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser ModuleLocation
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"module" Parser (Maybe Position -> Location)
-> Parser (Maybe Position) -> Parser Location
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Maybe Position)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"pos"

-- | Get source module root directory, i.e. for "...\src\Foo\Bar.hs" with module 'Foo.Bar' will return "...\src"
sourceModuleRoot :: Text -> Path -> Path
sourceModuleRoot :: Text -> Text -> Text
sourceModuleRoot Text
mname = ASetter Text Text String String -> ShowS -> Text -> Text
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Text Text String String
forall a. Paths a => Traversal' a String
paths (ShowS -> Text -> Text) -> ShowS -> Text -> Text
forall a b. (a -> b) -> a -> b
$
	ShowS
normalise ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatFlags -> String
joinPath (FormatFlags -> String) -> (String -> FormatFlags) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	FormatFlags -> FormatFlags
forall a. [a] -> [a]
reverse (FormatFlags -> FormatFlags)
-> (String -> FormatFlags) -> String -> FormatFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FormatFlags -> FormatFlags
forall a. Int -> [a] -> [a]
drop ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
mname) (FormatFlags -> FormatFlags)
-> (String -> FormatFlags) -> String -> FormatFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatFlags -> FormatFlags
forall a. [a] -> [a]
reverse (FormatFlags -> FormatFlags)
-> (String -> FormatFlags) -> String -> FormatFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	String -> FormatFlags
splitDirectories

-- | Path to module source
-- >importPath "Quux.Blah" = "Quux/Blah.hs"
importPath :: Text -> Path
importPath :: Text -> Text
importPath = String -> Text
fromFilePath (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
`addExtension` String
"hs") ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatFlags -> String
joinPath (FormatFlags -> String) -> (Text -> FormatFlags) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> FormatFlags
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
unpack ([Text] -> FormatFlags) -> (Text -> [Text]) -> Text -> FormatFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')

-- | Root of sources, package dir or root directory of standalone modules
sourceRoot :: ModuleId -> Maybe Path
sourceRoot :: ModuleId -> Maybe Text
sourceRoot ModuleId
m = do
	Text
fpath <- Getting (First Text) ModuleId Text -> ModuleId -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) ModuleId Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
moduleFile) ModuleId
m
	Maybe Project
mproj <- Getting (First (Maybe Project)) ModuleId (Maybe Project)
-> ModuleId -> Maybe (Maybe Project)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((ModuleLocation -> Const (First (Maybe Project)) ModuleLocation)
-> ModuleId -> Const (First (Maybe Project)) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First (Maybe Project)) ModuleLocation)
 -> ModuleId -> Const (First (Maybe Project)) ModuleId)
-> ((Maybe Project
     -> Const (First (Maybe Project)) (Maybe Project))
    -> ModuleLocation -> Const (First (Maybe Project)) ModuleLocation)
-> Getting (First (Maybe Project)) ModuleId (Maybe Project)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Project -> Const (First (Maybe Project)) (Maybe Project))
-> ModuleLocation -> Const (First (Maybe Project)) ModuleLocation
Traversal' ModuleLocation (Maybe Project)
moduleProject) ModuleId
m
	Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> (Project -> Text) -> Maybe Project -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
		(Text -> Text -> Text
sourceModuleRoot (Getting Text ModuleId Text -> ModuleId -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ModuleId Text
Lens' ModuleId Text
moduleName ModuleId
m) Text
fpath)
		(Getting Text Project Text -> Project -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Project Text
Lens' Project Text
projectPath)
		Maybe Project
mproj

sourceRoot_ :: ModuleId -> Path
sourceRoot_ :: ModuleId -> Text
sourceRoot_ = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. HasCallStack => String -> a
error String
"sourceRoot_: not a source location") (Maybe Text -> Text)
-> (ModuleId -> Maybe Text) -> ModuleId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleId -> Maybe Text
sourceRoot

-- | Recalc positions to interpret '\t' as one symbol instead of N
class RecalcTabs a where
	-- | Interpret '\t' as one symbol instead of N
	recalcTabs :: Text -> Int -> a -> a
	-- | Inverse of `recalcTabs`: interpret '\t' as N symbols instead of 1
	calcTabs :: Text -> Int -> a -> a

instance RecalcTabs Position where
	recalcTabs :: Text -> Int -> Position -> Position
recalcTabs Text
cts Int
n (Position Int
l Int
c) = Int -> Int -> Position
Position Int
l Int
c' where
		line :: Maybe Text
line = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int -> Int
forall a. Enum a => a -> a
pred Int
l) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
cts
		c' :: Int
c' = case Maybe Text
line of
			Maybe Text
Nothing -> Int
c
			Just Text
line' -> let sizes :: [Int]
sizes = (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
charSize (Text -> String
unpack Text
line') in
				Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> ([Int] -> Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
sizes) (Maybe Int -> Int) -> ([Int] -> Maybe Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
				(Int -> Bool) -> [Int] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
forall a. Enum a => a -> a
pred Int
c) ([Int] -> Maybe Int) -> ([Int] -> [Int]) -> [Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
				(Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [Int]
sizes
		charSize :: Char -> Int
		charSize :: Char -> Int
charSize Char
'\t' = Int
n
		charSize Char
_ = Int
1
	calcTabs :: Text -> Int -> Position -> Position
calcTabs Text
cts Int
n (Position Int
l Int
c) = Int -> Int -> Position
Position Int
l Int
c' where
		line :: Maybe Text
line = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int -> Int
forall a. Enum a => a -> a
pred Int
l) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
cts
		c' :: Int
c' = Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
c (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (Text -> [Int]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
charSize (String -> [Int]) -> (Text -> String) -> Text -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a. Enum a => a -> a
pred Int
c) ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) Maybe Text
line
		charSize :: Char -> Int
		charSize :: Char -> Int
charSize Char
'\t' = Int
n
		charSize Char
_ = Int
1

instance RecalcTabs Region where
	recalcTabs :: Text -> Int -> Region -> Region
recalcTabs Text
cts Int
n (Region Position
f Position
t) = Position -> Position -> Region
Region (Text -> Int -> Position -> Position
forall a. RecalcTabs a => Text -> Int -> a -> a
recalcTabs Text
cts Int
n Position
f) (Text -> Int -> Position -> Position
forall a. RecalcTabs a => Text -> Int -> a -> a
recalcTabs Text
cts Int
n Position
t)
	calcTabs :: Text -> Int -> Region -> Region
calcTabs Text
cts Int
n (Region Position
f Position
t) = Position -> Position -> Region
Region (Text -> Int -> Position -> Position
forall a. RecalcTabs a => Text -> Int -> a -> a
calcTabs Text
cts Int
n Position
f) (Text -> Int -> Position -> Position
forall a. RecalcTabs a => Text -> Int -> a -> a
calcTabs Text
cts Int
n Position
t)