module Language.PureScript.Ide.Util
( identifierFromIdeDeclaration
, unwrapMatch
, namespaceForDeclaration
, encodeT
, decodeT
, discardAnn
, withEmptyAnn
, valueOperatorAliasT
, typeOperatorAliasT
, properNameT
, identT
, opNameT
, ideReadFile
, module Language.PureScript.Ide.Logging
) where
import Protolude hiding (decodeUtf8,
encodeUtf8, to)
import Control.Lens (Getting, to, (^.))
import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding as TLE
import Language.PureScript qualified as P
import Language.PureScript.Ide.Error (IdeError(..))
import Language.PureScript.Ide.Logging
import Language.PureScript.Ide.Types (IdeDeclaration(..), IdeDeclarationAnn(..), IdeNamespace(..), Match(..), emptyAnn, ideDtorName, ideSynonymName, ideTCName, ideTypeName, ideTypeOpName, ideValueIdent, ideValueOpName)
import System.IO.UTF8 (readUTF8FileT)
import System.Directory (makeAbsolute)
identifierFromIdeDeclaration :: IdeDeclaration -> Text
identifierFromIdeDeclaration :: IdeDeclaration -> Text
identifierFromIdeDeclaration IdeDeclaration
d = case IdeDeclaration
d of
IdeDeclValue IdeValue
v -> IdeValue
v forall s a. s -> Getting a s a -> a
^. Lens' IdeValue Ident
ideValueIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Getting r Ident Text
identT
IdeDeclType IdeType
t -> IdeType
t forall s a. s -> Getting a s a -> a
^. Lens' IdeType (ProperName 'TypeName)
ideTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT
IdeDeclTypeSynonym IdeTypeSynonym
s -> IdeTypeSynonym
s forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeSynonym (ProperName 'TypeName)
ideSynonymName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT
IdeDeclDataConstructor IdeDataConstructor
dtor -> IdeDataConstructor
dtor forall s a. s -> Getting a s a -> a
^. Lens' IdeDataConstructor (ProperName 'ConstructorName)
ideDtorName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT
IdeDeclTypeClass IdeTypeClass
tc -> IdeTypeClass
tc forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeClass (ProperName 'ClassName)
ideTCName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT
IdeDeclValueOperator IdeValueOperator
op -> IdeValueOperator
op forall s a. s -> Getting a s a -> a
^. Lens' IdeValueOperator (OpName 'ValueOpName)
ideValueOpName forall a b. a -> (a -> b) -> b
& forall (a :: OpNameType). OpName a -> Text
P.runOpName
IdeDeclTypeOperator IdeTypeOperator
op -> IdeTypeOperator
op forall s a. s -> Getting a s a -> a
^. Lens' IdeTypeOperator (OpName 'TypeOpName)
ideTypeOpName forall a b. a -> (a -> b) -> b
& forall (a :: OpNameType). OpName a -> Text
P.runOpName
IdeDeclModule ModuleName
name -> ModuleName -> Text
P.runModuleName ModuleName
name
namespaceForDeclaration :: IdeDeclaration -> IdeNamespace
namespaceForDeclaration :: IdeDeclaration -> IdeNamespace
namespaceForDeclaration IdeDeclaration
d = case IdeDeclaration
d of
IdeDeclValue IdeValue
_ -> IdeNamespace
IdeNSValue
IdeDeclType IdeType
_ -> IdeNamespace
IdeNSType
IdeDeclTypeSynonym IdeTypeSynonym
_ -> IdeNamespace
IdeNSType
IdeDeclDataConstructor IdeDataConstructor
_ -> IdeNamespace
IdeNSValue
IdeDeclTypeClass IdeTypeClass
_ -> IdeNamespace
IdeNSType
IdeDeclValueOperator IdeValueOperator
_ -> IdeNamespace
IdeNSValue
IdeDeclTypeOperator IdeTypeOperator
_ -> IdeNamespace
IdeNSType
IdeDeclModule ModuleName
_ -> IdeNamespace
IdeNSModule
discardAnn :: IdeDeclarationAnn -> IdeDeclaration
discardAnn :: IdeDeclarationAnn -> IdeDeclaration
discardAnn (IdeDeclarationAnn Annotation
_ IdeDeclaration
d) = IdeDeclaration
d
withEmptyAnn :: IdeDeclaration -> IdeDeclarationAnn
withEmptyAnn :: IdeDeclaration -> IdeDeclarationAnn
withEmptyAnn = Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn Annotation
emptyAnn
unwrapMatch :: Match a -> a
unwrapMatch :: forall a. Match a -> a
unwrapMatch (Match (ModuleName
_, a
ed)) = a
ed
valueOperatorAliasT
:: P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName)) -> Text
valueOperatorAliasT :: Qualified (Either Ident (ProperName 'ConstructorName)) -> Text
valueOperatorAliasT =
forall a. (a -> Text) -> Qualified a -> Text
P.showQualified forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Ident -> Text
P.runIdent forall (a :: ProperNameType). ProperName a -> Text
P.runProperName
typeOperatorAliasT
:: P.Qualified (P.ProperName 'P.TypeName) -> Text
typeOperatorAliasT :: Qualified (ProperName 'TypeName) -> Text
typeOperatorAliasT =
forall a. (a -> Text) -> Qualified a -> Text
P.showQualified forall (a :: ProperNameType). ProperName a -> Text
P.runProperName
encodeT :: (ToJSON a) => a -> Text
encodeT :: forall a. ToJSON a => a -> Text
encodeT = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TLE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode
decodeT :: (FromJSON a) => Text -> Either Text a
decodeT :: forall a. FromJSON a => Text -> Either Text a
decodeT = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
eitherDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
properNameT :: Getting r (P.ProperName a) Text
properNameT :: forall r (a :: ProperNameType). Getting r (ProperName a) Text
properNameT = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall (a :: ProperNameType). ProperName a -> Text
P.runProperName
identT :: Getting r P.Ident Text
identT :: forall r. Getting r Ident Text
identT = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Ident -> Text
P.runIdent
opNameT :: Getting r (P.OpName a) Text
opNameT :: forall r (a :: OpNameType). Getting r (OpName a) Text
opNameT = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall (a :: OpNameType). OpName a -> Text
P.runOpName
ideReadFile'
:: (MonadIO m, MonadError IdeError m)
=> (FilePath -> IO Text)
-> FilePath
-> m (FilePath, Text)
ideReadFile' :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
(String -> IO Text) -> String -> m (String, Text)
ideReadFile' String -> IO Text
fileReader String
fp = do
String
absPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO String
makeAbsolute String
fp)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (IOException
err :: IOException) ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(Text -> IdeError
GeneralError
(Text
"Couldn't resolve path for: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
fp forall a. Semigroup a => a -> a -> a
<> Text
", Error: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show IOException
err))
Right String
absPath -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
absPath
Text
contents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO Text
fileReader String
absPath)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (IOException
err :: IOException) ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(Text -> IdeError
GeneralError
(Text
"Couldn't find file at: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
absPath forall a. Semigroup a => a -> a -> a
<> Text
", Error: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show IOException
err))
Right Text
contents ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
contents
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
absPath, Text
contents)
ideReadFile :: (MonadIO m, MonadError IdeError m) => FilePath -> m (FilePath, Text)
ideReadFile :: forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
String -> m (String, Text)
ideReadFile = forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
(String -> IO Text) -> String -> m (String, Text)
ideReadFile' String -> IO Text
readUTF8FileT