{-# 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)
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)
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
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"))
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)
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"
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"
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
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
'.')
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
class RecalcTabs a where
recalcTabs :: Text -> Int -> a -> a
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)