module HieFile
  ( Counters
  , getCounters
  , hieFileToCounters
  , mkNameCache
  ) where

import           Control.Exception (onException)
import           Control.Monad.State
import           Data.Bifunctor
import qualified Data.ByteString.Char8 as BS
import           Data.Maybe
import           Data.Monoid
import           System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, doesPathExist, listDirectory, withCurrentDirectory)
import           System.Environment (lookupEnv)
import           System.FilePath (isExtensionOf)

import           DynFlags (DynFlags)
import           HieBin
import           HieTypes
import           HieUtils
import           NameCache
import           UniqSupply (mkSplitUniqSupply)

import           DefCounts.ProcessHie
import           MatchSigs.ProcessHie
import           UseCounts.ProcessHie
import           Utils

type Counters = ( DefCounter
                , UsageCounter
                , SigMap
                , Sum Int -- total num lines
                )

getCounters :: DynFlags -> IO Counters
getCounters :: DynFlags -> IO Counters
getCounters DynFlags
dynFlags =
  (HieFile -> Counters) -> [HieFile] -> Counters
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (DynFlags -> HieFile -> Counters
hieFileToCounters DynFlags
dynFlags) ([HieFile] -> Counters) -> IO [HieFile] -> IO Counters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [HieFile]
getHieFiles

hieFileToCounters :: DynFlags
                  -> HieFile
                  -> Counters
hieFileToCounters :: DynFlags -> HieFile -> Counters
hieFileToCounters DynFlags
dynFlags HieFile
hieFile =
  let hies :: HieASTs TypeIndex
hies = HieFile -> HieASTs TypeIndex
hie_asts HieFile
hieFile
      asts :: Map FastString (HieAST TypeIndex)
asts = HieASTs TypeIndex -> Map FastString (HieAST TypeIndex)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts HieASTs TypeIndex
hies
      types :: Array TypeIndex HieTypeFlat
types = HieFile -> Array TypeIndex HieTypeFlat
hie_types HieFile
hieFile
      fullHies :: HieASTs HieTypeFix
fullHies = (TypeIndex -> Array TypeIndex HieTypeFlat -> HieTypeFix)
-> Array TypeIndex HieTypeFlat -> TypeIndex -> HieTypeFix
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeIndex -> Array TypeIndex HieTypeFlat -> HieTypeFix
recoverFullType Array TypeIndex HieTypeFlat
types (TypeIndex -> HieTypeFix)
-> HieASTs TypeIndex -> HieASTs HieTypeFix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieASTs TypeIndex
hies

   in ( (HieAST TypeIndex -> DefCounter)
-> Map FastString (HieAST TypeIndex) -> DefCounter
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((HieAST TypeIndex -> DefCounter) -> HieAST TypeIndex -> DefCounter
forall m a. Monoid m => (HieAST a -> m) -> HieAST a -> m
foldNodeChildren HieAST TypeIndex -> DefCounter
forall a. HieAST a -> DefCounter
declLines) Map FastString (HieAST TypeIndex)
asts
      , (HieAST TypeIndex -> UsageCounter)
-> Map FastString (HieAST TypeIndex) -> UsageCounter
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((HieAST TypeIndex -> UsageCounter)
-> HieAST TypeIndex -> UsageCounter
forall m a. Monoid m => (HieAST a -> m) -> HieAST a -> m
foldNodeChildren HieAST TypeIndex -> UsageCounter
forall a. HieAST a -> UsageCounter
usageCounter) Map FastString (HieAST TypeIndex)
asts
      , (HieAST HieTypeFix -> SigMap)
-> Map FastString (HieAST HieTypeFix) -> SigMap
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (DynFlags -> HieAST HieTypeFix -> SigMap
mkSigMap DynFlags
dynFlags) (Map FastString (HieAST HieTypeFix) -> SigMap)
-> Map FastString (HieAST HieTypeFix) -> SigMap
forall a b. (a -> b) -> a -> b
$ HieASTs HieTypeFix -> Map FastString (HieAST HieTypeFix)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts HieASTs HieTypeFix
fullHies
      , TypeIndex -> Sum TypeIndex
forall a. a -> Sum a
Sum (TypeIndex -> Sum TypeIndex)
-> (ByteString -> TypeIndex) -> ByteString -> Sum TypeIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> TypeIndex
forall (t :: * -> *) a. Foldable t => t a -> TypeIndex
length ([ByteString] -> TypeIndex)
-> (ByteString -> [ByteString]) -> ByteString -> TypeIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines (ByteString -> Sum TypeIndex) -> ByteString -> Sum TypeIndex
forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hieFile
      )

getHieFiles :: IO [HieFile]
getHieFiles :: IO [HieFile]
getHieFiles = do
  [Char]
hieDir <- [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
".hie" (Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"HIE_DIR"
  let notPathsFile :: [Char] -> Bool
notPathsFile = ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"Paths_") ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeIndex -> [Char] -> [Char]
forall a. TypeIndex -> [a] -> [a]
take TypeIndex
6
  [[Char]]
filePaths <- ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
notPathsFile ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
getHieFilesIn [Char]
hieDir
    IO [[Char]] -> IO Any -> IO [[Char]]
forall a b. IO a -> IO b -> IO a
`onException` [Char] -> IO Any
forall a. HasCallStack => [Char] -> a
error [Char]
"HIE file directory does not exist"
  NameCache
nameCache <- IO NameCache
mkNameCache
  StateT NameCache IO [HieFile] -> NameCache -> IO [HieFile]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (([Char] -> StateT NameCache IO HieFile)
-> [[Char]] -> StateT NameCache IO [HieFile]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Char] -> StateT NameCache IO HieFile
getHieFile [[Char]]
filePaths) NameCache
nameCache

getHieFile :: FilePath -> StateT NameCache IO HieFile
getHieFile :: [Char] -> StateT NameCache IO HieFile
getHieFile [Char]
filePath = (NameCache -> IO (HieFile, NameCache))
-> StateT NameCache IO HieFile
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((NameCache -> IO (HieFile, NameCache))
 -> StateT NameCache IO HieFile)
-> (NameCache -> IO (HieFile, NameCache))
-> StateT NameCache IO HieFile
forall a b. (a -> b) -> a -> b
$ \NameCache
nameCache ->
  (HieFileResult -> HieFile)
-> (HieFileResult, NameCache) -> (HieFile, NameCache)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HieFileResult -> HieFile
hie_file_result ((HieFileResult, NameCache) -> (HieFile, NameCache))
-> IO (HieFileResult, NameCache) -> IO (HieFile, NameCache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameCache -> [Char] -> IO (HieFileResult, NameCache)
readHieFile NameCache
nameCache [Char]
filePath

mkNameCache :: IO NameCache
mkNameCache :: IO NameCache
mkNameCache = do
  UniqSupply
uniqueSupply <- Char -> IO UniqSupply
mkSplitUniqSupply Char
'z'
  NameCache -> IO NameCache
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NameCache -> IO NameCache) -> NameCache -> IO NameCache
forall a b. (a -> b) -> a -> b
$ UniqSupply -> [Name] -> NameCache
initNameCache UniqSupply
uniqueSupply []

-- | Recursively search for .hie files in given directory
getHieFilesIn :: FilePath -> IO [FilePath]
-- ignore Paths_* files generated by cabal
getHieFilesIn :: [Char] -> IO [[Char]]
getHieFilesIn [Char]
path | TypeIndex -> [Char] -> [Char]
forall a. TypeIndex -> [a] -> [a]
take TypeIndex
6 [Char]
path [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Paths_" = [[Char]] -> IO [[Char]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getHieFilesIn [Char]
path = do
  Bool
exists <-
    [Char] -> IO Bool
doesPathExist [Char]
path

  if Bool
exists
    then do
      Bool
isFile <- [Char] -> IO Bool
doesFileExist [Char]
path
      if Bool
isFile Bool -> Bool -> Bool
&& [Char]
"hie" [Char] -> [Char] -> Bool
`isExtensionOf` [Char]
path
        then do
          [Char]
path' <- [Char] -> IO [Char]
canonicalizePath [Char]
path
          [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]
path']
        else do
          Bool
isDir <-
            [Char] -> IO Bool
doesDirectoryExist [Char]
path
          if Bool
isDir
            then do
              [[Char]]
cnts <-
                [Char] -> IO [[Char]]
listDirectory [Char]
path
              [Char] -> IO [[Char]] -> IO [[Char]]
forall a. [Char] -> IO a -> IO a
withCurrentDirectory [Char]
path (([Char] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Char] -> IO [[Char]]
getHieFilesIn [[Char]]
cnts)
            else
              [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else
      [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []