    {-# 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
    (Module -> Module -> Bool)
    -> (Module -> Module -> Bool) -> Eq Module
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Module -> Module -> Bool
    == :: Module -> Module -> Bool
    $c/= :: Module -> Module -> Bool
    /= :: Module -> Module -> Bool
    Eq, Eq Module
    Eq Module =>
    (Module -> Module -> Ordering)
    -> (Module -> Module -> Bool)
    -> (Module -> Module -> Bool)
    -> (Module -> Module -> Bool)
    -> (Module -> Module -> Bool)
    -> (Module -> Module -> Module)
    -> (Module -> Module -> Module)
    -> Ord 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
    $ccompare :: Module -> Module -> Ordering
    compare :: Module -> Module -> Ordering
    $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
    >= :: Module -> Module -> Bool
    $cmax :: Module -> Module -> Module
    max :: Module -> Module -> Module
    $cmin :: Module -> Module -> Module
    min :: Module -> Module -> Module
    Ord)

    instance Show Module where
      show :: Module -> String
    show = String -> String
    forall a. Show a => a -> String
    show (String -> String) -> (Module -> String) -> Module -> String
    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 = (String -> Module) -> Parser String -> Parser Module
    forall a b. (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Module
    Module (Parser String -> Parser Module)
    -> (Value -> Parser String) -> Value -> Parser Module
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> Parser String
    forall a. FromValue a => Value -> Parser a
    fromValue

    toModule :: Path -> Module
    toModule :: Path -> Module
    toModule Path
    path = case [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String]) -> [String] -> [String]
    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 (String -> Module) -> ([String] -> String) -> [String] -> Module
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> Module) -> [String] -> Module
    forall a b. (a -> b) -> a -> b
    $ String -> String
    dropExtension String
    file String -> [String] -> [String]
    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 ([Module] -> [Module]) -> IO [Module] -> IO [Module]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
      exists <- String -> IO Bool
    Directory.doesDirectoryExist (String
    dir String -> String -> String
    </> String
    literalSrc)
      if exists
        then do
          canonicalSrc <- Directory.canonicalizePath (dir </> literalSrc)

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

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

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

          toModules <$> getModuleFilesRecursive canonicalSrc
        else return []

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

    isSourceFile :: PathComponent -> Bool
    isSourceFile :: PathComponent -> Bool
    isSourceFile (String -> (String, String)
    splitExtension (String -> (String, String))
    -> (PathComponent -> String) -> PathComponent -> (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PathComponent -> String
    unPathComponent -> (String
    name, String
    ext)) = String
    ext String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 (String -> Bool)
    -> (PathComponent -> String) -> PathComponent -> Bool
    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
    </>) (String -> String) -> (Path -> String) -> Path -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path -> String
    Path.toFilePath

        listDirectory :: Path -> IO [PathComponent]
        listDirectory :: Path -> IO [PathComponent]
    listDirectory = ([String] -> [PathComponent]) -> IO [String] -> IO [PathComponent]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((String -> PathComponent) -> [String] -> [PathComponent]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> PathComponent
    PathComponent) (IO [String] -> IO [PathComponent])
    -> (Path -> IO [String]) -> Path -> IO [PathComponent]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO [String]
    Directory.listDirectory (String -> IO [String]) -> (Path -> String) -> Path -> IO [String]
    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 (String -> IO Bool) -> (Path -> String) -> Path -> IO Bool
    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 (String -> IO Bool) -> (Path -> String) -> Path -> IO Bool
    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
          entries <- Path -> IO [PathComponent]
    listDirectory Path
    dir

          files       <- filterWith doesFileExist      (filter isSourceFile      entries)
          directories <- filterWith doesDirectoryExist (filter isModuleComponent entries)

          subdirsFiles  <- concat <$> mapM go directories
          return (files ++ subdirsFiles)
          where
            filterWith :: (Path -> IO Bool) -> [PathComponent] -> IO [Path]
            filterWith :: (Path -> IO Bool) -> [PathComponent] -> IO [Path]
    filterWith Path -> IO Bool
    p = (Path -> IO Bool) -> [Path] -> IO [Path]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM Path -> IO Bool
    p ([Path] -> IO [Path])
    -> ([PathComponent] -> [Path]) -> [PathComponent] -> IO [Path]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PathComponent -> Path) -> [PathComponent] -> [Path]
    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 [PathComponent] -> [PathComponent] -> [PathComponent]
    forall a. [a] -> [a] -> [a]
    ++ [PathComponent
    entry])