Commit d021ffc3 authored by Alp Mestanogullari's avatar Alp Mestanogullari Committed by Andrey Mokhov

Generic library rules (#571)

* wip

* debugging output

* Compute ProjectVersion on demand ONLY!

* remove debugging output, boot with --hadrian

* go back to using -c everywhere in .travis.yml

* prioritise libgmp.a rule over catch-all *.a rule, to avoid conflict

* add missing import

* tentative fix for the appveyor script

* use backslashes in appveyor.yml

* less 'cd'ing around in appveyor.yml

* address most of @snowleopard's feedback

* address last bit of feedback
parent 5276bf54
......@@ -17,10 +17,8 @@ matrix:
- PATH="/opt/cabal/2.0/bin:$PATH"
script:
# boot & configure ghc source tree
- ./boot && ./configure
# Run internal Hadrian tests
- hadrian/build.sh selftest
# Run internal Hadrian tests, after boot and configure.
- hadrian/build.sh -c selftest
- os: linux
env: MODE="--flavour=quickest"
......@@ -38,11 +36,8 @@ matrix:
- PATH="/opt/cabal/2.0/bin:$PATH"
script:
# boot & configure ghc source tree
- ./boot && ./configure
# Build GHC, letting hadrian boot & configure the ghc source tree
- hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=-
- hadrian/build.sh -c -j $MODE --no-progress --progress-colour=never --profile=-
- os: linux
env: MODE="--flavour=quickest --integer-simple"
......@@ -60,11 +55,8 @@ matrix:
- PATH="/opt/cabal/2.2/bin:$PATH"
script:
# boot & configure ghc source tree
- ./boot && ./configure
# build GHC
- hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=-
# boot, configure and build GHC
- hadrian/build.sh -c -j $MODE --no-progress --progress-colour=never --profile=-
# Test GHC binary
- _build/stage1/bin/ghc -e 1+2
......@@ -78,9 +70,6 @@ matrix:
- brew upgrade python
script:
# boot and configure ghc source tree
- ./boot && ./configure
# Due to timeout limit of OS X build on Travis CI,
# we will ignore selftest and build only stage1
- hadrian/build.sh -j -c $MODE --no-progress --progress-colour=never --profile=-
......
......@@ -34,11 +34,9 @@ build_script:
- cd ..
- hadrian\stack exec -- python3 boot
- hadrian\stack exec -- bash configure --enable-distro-toolchain
- cd hadrian
# Build GHC
- build -j --flavour=quickest --integer-simple --no-progress --progress-colour=never --profile=-
- hadrian\build -j --flavour=quickest --integer-simple --no-progress --progress-colour=never --profile=-
# Test GHC binary
- cd ..
- _build/stage1/bin/ghc -e 1+2
- _build\stage1\bin\ghc -e 1+2
......@@ -118,6 +118,7 @@ executable hadrian
, directory >= 1.2 && < 1.4
, extra >= 1.4.7
, mtl == 2.2.*
, parsec >= 3.1 && < 3.2
, QuickCheck >= 2.6 && < 2.11
, shake == 0.16.*
, transformers >= 0.4 && < 0.6
......
......@@ -98,12 +98,15 @@ packageRules = do
let contexts = liftM3 Context allStages knownPackages allWays
vanillaContexts = liftM2 vanillaContext allStages knownPackages
forM_ contexts $ mconcat
[ Rules.Compile.compilePackage readPackageDb
, Rules.Library.buildPackageLibrary ]
-- TODO: we might want to look into converting more and more
-- rules to the style introduced in Rules.Library in
-- https://github.com/snowleopard/hadrian/pull/571,
-- where "catch-all" rules are used to "catch" the need
-- for library files, and we then use parsec parsers to
-- extract all sorts of information needed to build them, like
-- the package, the stage, the way, etc.
let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic]
forM_ dynamicContexts Rules.Library.buildDynamicLib
forM_ contexts (Rules.Compile.compilePackage readPackageDb)
Rules.Program.buildProgram readPackageDb
......@@ -118,7 +121,6 @@ packageRules = do
[ Rules.PackageData.buildPackageData
, Rules.Dependencies.buildPackageDependencies readPackageDb
, Rules.Documentation.buildPackageDocumentation
, Rules.Library.buildPackageGhciLibrary
, Rules.Generate.generatePackageCode ]
buildRules :: Rules ()
......@@ -129,6 +131,7 @@ buildRules = do
Rules.Generate.generateRules
Rules.Gmp.gmpRules
Rules.Libffi.libffiRules
Rules.Library.libraryRules
packageRules
oracleRules :: Rules ()
......
......@@ -12,6 +12,7 @@ import Utilities
configureRules :: Rules ()
configureRules = do
-- TODO: consider other files we should track here (rts/rts.cabal etc)
[configFile, "settings", configH, "compiler/ghc.cabal"] &%> \outs -> do
skip <- not <$> cmdConfigure
if skip
......@@ -40,4 +41,4 @@ configureRules = do
need ["configure.ac"]
putBuild "| Running boot..."
verbosity <- getVerbosity
quietly $ cmd [EchoStdout (verbosity >= Loud)] "python3 boot"
quietly $ cmd [EchoStdout (verbosity >= Loud)] "python3 boot --hadrian"
......@@ -66,8 +66,9 @@ gmpRules = do
copyFile (gmpPath -/- "gmp.h") header
copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)
-- Build in-tree GMP library
root <//> gmpLibrary %> \lib -> do
-- Build in-tree GMP library, prioritised so that it matches "before"
-- the generic .a library rule in Rules.Library, whenever applicable.
priority 2.0 $ root <//> gmpLibrary %> \lib -> do
gmpPath <- gmpBuildPath
build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
putSuccess "| Successfully built custom library 'gmp'"
......
......@@ -51,7 +51,9 @@ libffiRules = do
libffiPath <- libffiBuildPath
need [libffiPath -/- libffiLibrary]
root <//> libffiLibrary %> \_ -> do
-- we set a higher priority because this overlaps
-- with the static lib rule from Rules.Library.libraryRules.
priority 2.0 $ root <//> libffiLibrary %> \_ -> do
useSystemFfi <- flag UseSystemFfi
rtsPath <- rtsBuildPath
if useSystemFfi
......
module Rules.Library (
buildPackageLibrary, buildPackageGhciLibrary, buildDynamicLib
) where
module Rules.Library (libraryRules) where
import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.PackageData as PD
import Hadrian.Haskell.Cabal.Parse (parseCabalPkgId)
import Hadrian.Package.Type
import Base
import Context
......@@ -12,105 +10,82 @@ import Expression hiding (way, package)
import Flavour
import GHC.Packages
import Oracles.ModuleFiles
import Oracles.Setting (libsuf)
import Rules.Gmp
import Settings
import Target
import Utilities
import Data.Functor
import qualified System.Directory as IO
import qualified Text.Parsec as Parsec
archive :: Way -> String -> String
archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a")
-- TODO: This comment is rather vague, make it more precise by listing what
-- exactly gets built and moved where, referencing the corresponding rules.
-- | Building a library consist of building the artefacts, copying it somewhere
-- with Cabal, and finally registering it with the compiler via Cabal in the
-- package database. We assume rules to build all the package artefacts, and
-- provide rules for the library artefacts.
library :: Context -> Rules ()
library context@Context{..} = do
root <- buildRootRules
pkgId <- case pkgCabalFile package of
Just file -> liftIO $ parseCabalPkgId file
Nothing -> return $ pkgName package
root -/- libDir context -/- pkgId -/- archive way pkgId %> \_ ->
need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) [pkgId]
-- * Library 'Rules'
libraryObjects :: Context -> Action [FilePath]
libraryObjects context@Context{..} = do
hsObjs <- hsObjects context
nonHsObjs <- nonHsObjects context
libraryRules :: Rules ()
libraryRules = do
root <- buildRootRules
-- This will create split objects if required (we don't track them
-- explicitly as this would needlessly bloat the Shake database).
need $ nonHsObjs ++ hsObjs
root -/- "//libHS*-*.dylib" %> buildDynamicLibUnix root "dylib"
root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so"
root -/- "//*.a" %> buildStaticLib root
priority 2 $ root -/- "//HS*-*.o" %> buildGhciLibO root
split <- interpretInContext context =<< splitObjects <$> flavour
let getSplitObjs = concatForM hsObjs $ \obj -> do
let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
contents <- liftIO $ IO.getDirectoryContents dir
return . map (dir -/-) $ filter (not . all (== '.')) contents
-- * 'Action's for building libraries
-- | Build a static library ('LibA') under the given build root, whose
-- path is the second argument.
buildStaticLib :: FilePath -> FilePath -> Action ()
buildStaticLib root archivePath = do
l@(BuildPath _ stage _ (LibA pkgname _ way))
<- parsePath (parseBuildLibA root)
"<.a library (build) path parser>"
archivePath
let context = libAContext l
objs <- libraryObjects context
removeFile archivePath
build $ target context (Ar Pack stage) objs [archivePath]
synopsis <- pkgSynopsis context
putSuccess $ renderLibrary
(quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
archivePath synopsis
(nonHsObjs ++) <$> if split then getSplitObjs else return hsObjs
buildDynamicLib :: Context -> Rules ()
buildDynamicLib context@Context{..} = do
root <- buildRootRules
pkgId <- case pkgCabalFile package of
Just file -> liftIO $ parseCabalPkgId file
Nothing -> return $ pkgName package
let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId
-- OS X
libPrefix ++ "*.dylib" %> buildDynamicLibUnix
-- Linux
libPrefix ++ "*.so" %> buildDynamicLibUnix
-- TODO: Windows
where
buildDynamicLibUnix lib = do
deps <- contextDependencies context
need =<< mapM pkgLibraryFile deps
objs <- libraryObjects context
build $ target context (Ghc LinkHs stage) objs [lib]
buildPackageLibrary :: Context -> Rules ()
buildPackageLibrary context@Context {..} = do
root <- buildRootRules
pkgId <- case pkgCabalFile package of
Just file -> liftIO $ parseCabalPkgId file
Nothing -> return $ pkgName package
let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId
archive = libPrefix ++ (waySuffix way <.> "a")
archive %%> \a -> do
objs <- libraryObjects context
removeFile a
build $ target context (Ar Pack stage) objs [a]
synopsis <- pkgSynopsis context
putSuccess $ renderLibrary
(quote (pkgName package) ++ " (" ++ show stage ++ ", way "
++ show way ++ ").") a synopsis
library context
buildPackageGhciLibrary :: Context -> Rules ()
buildPackageGhciLibrary context@Context {..} = priority 2 $ do
root <- buildRootRules
-- TODO: Get rid of code duplication for 'pkgId'.
pkgId <- case pkgCabalFile package of
Just file -> liftIO $ parseCabalPkgId file
Nothing -> return $ pkgName package
let libPrefix = root -/- buildDir context -/- "HS" ++ pkgId
libPrefix ++ "*" ++ (waySuffix way <.> "o") %> \obj -> do
objs <- allObjects context
need objs
build $ target context (Ld stage) objs [obj]
-- | Build a dynamic library ('LibDyn') under the given build root,
-- with the given suffix (@.so@ or @.dylib@, @.dll@ in the future),
-- where the complete path of the archive to build is given as the
-- third argument.
buildDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
buildDynamicLibUnix root suffix dynlibpath = do
dynlib <- parsePath (parseBuildLibDyn root suffix) "<dyn lib parser>" dynlibpath
let context = libDynContext dynlib
deps <- contextDependencies context
need =<< mapM pkgLibraryFile deps
objs <- libraryObjects context
build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath]
-- | Build a "ghci library" ('LibGhci') under the given build root,
-- with the complete path of the file to build is given as the second
-- argument.
buildGhciLibO :: FilePath -> FilePath -> Action ()
buildGhciLibO root ghcilibPath = do
l@(BuildPath _ stage _ (LibGhci _ _ _))
<- parsePath (parseBuildLibGhci root)
"<.o ghci lib (build) path parser>"
ghcilibPath
let context = libGhciContext l
objs <- allObjects context
need objs
build $ target context (Ld stage) objs [ghcilibPath]
-- * Helpers
-- | Return all Haskell and non-Haskell object files for the
-- given 'Context'.
allObjects :: Context -> Action [FilePath]
allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
-- | Return all the non-Haskell object files for the given library
-- context (object files built from C, C-- and sometimes other things).
nonHsObjects :: Context -> Action [FilePath]
nonHsObjects context = do
cObjs <- cObjects context
......@@ -119,6 +94,8 @@ nonHsObjects context = do
eObjs <- extraObjects context
return $ cObjs ++ cmmObjs ++ eObjs
-- | Return all the C object files needed to build the given library
-- context.
cObjects :: Context -> Action [FilePath]
cObjects context = do
srcs <- interpretInContext context (getPackageData PD.cSrcs)
......@@ -127,6 +104,9 @@ cObjects context = do
then objs
else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
-- | Return extra object files needed to build the given library context. The
-- resulting list is non empty only when the package from the 'Context' is
-- /integer-gmp/.
extraObjects :: Context -> Action [FilePath]
extraObjects context
| package context == integerGmp = do
......@@ -134,3 +114,211 @@ extraObjects context
need [gmpPath -/- gmpLibraryH]
map unifyPath <$> getDirectoryFiles "" [gmpPath -/- gmpObjectsDir -/- "*.o"]
| otherwise = return []
-- | Return all the object files to be put into the library
-- we're building for the given 'Context'.
libraryObjects :: Context -> Action [FilePath]
libraryObjects context@Context{..} = do
hsObjs <- hsObjects context
noHsObjs <- nonHsObjects context
-- This will create split objects if required (we don't track them
-- explicitly as this would needlessly bloat the Shake database).
need $ noHsObjs ++ hsObjs
split <- interpretInContext context =<< splitObjects <$> flavour
let getSplitObjs = concatForM hsObjs $ \obj -> do
let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
contents <- liftIO $ IO.getDirectoryContents dir
return . map (dir -/-) $ filter (not . all (== '.')) contents
(noHsObjs ++) <$> if split then getSplitObjs else return hsObjs
-- * Library paths types and parsers
-- | > libHS<pkg name>-<pkg version>[_<way suffix>].a
data LibA = LibA String [Integer] Way
deriving (Eq, Show)
-- | > <so or dylib>
data DynLibExt = So | Dylib
deriving (Eq, Show)
-- | > libHS<pkg name>-<pkg version>-ghc<ghc version>[_<way suffix>].<so or dylib>
data LibDyn = LibDyn String [Integer] Way DynLibExt
deriving (Eq, Show)
-- | > HS<pkg name>-<pkg version>[_<way suffix>].o
data LibGhci = LibGhci String [Integer] Way
deriving (Eq, Show)
-- | A path of the form
--
-- > <build root>/stage<N>/<path/to/pkg/from/ghc/root>/build/<something>
--
-- where @something@ describes a library to be build for the given package.
--
-- @a@, which represents that @something@, is instantiated as 'LibA', 'LibDyn'
-- and 'LibGhci' successively in this module, depending on the type of library
-- we're giving the build rules for.
data BuildPath a
= BuildPath FilePath -- ^ > <build root>/
Stage -- ^ > stage<N>/
FilePath -- ^ > <path/to/pkg/from/ghc/root>/build/
a -- ^ > whatever comes after 'build/'
deriving (Eq, Show)
-- | Get the 'Context' corresponding to the build path for a given static library.
libAContext :: BuildPath LibA -> Context
libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way))
= Context stage pkg way
where pkg = Package (if pkgname == "rts" then C else Haskell) Library pkgname pkgpath
-- | Get the 'Context' corresponding to the build path for a given ghci library.
libGhciContext :: BuildPath LibGhci -> Context
libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way))
= Context stage pkg way
where pkg = Package (if pkgname == "rts" then C else Haskell) Library pkgname pkgpath
-- | Get the 'Context' corresponding to the build path for a given dynamic library.
libDynContext :: BuildPath LibDyn -> Context
libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _))
= Context stage pkg way
where pkg = Package (if pkgname == "rts" then C else Haskell) Library pkgname pkgpath
-- | Parse a build path for a library to be built under the given build root,
-- where the filename will be parsed with the given parser argument.
parseBuildPath
:: FilePath -- ^ build root
-> Parsec.Parsec String () a -- ^ what to parse after @build/@
-> Parsec.Parsec String () (BuildPath a)
parseBuildPath root afterBuild = do
_ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
stage <- parseStage
_ <- Parsec.char '/'
pkgpath <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/build/")
a <- afterBuild
return (BuildPath root stage pkgpath a)
-- | Parse a path to a static library to be built, making sure the path starts
-- with the given build root.
parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA)
parseBuildLibA root = parseBuildPath root parseLibAFilename
Parsec.<?> "build path for a static library"
-- | Parse a path to a ghci library to be built, making sure the path starts
-- with the given build root.
parseBuildLibGhci :: FilePath -> Parsec.Parsec String () (BuildPath LibGhci)
parseBuildLibGhci root = parseBuildPath root parseLibGhciFilename
Parsec.<?> "build path for a ghci library"
-- | Parse a path to a dynamic library to be built, making sure the path starts
-- with the given build root.
parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath LibDyn)
parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext)
Parsec.<?> ("build path for a dynamic library with extension " ++ ext)
-- | Parse the filename of a static library to be built into a 'LibA' value.
parseLibAFilename :: Parsec.Parsec String () LibA
parseLibAFilename = do
_ <- Parsec.string "libHS"
(pkgname, pkgver) <- parsePkgId
way <- parseWaySuffix vanilla
_ <- Parsec.string ".a"
return (LibA pkgname pkgver way)
-- | Parse the filename of a ghci library to be built into a 'LibGhci' value.
parseLibGhciFilename :: Parsec.Parsec String () LibGhci
parseLibGhciFilename = do
_ <- Parsec.string "HS"
(pkgname, pkgver) <- parsePkgId
way <- parseWaySuffix vanilla
_ <- Parsec.string ".o"
return (LibGhci pkgname pkgver way)
-- | Parse the filename of a dynamic library to be built into a 'LibDyn' value.
parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn
parseLibDynFilename ext = do
_ <- Parsec.string "libHS"
(pkgname, pkgver) <- parsePkgId
_ <- optional $ Parsec.string "-ghc" *> parsePkgVersion
way <- addWayUnit Dynamic <$> parseWaySuffix dynamic
_ <- Parsec.string ("." ++ ext)
return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)
-- To be kept in sync with Stage.hs's stageString function
-- | Parse @"stageX"@ into a 'Stage'.
parseStage :: Parsec.Parsec String () Stage
parseStage = (Parsec.string "stage" *> Parsec.choice
[ Parsec.string (show n) $> toEnum n
| n <- map fromEnum [minBound .. maxBound :: Stage]
]) Parsec.<?> "stage string"
-- To be kept in sync with the show instances in
-- Way.Type, until we perhaps use some bidirectional
-- parsing/pretty printing approach or library.
-- | Parse a way suffix, returning the argument when no suffix is found
-- (the argument will be vanilla in most cases, but dynamic when we parse
-- the way suffix out of a shared library file name.
parseWaySuffix :: Way -> Parsec.Parsec String () Way
parseWaySuffix w = Parsec.choice
[ Parsec.string "_" *> (wayFromUnits <$> Parsec.sepBy1 parseWayUnit (Parsec.string "_"))
, pure w
] Parsec.<?> "way suffix (e.g _thr_p, or none for vanilla)"
where parseWayUnit = Parsec.choice
[ Parsec.string "thr" *> pure Threaded
, Parsec.char 'd' *>
(Parsec.choice
[ Parsec.string "ebug" *> pure Debug
, Parsec.string "yn" *> pure Dynamic
]
)
, Parsec.char 'p' *> pure Profiling
, Parsec.char 'l' *> pure Logging
] Parsec.<?> "way unit (thr, debug, dyn, p, l)"
-- | Parse a @"pkgname-pkgversion"@ string into
-- the package name and the integers that make up the
-- package version.
parsePkgId :: Parsec.Parsec String () (String, [Integer])
parsePkgId = parsePkgId' "" Parsec.<?> "package identifier (<name>-<version>)"
where parsePkgId' currName = do
s <- Parsec.many1 Parsec.alphaNum
_ <- Parsec.char '-'
let newName = if null currName then s else currName ++ "-" ++ s
Parsec.choice [ (newName,) <$> parsePkgVersion
, parsePkgId' newName
]
-- | Parse "."-separated integers that describe a package's version.
parsePkgVersion :: Parsec.Parsec String () [Integer]
parsePkgVersion = fmap reverse (parsePkgVersion' []) Parsec.<?> "package version"
where parsePkgVersion' xs = do
n <- parseNatural
Parsec.choice
[ Parsec.try (Parsec.lookAhead (Parsec.char '.' *> (Parsec.letter <|> Parsec.char '_')))
$> (n:xs)
, Parsec.char '.' *> parsePkgVersion' (n:xs)
, pure $ (n:xs)
]
-- | Parse a natural number.
parseNatural :: Parsec.Parsec String () Integer
parseNatural = (read <$> Parsec.many1 Parsec.digit)
Parsec.<?> "natural number"
-- | Runs the given parser against the given path,
-- erroring out when the parser fails (because it shouldn't
-- if the code from this module is correct).
parsePath
:: Parsec.Parsec String () a -- ^ parser to run
-> String -- ^ string describing the input source
-> FilePath -- ^ path to parse
-> Action a
parsePath p inp path = case Parsec.parse p inp path of
Left err -> fail $ "Rules.Library.parsePath: path="
++ path ++ ", error:\n" ++ show err
Right a -> pure a
......@@ -22,8 +22,6 @@ packageArgs = do
gmpBuildPath <- expr gmpBuildPath
let includeGmp = "-I" ++ gmpBuildPath -/- "include"
version <- getSetting ProjectVersion
mconcat
[ package base
? mconcat [ builder CabalFlags ? arg ('+':integerLibraryName)
......@@ -119,7 +117,9 @@ packageArgs = do
arg ("--configure-option=CFLAGS=" ++ includeGmp)
, arg ("--gcc-options=" ++ includeGmp) ] ]
, package runGhc
? builder Ghc ? input "//Main.hs" ? pure ["-cpp", "-DVERSION=" ++ show version]
? builder Ghc
? input "//Main.hs"
? (\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion
, package rts
? builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling"
]
module Way (
WayUnit (..), Way, wayUnit, removeWayUnit, wayFromUnits, allWays,
WayUnit (..), Way, wayUnit, addWayUnit, removeWayUnit, wayFromUnits, allWays,
vanilla, profiling, dynamic, profilingDynamic, threaded, debug, logging,
threadedDebug, threadedProfiling, threadedLogging, threadedDynamic,
......
......@@ -57,6 +57,10 @@ wayToUnits (Way set) = map toEnum . Set.elems $ set
wayUnit :: WayUnit -> Way -> Bool
wayUnit unit (Way set) = fromEnum unit `Set.member` set
-- | Add a 'WayUnit' to a 'Way'
addWayUnit :: WayUnit -> Way -> Way
addWayUnit unit (Way set) = Way . Set.insert (fromEnum unit) $ set
-- | Remove a 'WayUnit' from 'Way'.
removeWayUnit :: WayUnit -> Way -> Way
removeWayUnit unit (Way set) = Way . Set.delete (fromEnum unit) $ set
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment