{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
module Hpack.Module (
  Module(..)
, toModule
, getModules
#ifdef TEST
, getModuleFilesRecursive
#endif
) where

import           Imports

import           System.FilePath
import qualified System.Directory as Directory

import           Data.Aeson.Config.FromValue
import           Hpack.Util
import           Hpack.Haskell

import           Path (Path(..), PathComponent(..))
import qualified Path

newtype Module = Module {Module -> String
unModule :: String}
  deriving (Module -> Module -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c== :: Module -> Module -> Bool
Eq, Eq Module
Module -> Module -> Bool
Module -> Module -> Ordering
Module -> Module -> Module
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Module -> Module -> Module
$cmin :: Module -> Module -> Module
max :: Module -> Module -> Module
$cmax :: Module -> Module -> Module
>= :: Module -> Module -> Bool
$c>= :: Module -> Module -> Bool
> :: Module -> Module -> Bool
$c> :: Module -> Module -> Bool
<= :: Module -> Module -> Bool
$c<= :: Module -> Module -> Bool
< :: Module -> Module -> Bool
$c< :: Module -> Module -> Bool
compare :: Module -> Module -> Ordering
$ccompare :: Module -> Module -> Ordering
Ord)

instance Show Module where
  show :: Module -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> String
unModule

instance IsString Module where
  fromString :: String -> Module
fromString = String -> Module
Module

instance FromValue Module where
  fromValue :: Value -> Parser Module
fromValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Module
Module forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromValue a => Value -> Parser a
fromValue

toModule :: Path -> Module
toModule :: Path -> Module
toModule Path
path = case forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Path -> [String]
Path.components Path
path of
  [] -> String -> Module
Module String
""
  String
file : [String]
dirs -> String -> Module
Module forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
file forall a. a -> [a] -> [a]
: [String]
dirs

getModules :: FilePath -> FilePath -> IO [Module]
getModules :: String -> String -> IO [Module]
getModules String
dir String
literalSrc = [Module] -> [Module]
sortModules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Bool
exists <- String -> IO Bool
Directory.doesDirectoryExist (String
dir String -> String -> String
</> String
literalSrc)
  if Bool
exists
    then do
      String
canonicalSrc <- String -> IO String
Directory.canonicalizePath (String
dir String -> String -> String
</> String
literalSrc)

      let
        srcIsProjectRoot :: Bool
        srcIsProjectRoot :: Bool
srcIsProjectRoot = String
canonicalSrc forall a. Eq a => a -> a -> Bool
== String
dir

        toModules :: [Path] -> [Module]
        toModules :: [Path] -> [Module]
toModules = [Module] -> [Module]
removeSetup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Path -> Module
toModule

        removeSetup :: [Module] -> [Module]
        removeSetup :: [Module] -> [Module]
removeSetup
          | Bool
srcIsProjectRoot = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Module
"Setup")
          | Bool
otherwise = forall a. a -> a
id

      [Path] -> [Module]
toModules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [Path]
getModuleFilesRecursive String
canonicalSrc
    else forall (m :: * -> *) a. Monad m => a -> m a
return []

sortModules :: [Module] -> [Module]
sortModules :: [Module] -> [Module]
sortModules = forall a b. (a -> b) -> [a] -> [b]
map String -> Module
Module forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Module -> String
unModule

isSourceFile :: PathComponent -> Bool
isSourceFile :: PathComponent -> Bool
isSourceFile (String -> (String, String)
splitExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathComponent -> String
unPathComponent -> (String
name, String
ext)) = String
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
extensions Bool -> Bool -> Bool
&& String -> Bool
isModuleNameComponent String
name
  where
    extensions :: [String]
    extensions :: [String]
extensions = [
        String
".hs"
      , String
".lhs"
      , String
".chs"
      , String
".hsc"
      , String
".y"
      , String
".ly"
      , String
".x"
      ]

isModuleComponent :: PathComponent -> Bool
isModuleComponent :: PathComponent -> Bool
isModuleComponent = String -> Bool
isModuleNameComponent forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathComponent -> String
unPathComponent

getModuleFilesRecursive :: FilePath -> IO [Path]
getModuleFilesRecursive :: String -> IO [Path]
getModuleFilesRecursive String
baseDir = Path -> IO [Path]
go ([PathComponent] -> Path
Path [])
  where
    addBaseDir :: Path -> FilePath
    addBaseDir :: Path -> String
addBaseDir = (String
baseDir String -> String -> String
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> String
Path.toFilePath

    listDirectory :: Path -> IO [PathComponent]
    listDirectory :: Path -> IO [PathComponent]
listDirectory = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map String -> PathComponent
PathComponent) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
Directory.listDirectory forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> String
addBaseDir

    doesFileExist :: Path -> IO Bool
    doesFileExist :: Path -> IO Bool
doesFileExist = String -> IO Bool
Directory.doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> String
addBaseDir

    doesDirectoryExist :: Path -> IO Bool
    doesDirectoryExist :: Path -> IO Bool
doesDirectoryExist = String -> IO Bool
Directory.doesDirectoryExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> String
addBaseDir

    go :: Path -> IO [Path]
    go :: Path -> IO [Path]
go Path
dir = do
      [PathComponent]
entries <- Path -> IO [PathComponent]
listDirectory Path
dir

      [Path]
files       <- (Path -> IO Bool) -> [PathComponent] -> IO [Path]
filterWith Path -> IO Bool
doesFileExist      (forall a. (a -> Bool) -> [a] -> [a]
filter PathComponent -> Bool
isSourceFile      [PathComponent]
entries)
      [Path]
directories <- (Path -> IO Bool) -> [PathComponent] -> IO [Path]
filterWith Path -> IO Bool
doesDirectoryExist (forall a. (a -> Bool) -> [a] -> [a]
filter PathComponent -> Bool
isModuleComponent [PathComponent]
entries)

      [Path]
subdirsFiles  <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Path -> IO [Path]
go [Path]
directories
      forall (m :: * -> *) a. Monad m => a -> m a
return ([Path]
files forall a. [a] -> [a] -> [a]
++ [Path]
subdirsFiles)
      where
        filterWith :: (Path -> IO Bool) -> [PathComponent] -> IO [Path]
        filterWith :: (Path -> IO Bool) -> [PathComponent] -> IO [Path]
filterWith Path -> IO Bool
p = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Path -> IO Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PathComponent -> Path
addDir

        addDir :: PathComponent -> Path
        addDir :: PathComponent -> Path
addDir PathComponent
entry = [PathComponent] -> Path
Path (Path -> [PathComponent]
unPath Path
dir forall a. [a] -> [a] -> [a]
++ [PathComponent
entry])