-----------------------------------------------------------------------------
--
-- Module      : Language.PureScript.Ide.Imports
-- Description : Provides functionality to manage imports
-- Copyright   : Christoph Hegemann 2016
-- License     : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>
-- Stability   : experimental
--
-- |
-- Provides functionality to manage imports
-----------------------------------------------------------------------------

module Language.PureScript.Ide.Imports
       ( parseImportsFromFile
       , parseImportsFromFile'
         -- for tests
       , 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)

-- | Reads a file and returns the parsed module name as well as the parsed
-- imports, while ignoring eventual parse errors that aren't relevant to the
-- import section
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)

-- | Reads a file and returns the (lines before the imports, the imports, the
-- lines after the imports)
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)

-- | @ImportParse@ holds the data we extract out of a partial parse of the
-- sourcefile
data ImportParse = ImportParse
  { ImportParse -> ModuleName
ipModuleName :: P.ModuleName
  -- ^ the module name we parse
  , ImportParse -> SourcePos
ipStart :: P.SourcePos
  -- ^ the beginning of the import section. If `import Prelude` was the first
  -- import, this would point at `i`
  , ImportParse -> SourcePos
ipEnd :: P.SourcePos
  -- ^ the end of the import section
  , ImportParse -> [Import]
ipImports :: [Import]
  -- ^ the extracted import declarations
  }

parseModuleHeader :: Text -> Either (NE.NonEmpty CST.ParserError) ImportParse
parseModuleHeader :: Text -> Either (NonEmpty ParserError) ImportParse
parseModuleHeader 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
    -- Not sure why I need to drop 1 here, but it makes the tests pass
    , 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)
      -- Only add the extra spacing if both implicit as well as
      -- explicit/qualified imports exist
      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

-- | Test and ghci helper
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