module Language.PureScript.Ide.Imports
( parseImportsFromFile
, parseImportsFromFile'
, parseImport
, prettyPrintImportSection
, sliceImportSection
, prettyPrintImport'
, Import(Import)
)
where
import Protolude hiding (moduleName)
import Control.Lens ((^.), (%~), ix)
import Data.List (partition)
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Language.PureScript qualified as P
import Language.PureScript.CST qualified as CST
import Language.PureScript.Ide.Error (IdeError(..))
import Language.PureScript.Ide.Util (ideReadFile)
data Import = Import P.ModuleName P.ImportDeclarationType (Maybe P.ModuleName)
deriving (Import -> Import -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import -> Import -> Bool
$c/= :: Import -> Import -> Bool
== :: Import -> Import -> Bool
$c== :: Import -> Import -> Bool
Eq, Int -> Import -> ShowS
[Import] -> ShowS
Import -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Import] -> ShowS
$cshowList :: [Import] -> ShowS
show :: Import -> String
$cshow :: Import -> String
showsPrec :: Int -> Import -> ShowS
$cshowsPrec :: Int -> Import -> ShowS
Show)
parseImportsFromFile
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> m (P.ModuleName, [(P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)])
parseImportsFromFile :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String
-> m (ModuleName,
[(ModuleName, ImportDeclarationType, Maybe ModuleName)])
parseImportsFromFile String
file = do
(ModuleName
mn, [Text]
_, [Import]
imports, [Text]
_) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' String
file
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
mn, Import -> (ModuleName, ImportDeclarationType, Maybe ModuleName)
unwrapImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Import]
imports)
where
unwrapImport :: Import -> (ModuleName, ImportDeclarationType, Maybe ModuleName)
unwrapImport (Import ModuleName
a ImportDeclarationType
b Maybe ModuleName
c) = (ModuleName
a, ImportDeclarationType
b, Maybe ModuleName
c)
parseImportsFromFile'
:: (MonadIO m, MonadError IdeError m)
=> FilePath
-> m (P.ModuleName, [Text], [Import], [Text])
parseImportsFromFile' :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (ModuleName, [Text], [Import], [Text])
parseImportsFromFile' String
fp = do
(String
_, Text
file) <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (String, Text)
ideReadFile String
fp
case [Text] -> Either Text (ModuleName, [Text], [Import], [Text])
sliceImportSection (Text -> [Text]
T.lines Text
file) of
Right (ModuleName, [Text], [Import], [Text])
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName, [Text], [Import], [Text])
res
Left Text
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
GeneralError Text
err)
data ImportParse = ImportParse
{ ImportParse -> ModuleName
ipModuleName :: P.ModuleName
, ImportParse -> SourcePos
ipStart :: P.SourcePos
, ImportParse -> SourcePos
ipEnd :: P.SourcePos
, ImportParse -> [Import]
ipImports :: [Import]
}
parseModuleHeader :: Text -> Either (NE.NonEmpty CST.ParserError) ImportParse
Text
src = do
CST.PartialResult Module ()
md ([ParserWarning], Either (NonEmpty ParserError) (Module ()))
_ <- [LexResult]
-> Either (NonEmpty ParserError) (PartialResult (Module ()))
CST.parseModule forall a b. (a -> b) -> a -> b
$ [LexResult] -> [LexResult]
CST.lenient forall a b. (a -> b) -> a -> b
$ Text -> [LexResult]
CST.lexModule Text
src
let
mn :: ModuleName
mn = forall a. Name a -> a
CST.nameValue forall a b. (a -> b) -> a -> b
$ forall a. Module a -> Name ModuleName
CST.modNamespace Module ()
md
decls :: [(SourceSpan, Import)]
decls = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Module a -> [ImportDecl a]
CST.modImports Module ()
md) forall a b. (a -> b) -> a -> b
$ \ImportDecl ()
decl -> do
let ((SourceSpan
ss, [Comment]
_), ModuleName
mn', ImportDeclarationType
it, Maybe ModuleName
qual) = forall a.
String
-> ImportDecl a
-> (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
CST.convertImportDecl String
"<purs-ide>" ImportDecl ()
decl
(SourceSpan
ss, ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Import
Import ModuleName
mn' ImportDeclarationType
it Maybe ModuleName
qual)
case (forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [(SourceSpan, Import)]
decls, forall a. [a] -> Maybe a
lastMay [(SourceSpan, Import)]
decls) of
(Just (SourceSpan, Import)
hd, Just (SourceSpan, Import)
ls) -> do
let
ipStart :: SourcePos
ipStart = SourceSpan -> SourcePos
P.spanStart forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (SourceSpan, Import)
hd
ipEnd :: SourcePos
ipEnd = SourceSpan -> SourcePos
P.spanEnd forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (SourceSpan, Import)
ls
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ModuleName -> SourcePos -> SourcePos -> [Import] -> ImportParse
ImportParse ModuleName
mn SourcePos
ipStart SourcePos
ipEnd forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceSpan, Import)]
decls
(Maybe (SourceSpan, Import), Maybe (SourceSpan, Import))
_ -> do
let pos :: SourcePos
pos = SourcePos -> SourcePos
CST.sourcePos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRange -> SourcePos
CST.srcEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenAnn -> SourceRange
CST.tokRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceToken -> TokenAnn
CST.tokAnn forall a b. (a -> b) -> a -> b
$ forall a. Module a -> SourceToken
CST.modWhere Module ()
md
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ModuleName -> SourcePos -> SourcePos -> [Import] -> ImportParse
ImportParse ModuleName
mn SourcePos
pos SourcePos
pos []
sliceImportSection :: [Text] -> Either Text (P.ModuleName, [Text], [Import], [Text])
sliceImportSection :: [Text] -> Either Text (ModuleName, [Text], [Import], [Text])
sliceImportSection [Text]
fileLines = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserError -> String
CST.prettyPrintError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head) forall a b. (a -> b) -> a -> b
$ do
ImportParse{[Import]
SourcePos
ModuleName
ipImports :: [Import]
ipEnd :: SourcePos
ipStart :: SourcePos
ipModuleName :: ModuleName
ipImports :: ImportParse -> [Import]
ipEnd :: ImportParse -> SourcePos
ipStart :: ImportParse -> SourcePos
ipModuleName :: ImportParse -> ModuleName
..} <- Text -> Either (NonEmpty ParserError) ImportParse
parseModuleHeader Text
file
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( ModuleName
ipModuleName
, SourcePos -> SourcePos -> [Text]
sliceFile (Int -> Int -> SourcePos
P.SourcePos Int
1 Int
1) (SourcePos -> SourcePos
prevPos SourcePos
ipStart)
, [Import]
ipImports
, forall a. Int -> [a] -> [a]
drop Int
1 (SourcePos -> SourcePos -> [Text]
sliceFile (SourcePos -> SourcePos
nextPos SourcePos
ipEnd) (Int -> Int -> SourcePos
P.SourcePos (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
fileLines) (Int -> Int
lineLength (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
fileLines))))
)
where
prevPos :: SourcePos -> SourcePos
prevPos (P.SourcePos Int
l Int
c)
| Int
l forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
c forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> Int -> SourcePos
P.SourcePos Int
l Int
c
| Int
c forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> Int -> SourcePos
P.SourcePos (Int
l forall a. Num a => a -> a -> a
- Int
1) (Int -> Int
lineLength (Int
l forall a. Num a => a -> a -> a
- Int
1))
| Bool
otherwise = Int -> Int -> SourcePos
P.SourcePos Int
l (Int
c forall a. Num a => a -> a -> a
- Int
1)
nextPos :: SourcePos -> SourcePos
nextPos (P.SourcePos Int
l Int
c)
| Int
c forall a. Eq a => a -> a -> Bool
== Int -> Int
lineLength Int
l = Int -> Int -> SourcePos
P.SourcePos (Int
l forall a. Num a => a -> a -> a
+ Int
1) Int
1
| Bool
otherwise = Int -> Int -> SourcePos
P.SourcePos Int
l (Int
c forall a. Num a => a -> a -> a
+ Int
1)
file :: Text
file = [Text] -> Text
T.unlines [Text]
fileLines
lineLength :: Int -> Int
lineLength Int
l = Text -> Int
T.length ([Text]
fileLines forall s a. s -> Getting a s a -> a
^. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
l forall a. Num a => a -> a -> a
- Int
1))
sliceFile :: SourcePos -> SourcePos -> [Text]
sliceFile (P.SourcePos Int
l1 Int
c1) (P.SourcePos Int
l2 Int
c2) =
[Text]
fileLines
forall a b. a -> (a -> b) -> b
& forall a. Int -> [a] -> [a]
drop (Int
l1 forall a. Num a => a -> a -> a
- Int
1)
forall a b. a -> (a -> b) -> b
& forall a. Int -> [a] -> [a]
take (Int
l2 forall a. Num a => a -> a -> a
- Int
l1 forall a. Num a => a -> a -> a
+ Int
1)
forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Text -> Text
T.drop (Int
c1 forall a. Num a => a -> a -> a
- Int
1)
forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
l2 forall a. Num a => a -> a -> a
- Int
l1) forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Text -> Text
T.take Int
c2
prettyPrintImport' :: Import -> Text
prettyPrintImport' :: Import -> Text
prettyPrintImport' (Import ModuleName
mn ImportDeclarationType
idt Maybe ModuleName
qual) =
Text
"import " forall a. Semigroup a => a -> a -> a
<> ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Text
P.prettyPrintImport ModuleName
mn ImportDeclarationType
idt Maybe ModuleName
qual
prettyPrintImportSection :: [Import] -> [Text]
prettyPrintImportSection :: [Import] -> [Text]
prettyPrintImportSection [Import]
imports =
let
([Import]
implicitImports, [Import]
explicitImports) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Import -> Bool
isImplicitImport [Import]
imports
in
forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Import -> Text
prettyPrintImport' [Import]
implicitImports)
forall a. Semigroup a => a -> a -> a
<> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Import]
explicitImports Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Import]
implicitImports)) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"")
forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Import -> Text
prettyPrintImport' [Import]
explicitImports)
where
isImplicitImport :: Import -> Bool
isImplicitImport :: Import -> Bool
isImplicitImport Import
i = case Import
i of
Import ModuleName
_ ImportDeclarationType
P.Implicit Maybe ModuleName
Nothing -> Bool
True
Import ModuleName
_ (P.Hiding [DeclarationRef]
_) Maybe ModuleName
Nothing -> Bool
True
Import
_ -> Bool
False
parseImport :: Text -> Maybe Import
parseImport :: Text -> Maybe Import
parseImport Text
t =
case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a.
String
-> ImportDecl a
-> (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
CST.convertImportDecl String
"<purs-ide>" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
forall a b. (a -> b) -> a -> b
$ forall a.
Parser a
-> [LexResult]
-> Either (NonEmpty ParserError) ([ParserWarning], a)
CST.runTokenParser Parser (ImportDecl ())
CST.parseImportDeclP
forall a b. (a -> b) -> a -> b
$ Text -> [LexResult]
CST.lex Text
t of
Right (SourceAnn
_, ModuleName
mn, ImportDeclarationType
idt, Maybe ModuleName
mmn) ->
forall a. a -> Maybe a
Just (ModuleName -> ImportDeclarationType -> Maybe ModuleName -> Import
Import ModuleName
mn ImportDeclarationType
idt Maybe ModuleName
mmn)
Either
(NonEmpty ParserError)
(SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
_ -> forall a. Maybe a
Nothing