module Stan.Hie
( readHieFiles
, countLinesOfCode
, eqAst
, slice
) where
import Colourista (errorMessage, infoMessage, warningMessage)
import Prelude hiding (span)
import System.Directory (doesDirectoryExist, doesFileExist)
import System.Directory.Recursive (getDirRecursive)
import System.FilePath (takeExtension)
import Stan.Core.List (checkWith)
import Stan.Ghc.Compat (RealSrcSpan, srcSpanEndCol, srcSpanStartCol, srcSpanStartLine)
import Stan.Hie.Compat (HieAST (..), HieFile (..), HieFileResult (hie_file_result),
NodeInfo (..), readHieFileWithNameCache, nodeInfo,
toNodeAnnotation)
import Stan.Hie.Debug ()
import Stan.Pattern.Ast (literalAnns)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Set as Set
readHieFiles :: FilePath -> IO [HieFile]
readHieFiles :: FilePath -> IO [HieFile]
readHieFiles FilePath
hieDir = do
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
doesDirectoryExist FilePath
hieDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Directory with HIE files doesn't exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
hieDir
Text -> IO ()
infoMessage Text
"Use the '--hiedir' CLI option to specify path to the directory with HIE files"
IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
FilePath -> IO HieFileResult
readHieFile <- IO (FilePath -> IO HieFileResult)
readHieFileWithNameCache
[FilePath]
hieContent <- FilePath -> IO [FilePath]
getDirRecursive FilePath
hieDir
let isHieFile :: FilePath -> IO Bool
isHieFile FilePath
f = Bool -> Bool -> Bool
(&&) (FilePath -> FilePath
takeExtension FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".hie") (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist FilePath
f
[FilePath]
hiePaths <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
isHieFile [FilePath]
hieContent
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
hiePaths) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
warningMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
Text
"The directory with HIE files doesn't contain any HIE files: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
hieDir
[FilePath] -> (FilePath -> IO HieFile) -> IO [HieFile]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
hiePaths ((FilePath -> IO HieFile) -> IO [HieFile])
-> (FilePath -> IO HieFile) -> IO [HieFile]
forall a b. (a -> b) -> a -> b
$ \FilePath
hiePath -> do
HieFileResult
hieFileResult <- FilePath -> IO HieFileResult
readHieFile FilePath
hiePath
HieFile -> IO HieFile
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HieFile -> IO HieFile) -> HieFile -> IO HieFile
forall a b. (a -> b) -> a -> b
$ HieFileResult -> HieFile
hie_file_result HieFileResult
hieFileResult
countLinesOfCode :: HieFile -> Int
countLinesOfCode :: HieFile -> Int
countLinesOfCode HieFile{FilePath
[AvailInfo]
ByteString
Array Int HieTypeFlat
Module
HieASTs Int
hie_hs_file :: FilePath
hie_module :: Module
hie_types :: Array Int HieTypeFlat
hie_asts :: HieASTs Int
hie_exports :: [AvailInfo]
hie_hs_src :: ByteString
hie_hs_file :: HieFile -> FilePath
hie_module :: HieFile -> Module
hie_types :: HieFile -> Array Int HieTypeFlat
hie_asts :: HieFile -> HieASTs Int
hie_exports :: HieFile -> [AvailInfo]
hie_hs_src :: HieFile -> ByteString
..} = [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ByteString] -> Int) -> [ByteString] -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS8.lines ByteString
hie_hs_src
slice :: RealSrcSpan -> ByteString -> Maybe ByteString
slice :: RealSrcSpan -> ByteString -> Maybe ByteString
slice RealSrcSpan
span =
(ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( Int -> ByteString -> ByteString
BS.take (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
span)
(ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop (RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
)
(Maybe ByteString -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Int -> Maybe ByteString)
-> Int -> [ByteString] -> Maybe ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip [ByteString] -> Int -> Maybe ByteString
forall a. [a] -> Int -> Maybe a
(!!?) (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
([ByteString] -> Maybe ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS8.lines
eqAst :: forall a . Ord a => HieFile -> HieAST a -> HieAST a -> Bool
eqAst :: forall a. Ord a => HieFile -> HieAST a -> HieAST a -> Bool
eqAst HieFile{FilePath
[AvailInfo]
ByteString
Array Int HieTypeFlat
Module
HieASTs Int
hie_hs_file :: HieFile -> FilePath
hie_module :: HieFile -> Module
hie_types :: HieFile -> Array Int HieTypeFlat
hie_asts :: HieFile -> HieASTs Int
hie_exports :: HieFile -> [AvailInfo]
hie_hs_src :: HieFile -> ByteString
hie_hs_file :: FilePath
hie_module :: Module
hie_types :: Array Int HieTypeFlat
hie_asts :: HieASTs Int
hie_exports :: [AvailInfo]
hie_hs_src :: ByteString
..} = HieAST a -> HieAST a -> Bool
eqNodes
where
eqNodes :: HieAST a -> HieAST a -> Bool
eqNodes :: HieAST a -> HieAST a -> Bool
eqNodes n1 :: HieAST a
n1@(Node SourcedNodeInfo a
_ RealSrcSpan
span1 [HieAST a]
children1) n2 :: HieAST a
n2@(Node SourcedNodeInfo a
_ RealSrcSpan
span2 [HieAST a]
children2) =
NodeInfo a -> NodeInfo a -> Bool
eqInfo NodeInfo a
info1 NodeInfo a
info2 Bool -> Bool -> Bool
&& (HieAST a -> HieAST a -> Bool) -> [HieAST a] -> [HieAST a] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
checkWith HieAST a -> HieAST a -> Bool
eqNodes [HieAST a]
children1 [HieAST a]
children2
where
info1 :: NodeInfo a
info1 = HieAST a -> NodeInfo a
forall a. Ord a => HieAST a -> NodeInfo a
nodeInfo HieAST a
n1
info2 :: NodeInfo a
info2 = HieAST a -> NodeInfo a
forall a. Ord a => HieAST a -> NodeInfo a
nodeInfo HieAST a
n2
eqInfo :: NodeInfo a -> NodeInfo a -> Bool
eqInfo :: NodeInfo a -> NodeInfo a -> Bool
eqInfo (NodeInfo Set NodeAnnotation
anns1 [a]
types1 NodeIdentifiers a
ids1) (NodeInfo Set NodeAnnotation
anns2 [a]
types2 NodeIdentifiers a
ids2) =
Set NodeAnnotation
anns1 Set NodeAnnotation -> Set NodeAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== Set NodeAnnotation
anns2 Bool -> Bool -> Bool
&& [a]
types1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
types2 Bool -> Bool -> Bool
&& NodeIdentifiers a
ids1 NodeIdentifiers a -> NodeIdentifiers a -> Bool
forall a. Eq a => a -> a -> Bool
== NodeIdentifiers a
ids2 Bool -> Bool -> Bool
&&
if NodeAnnotation -> Set NodeAnnotation -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member NodeAnnotation
literalAnns ((NodeAnnotation -> NodeAnnotation)
-> Set NodeAnnotation -> Set NodeAnnotation
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map NodeAnnotation -> NodeAnnotation
toNodeAnnotation Set NodeAnnotation
anns1)
then RealSrcSpan -> ByteString -> Maybe ByteString
slice RealSrcSpan
span1 ByteString
hie_hs_src Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> ByteString -> Maybe ByteString
slice RealSrcSpan
span2 ByteString
hie_hs_src
else Bool
True