mirror of
https://github.com/sol/hpack.git
synced 2024-10-04 03:38:00 +03:00
Add newtype Module
This commit is contained in:
parent
fe9f61b9b2
commit
dec9c82836
@ -65,6 +65,7 @@ module Hpack.Config (
|
||||
, CcOption
|
||||
, LdOption
|
||||
, Path(..)
|
||||
, Module(..)
|
||||
#ifdef TEST
|
||||
, renameDependencies
|
||||
, Empty(..)
|
||||
@ -200,10 +201,10 @@ data CustomSetupSection = CustomSetupSection {
|
||||
data LibrarySection = LibrarySection {
|
||||
librarySectionExposed :: Maybe Bool
|
||||
, librarySectionVisibility :: Maybe String
|
||||
, librarySectionExposedModules :: Maybe (List String)
|
||||
, librarySectionGeneratedExposedModules :: Maybe (List String)
|
||||
, librarySectionOtherModules :: Maybe (List String)
|
||||
, librarySectionGeneratedOtherModules :: Maybe (List String)
|
||||
, librarySectionExposedModules :: Maybe (List Module)
|
||||
, librarySectionGeneratedExposedModules :: Maybe (List Module)
|
||||
, librarySectionOtherModules :: Maybe (List Module)
|
||||
, librarySectionGeneratedOtherModules :: Maybe (List Module)
|
||||
, librarySectionReexportedModules :: Maybe (List String)
|
||||
, librarySectionSignatures :: Maybe (List String)
|
||||
} deriving (Eq, Show, Generic, FromValue)
|
||||
@ -226,8 +227,8 @@ instance Semigroup LibrarySection where
|
||||
|
||||
data ExecutableSection = ExecutableSection {
|
||||
executableSectionMain :: Maybe FilePath
|
||||
, executableSectionOtherModules :: Maybe (List String)
|
||||
, executableSectionGeneratedOtherModules :: Maybe (List String)
|
||||
, executableSectionOtherModules :: Maybe (List Module)
|
||||
, executableSectionGeneratedOtherModules :: Maybe (List Module)
|
||||
} deriving (Eq, Show, Generic, FromValue)
|
||||
|
||||
instance Monoid ExecutableSection where
|
||||
@ -905,17 +906,17 @@ data CustomSetup = CustomSetup {
|
||||
data Library = Library {
|
||||
libraryExposed :: Maybe Bool
|
||||
, libraryVisibility :: Maybe String
|
||||
, libraryExposedModules :: [String]
|
||||
, libraryOtherModules :: [String]
|
||||
, libraryGeneratedModules :: [String]
|
||||
, libraryExposedModules :: [Module]
|
||||
, libraryOtherModules :: [Module]
|
||||
, libraryGeneratedModules :: [Module]
|
||||
, libraryReexportedModules :: [String]
|
||||
, librarySignatures :: [String]
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data Executable = Executable {
|
||||
executableMain :: Maybe FilePath
|
||||
, executableOtherModules :: [String]
|
||||
, executableGeneratedModules :: [String]
|
||||
, executableOtherModules :: [Module]
|
||||
, executableGeneratedModules :: [Module]
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data BuildTool = BuildTool String String | LocalBuildTool String
|
||||
@ -1267,20 +1268,20 @@ traverseSectionAndConditionals fData fConditionals acc0 sect@Section{..} = do
|
||||
where
|
||||
traverseConditionals = traverse . traverse . traverseSectionAndConditionals fConditionals fConditionals
|
||||
|
||||
getMentionedLibraryModules :: LibrarySection -> [String]
|
||||
getMentionedLibraryModules :: LibrarySection -> [Module]
|
||||
getMentionedLibraryModules (LibrarySection _ _ exposedModules generatedExposedModules otherModules generatedOtherModules _ _)
|
||||
= fromMaybeList (exposedModules <> generatedExposedModules <> otherModules <> generatedOtherModules)
|
||||
|
||||
listModules :: FilePath -> Section a -> IO [String]
|
||||
listModules :: FilePath -> Section a -> IO [Module]
|
||||
listModules dir Section{..} = concat <$> mapM (getModules dir) sectionSourceDirs
|
||||
|
||||
inferModules ::
|
||||
FilePath
|
||||
-> String
|
||||
-> (a -> [String])
|
||||
-> (b -> [String])
|
||||
-> ([String] -> [String] -> a -> b)
|
||||
-> ([String] -> a -> b)
|
||||
-> (a -> [Module])
|
||||
-> (b -> [Module])
|
||||
-> ([Module] -> [Module] -> a -> b)
|
||||
-> ([Module] -> a -> b)
|
||||
-> Section a
|
||||
-> IO (Section b)
|
||||
inferModules dir packageName_ getMentionedModules getInferredModules fromData fromConditionals = traverseSectionAndConditionals
|
||||
@ -1301,9 +1302,10 @@ toLibrary :: FilePath -> String -> Section LibrarySection -> IO (Section Library
|
||||
toLibrary dir name =
|
||||
inferModules dir name getMentionedLibraryModules getLibraryModules fromLibrarySectionTopLevel fromLibrarySectionInConditional
|
||||
where
|
||||
getLibraryModules :: Library -> [String]
|
||||
getLibraryModules :: Library -> [Module]
|
||||
getLibraryModules Library{..} = libraryExposedModules ++ libraryOtherModules
|
||||
|
||||
fromLibrarySectionTopLevel :: [Module] -> [Module] -> LibrarySection -> Library
|
||||
fromLibrarySectionTopLevel pathsModule inferableModules LibrarySection{..} =
|
||||
Library librarySectionExposed librarySectionVisibility exposedModules otherModules generatedModules reexportedModules signatures
|
||||
where
|
||||
@ -1312,7 +1314,7 @@ toLibrary dir name =
|
||||
reexportedModules = fromMaybeList librarySectionReexportedModules
|
||||
signatures = fromMaybeList librarySectionSignatures
|
||||
|
||||
determineModules :: [String] -> [String] -> Maybe (List String) -> Maybe (List String) -> Maybe (List String) -> Maybe (List String) -> ([String], [String], [String])
|
||||
determineModules :: [Module] -> [Module] -> Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module) -> ([Module], [Module], [Module])
|
||||
determineModules pathsModule inferable mExposed mGeneratedExposed mOther mGeneratedOther =
|
||||
(exposed, others, generated)
|
||||
where
|
||||
@ -1320,7 +1322,7 @@ determineModules pathsModule inferable mExposed mGeneratedExposed mOther mGenera
|
||||
exposed = maybe inferable fromList mExposed ++ fromMaybeList mGeneratedExposed
|
||||
others = maybe ((inferable \\ exposed) ++ pathsModule) fromList mOther ++ fromMaybeList mGeneratedOther
|
||||
|
||||
fromLibrarySectionInConditional :: [String] -> LibrarySection -> Library
|
||||
fromLibrarySectionInConditional :: [Module] -> LibrarySection -> Library
|
||||
fromLibrarySectionInConditional inferableModules lib@(LibrarySection _ _ exposedModules _ otherModules _ _ _) =
|
||||
case (exposedModules, otherModules) of
|
||||
(Nothing, Nothing) -> addToOtherModules inferableModules (fromLibrarySectionPlain lib)
|
||||
@ -1339,7 +1341,7 @@ fromLibrarySectionPlain LibrarySection{..} = Library {
|
||||
, librarySignatures = fromMaybeList librarySectionSignatures
|
||||
}
|
||||
|
||||
getMentionedExecutableModules :: ExecutableSection -> [String]
|
||||
getMentionedExecutableModules :: ExecutableSection -> [Module]
|
||||
getMentionedExecutableModules (ExecutableSection main otherModules generatedModules)=
|
||||
maybe id (:) (main >>= toModule . splitDirectories) $ fromMaybeList (otherModules <> generatedModules)
|
||||
|
||||
@ -1348,7 +1350,7 @@ toExecutable dir packageName_ =
|
||||
inferModules dir packageName_ getMentionedExecutableModules executableOtherModules fromExecutableSection (fromExecutableSection [])
|
||||
. expandMain
|
||||
where
|
||||
fromExecutableSection :: [String] -> [String] -> ExecutableSection -> Executable
|
||||
fromExecutableSection :: [Module] -> [Module] -> ExecutableSection -> Executable
|
||||
fromExecutableSection pathsModule inferableModules ExecutableSection{..} =
|
||||
(Executable executableSectionMain (otherModules ++ generatedModules) generatedModules)
|
||||
where
|
||||
@ -1472,14 +1474,14 @@ toBuildTool packageName_ executableNames = \ case
|
||||
warnLegacyTool pkg name = tell ["Usage of the unqualified build-tool name " ++ show name ++ " is deprecated! Please use the qualified name \"" ++ pkg ++ ":" ++ name ++ "\" instead!"]
|
||||
warnLegacySystemTool name = tell ["Listing " ++ show name ++ " under build-tools is deperecated! Please list system executables under system-build-tools instead!"]
|
||||
|
||||
pathsModuleFromPackageName :: String -> String
|
||||
pathsModuleFromPackageName name = "Paths_" ++ map f name
|
||||
pathsModuleFromPackageName :: String -> Module
|
||||
pathsModuleFromPackageName name = Module ("Paths_" ++ map f name)
|
||||
where
|
||||
f '-' = '_'
|
||||
f x = x
|
||||
|
||||
getModules :: FilePath -> FilePath -> IO [String]
|
||||
getModules dir src_ = sort <$> do
|
||||
getModules :: FilePath -> FilePath -> IO [Module]
|
||||
getModules dir src_ = sortModules <$> do
|
||||
exists <- doesDirectoryExist (dir </> src_)
|
||||
if exists
|
||||
then do
|
||||
@ -1487,10 +1489,10 @@ getModules dir src_ = sort <$> do
|
||||
removeSetup src . toModules <$> getModuleFilesRecursive src
|
||||
else return []
|
||||
where
|
||||
toModules :: [[FilePath]] -> [String]
|
||||
toModules :: [[FilePath]] -> [Module]
|
||||
toModules = catMaybes . map toModule
|
||||
|
||||
removeSetup :: FilePath -> [String] -> [String]
|
||||
removeSetup :: FilePath -> [Module] -> [Module]
|
||||
removeSetup src
|
||||
| src == dir = filter (/= "Setup")
|
||||
| otherwise = id
|
||||
|
@ -299,14 +299,14 @@ renderDirectories name = Field name . LineSeparatedList . replaceDots
|
||||
"." -> "./."
|
||||
_ -> xs
|
||||
|
||||
renderExposedModules :: [String] -> Element
|
||||
renderExposedModules = Field "exposed-modules" . LineSeparatedList
|
||||
renderExposedModules :: [Module] -> Element
|
||||
renderExposedModules = Field "exposed-modules" . LineSeparatedList . map unModule
|
||||
|
||||
renderOtherModules :: [String] -> Element
|
||||
renderOtherModules = Field "other-modules" . LineSeparatedList
|
||||
renderOtherModules :: [Module] -> Element
|
||||
renderOtherModules = Field "other-modules" . LineSeparatedList . map unModule
|
||||
|
||||
renderGeneratedModules :: [String] -> Element
|
||||
renderGeneratedModules = Field "autogen-modules" . LineSeparatedList
|
||||
renderGeneratedModules :: [Module] -> Element
|
||||
renderGeneratedModules = Field "autogen-modules" . LineSeparatedList . map unModule
|
||||
|
||||
renderReexportedModules :: [String] -> Element
|
||||
renderReexportedModules = Field "reexported-modules" . CommaSeparatedList
|
||||
|
@ -7,11 +7,15 @@ module Hpack.Util (
|
||||
, CxxOption
|
||||
, LdOption
|
||||
, parseMain
|
||||
|
||||
, Module(..)
|
||||
, toModule
|
||||
, getModuleFilesRecursive
|
||||
|
||||
, tryReadFile
|
||||
, expandGlobs
|
||||
, sort
|
||||
, sortModules
|
||||
, lexicographically
|
||||
, Hash
|
||||
, sha256
|
||||
@ -29,13 +33,19 @@ import System.FilePath
|
||||
import qualified System.FilePath.Posix as Posix
|
||||
import System.FilePath.Glob
|
||||
import Crypto.Hash
|
||||
import Data.String
|
||||
|
||||
import Hpack.Haskell
|
||||
import Hpack.Utf8 as Utf8
|
||||
|
||||
import Data.Aeson.Config.FromValue
|
||||
|
||||
sort :: [String] -> [String]
|
||||
sort = sortBy (comparing lexicographically)
|
||||
|
||||
sortModules :: [Module] -> [Module]
|
||||
sortModules = map Module . sort . map unModule
|
||||
|
||||
lexicographically :: String -> (String, String)
|
||||
lexicographically x = (map toLower x, x)
|
||||
|
||||
@ -62,7 +72,19 @@ splitOn c = go
|
||||
(ys, "") -> [ys]
|
||||
(ys, _:zs) -> ys : go zs
|
||||
|
||||
toModule :: [FilePath] -> Maybe String
|
||||
newtype Module = Module {unModule :: String}
|
||||
deriving Eq
|
||||
|
||||
instance Show Module where
|
||||
show (Module m) = show m
|
||||
|
||||
instance FromValue Module where
|
||||
fromValue = fmap Module . fromValue
|
||||
|
||||
instance IsString Module where
|
||||
fromString = Module
|
||||
|
||||
toModule :: [FilePath] -> Maybe Module
|
||||
toModule path = case reverse path of
|
||||
[] -> Nothing
|
||||
x : xs -> do
|
||||
@ -76,7 +98,7 @@ toModule path = case reverse path of
|
||||
, ".x"
|
||||
]
|
||||
let name = reverse (m : xs)
|
||||
guard (isModule name) >> return (intercalate "." name)
|
||||
guard (isModule name) >> return (Module $ intercalate "." name)
|
||||
where
|
||||
stripSuffix :: String -> String -> Maybe String
|
||||
stripSuffix suffix x = reverse <$> stripPrefix (reverse suffix) (reverse x)
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Hpack.UtilSpec (main, spec) where
|
||||
|
||||
import Helper
|
||||
|
Loading…
Reference in New Issue
Block a user