summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2017-02-26 16:11:38 -0400
committerJoey Hess2017-02-26 16:17:19 -0400
commit55ed8e8743e861e2230e40670a56034353cf4e32 (patch)
tree3e5f8a965569f1dcf8a7c3cabd10e663924208dd
parent2ba4b6fb3d29b2b65aa60f4bd591ed8cf6a63e27 (diff)
use ConfigurableValue where applicable
* Removed fromPort (use val instead). (API change) * Removed several Show instances that were only used for generating configuration, replacing with ConfigurableValue instances. (API change) It's somewhat annoying that IsInfo requires a Show instance. That's needed to be able to display Info in ghci, but some non-derived Show instances had to be kept to support that.
-rw-r--r--debian/changelog5
-rw-r--r--src/Propellor/Property/Apache.hs10
-rw-r--r--src/Propellor/Property/Apt/PPA.hs27
-rw-r--r--src/Propellor/Property/Docker.hs2
-rw-r--r--src/Propellor/Property/Firewall.hs6
-rw-r--r--src/Propellor/Property/FreeBSD/Poudriere.hs12
-rw-r--r--src/Propellor/Property/Logcheck.hs12
-rw-r--r--src/Propellor/Property/Munin.hs2
-rw-r--r--src/Propellor/Property/OpenId.hs2
-rw-r--r--src/Propellor/Property/Sbuild.hs28
-rw-r--r--src/Propellor/Property/Ssh.hs2
-rw-r--r--src/Propellor/Property/Systemd.hs2
-rw-r--r--src/Propellor/Property/Tor.hs4
-rw-r--r--src/Propellor/Types/OS.hs16
-rw-r--r--src/Propellor/Types/ZFS.hs7
15 files changed, 75 insertions, 62 deletions
diff --git a/debian/changelog b/debian/changelog
index bbcf7bdc..e3009188 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,11 @@
-propellor (3.3.2) UNRELEASED; urgency=medium
+propellor (3.4.0) UNRELEASED; urgency=medium
* Added ConfigurableValue type class, for values that can be used in a
config file, or to otherwise configure a program.
* The val function converts such values to String.
+ * Removed fromPort (use val instead). (API change)
+ * Removed several Show instances that were only used for generating
+ configuration, replacing with ConfigurableValue instances. (API change)
-- Joey Hess <id@joeyh.name> Sun, 26 Feb 2017 15:15:33 -0400
diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs
index f321143f..d912acc1 100644
--- a/src/Propellor/Property/Apache.hs
+++ b/src/Propellor/Property/Apache.hs
@@ -72,7 +72,7 @@ listenPorts :: [Port] -> Property DebianLike
listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps
`onChange` restarted
where
- portline port = "Listen " ++ fromPort port
+ portline port = "Listen " ++ val port
-- This is a list of config files because different versions of apache
-- use different filenames. Propellor simply writes them all.
@@ -135,8 +135,8 @@ virtualHost domain port docroot = virtualHost' domain port docroot []
-- | Like `virtualHost` but with additional config lines added.
virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty DebianLike DebianLike
virtualHost' domain port docroot addedcfg = siteEnabled domain $
- [ "<VirtualHost *:" ++ fromPort port ++ ">"
- , "ServerName " ++ domain ++ ":" ++ fromPort port
+ [ "<VirtualHost *:" ++ val port ++ ">"
+ , "ServerName " ++ domain ++ ":" ++ val port
, "DocumentRoot " ++ docroot
, "ErrorLog /var/log/apache2/error.log"
, "LogLevel warn"
@@ -202,8 +202,8 @@ httpsVirtualHost' domain docroot letos addedcfg = setup <!> teardown
]
sslconffile s = "/etc/apache2/sites-available/ssl/" ++ domain ++ "/" ++ s ++ ".conf"
vhost p ls =
- [ "<VirtualHost *:" ++ fromPort p ++">"
- , "ServerName " ++ domain ++ ":" ++ fromPort p
+ [ "<VirtualHost *:" ++ val p ++">"
+ , "ServerName " ++ domain ++ ":" ++ val p
, "DocumentRoot " ++ docroot
, "ErrorLog /var/log/apache2/error.log"
, "LogLevel warn"
diff --git a/src/Propellor/Property/Apt/PPA.hs b/src/Propellor/Property/Apt/PPA.hs
index 49fa9fa7..346125ff 100644
--- a/src/Propellor/Property/Apt/PPA.hs
+++ b/src/Propellor/Property/Apt/PPA.hs
@@ -25,8 +25,8 @@ data PPA = PPA
, ppaArchive :: String -- ^ The name of the archive.
} deriving (Eq, Ord)
-instance Show PPA where
- show p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]
+instance ConfigurableValue PPA where
+ val p = concat ["ppa:", ppaAccount p, "/", ppaArchive p]
instance IsString PPA where
-- | Parse strings like "ppa:zfs-native/stable" into a PPA.
@@ -40,9 +40,9 @@ instance IsString PPA where
-- | Adds a PPA to the local system repositories.
addPpa :: PPA -> Property DebianLike
addPpa p =
- cmdPropertyEnv "apt-add-repository" ["--yes", show p] Apt.noninteractiveEnv
+ cmdPropertyEnv "apt-add-repository" ["--yes", val p] Apt.noninteractiveEnv
`assume` MadeChange
- `describe` ("Added PPA " ++ (show p))
+ `describe` ("Added PPA " ++ (val p))
`requires` installed
-- | A repository key ID to be downloaded with apt-key.
@@ -52,14 +52,11 @@ data AptKeyId = AptKeyId
, akiServer :: String
} deriving (Eq, Ord)
-instance Show AptKeyId where
- show k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]
-
-- | Adds an 'AptKeyId' from the specified GPG server.
addKeyId :: AptKeyId -> Property DebianLike
addKeyId keyId =
check keyTrusted akcmd
- `describe` (unwords ["Add third-party Apt key", show keyId])
+ `describe` (unwords ["Add third-party Apt key", desc keyId])
where
akcmd =
tightenTargets $ cmdProperty "apt-key" ["adv", "--keyserver", akiServer keyId, "--recv-keys", akiId keyId]
@@ -72,10 +69,12 @@ addKeyId keyId =
nkid = take 8 (akiId keyId)
in
(isInfixOf [nkid] . pks) <$> readProcess "apt-key" ["list"]
+ desc k = unwords ["Apt Key", akiName k, akiId k, "from", akiServer k]
-- | An Apt source line that apt-add-repository will just add to
--- sources.list. It's also an instance of both 'Show' and 'IsString' to make
--- using 'OverloadedStrings' in the configuration file easier.
+-- sources.list. It's also an instance of both 'ConfigurableValue'
+-- and 'IsString' to make using 'OverloadedStrings' in the configuration
+-- file easier.
--
-- | FIXME there's apparently an optional "options" fragment that I've
-- definitely not parsed here.
@@ -85,8 +84,8 @@ data AptSource = AptSource
, asComponents :: [String] -- ^ The list of components to install from this repository.
} deriving (Eq, Ord)
-instance Show AptSource where
- show asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]
+instance ConfigurableValue AptSource where
+ val asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc]
instance IsString AptSource where
fromString s =
@@ -103,7 +102,7 @@ addRepository :: AptRepository -> Property DebianLike
addRepository (AptRepositoryPPA p) = addPpa p
addRepository (AptRepositorySource src) =
check repoExists addSrc
- `describe` unwords ["Adding APT repository", show src]
+ `describe` unwords ["Adding APT repository", val src]
`requires` installed
where
allSourceLines =
@@ -112,4 +111,4 @@ addRepository (AptRepositorySource src) =
. filter (not . isPrefixOf "#")
. filter (/= "") . lines <$> allSourceLines
repoExists = isInfixOf [src] <$> activeSources
- addSrc = cmdProperty "apt-add-source" [show src]
+ addSrc = cmdProperty "apt-add-source" [val src]
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 68fa2926..d2b2ee35 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -323,7 +323,7 @@ class Publishable p where
toPublish :: p -> String
instance Publishable (Bound Port) where
- toPublish p = fromPort (hostSide p) ++ ":" ++ fromPort (containerSide p)
+ toPublish p = val (hostSide p) ++ ":" ++ val (containerSide p)
-- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort
instance Publishable String where
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index 3ea19ffa..ce08cc06 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -51,9 +51,9 @@ toIpTable r = map Param $
toIpTableArg :: Rules -> [String]
toIpTableArg Everything = []
toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
-toIpTableArg (DPort port) = ["--dport", fromPort port]
+toIpTableArg (DPort port) = ["--dport", val port]
toIpTableArg (DPortRange (portf, portt)) =
- ["--dport", fromPort portf ++ ":" ++ fromPort portt]
+ ["--dport", val portf ++ ":" ++ val portt]
toIpTableArg (InIFace iface) = ["-i", iface]
toIpTableArg (OutIFace iface) = ["-o", iface]
toIpTableArg (Ctstate states) =
@@ -100,7 +100,7 @@ toIpTableArg (NotDestination ipwm) =
]
toIpTableArg (NatDestination ip mport) =
[ "--to-destination"
- , fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport
+ , fromIPAddr ip ++ maybe "" (\p -> ":" ++ val p) mport
]
toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
index 58477468..e6ddea16 100644
--- a/src/Propellor/Property/FreeBSD/Poudriere.hs
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -19,6 +19,7 @@ poudriereConfigPath = "/usr/local/etc/poudriere.conf"
newtype PoudriereConfigured = PoudriereConfigured String
deriving (Typeable, Monoid, Show)
+
instance IsInfo PoudriereConfigured where
propagateInfo _ = False
@@ -68,7 +69,7 @@ jail j@(Jail name version arch) = tightenTargets $
nx <- liftIO $ not <$> jailExists j
return $ c && nx
- (cmd, args) = poudriereCommand "jail" ["-c", "-j", name, "-a", show arch, "-v", show version]
+ (cmd, args) = poudriereCommand "jail" ["-c", "-j", name, "-a", val arch, "-v", val version]
createJail = cmdProperty cmd args
in
check chk createJail
@@ -101,9 +102,10 @@ data PoudriereZFS = PoudriereZFS ZFS.ZFS ZFS.ZFSProperties
data Jail = Jail String FBSDVersion PoudriereArch
data PoudriereArch = I386 | AMD64 deriving (Eq)
-instance Show PoudriereArch where
- show I386 = "i386"
- show AMD64 = "amd64"
+
+instance ConfigurableValue PoudriereArch where
+ val I386 = "i386"
+ val AMD64 = "amd64"
fromArchitecture :: Architecture -> PoudriereArch
fromArchitecture X86_64 = AMD64
@@ -127,7 +129,7 @@ instance ToShellConfigLines PoudriereZFS where
toAssoc (PoudriereZFS (ZFS.ZFS (ZFS.ZPool pool) dataset) _) =
[ ("NO_ZFS", "no")
, ("ZPOOL", pool)
- , ("ZROOTFS", show dataset)
+ , ("ZROOTFS", val dataset)
]
type ConfigLine = String
diff --git a/src/Propellor/Property/Logcheck.hs b/src/Propellor/Property/Logcheck.hs
index ced9fce2..8eaf56fd 100644
--- a/src/Propellor/Property/Logcheck.hs
+++ b/src/Propellor/Property/Logcheck.hs
@@ -16,21 +16,21 @@ import qualified Propellor.Property.File as File
data ReportLevel = Workstation | Server | Paranoid
type Service = String
-instance Show ReportLevel where
- show Workstation = "workstation"
- show Server = "server"
- show Paranoid = "paranoid"
+instance ConfigurableValue ReportLevel where
+ val Workstation = "workstation"
+ val Server = "server"
+ val Paranoid = "paranoid"
-- The common prefix used by default in syslog lines.
defaultPrefix :: String
defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ "
ignoreFilePath :: ReportLevel -> Service -> FilePath
-ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t) </> n
+ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (val t) </> n
ignoreLines :: ReportLevel -> Service -> [String] -> Property UnixLike
ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls
- `describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")")
+ `describe` ("logcheck ignore lines for " ++ n ++ "(" ++ val t ++ ")")
installed :: Property DebianLike
installed = Apt.installed ["logcheck"]
diff --git a/src/Propellor/Property/Munin.hs b/src/Propellor/Property/Munin.hs
index dd74d91b..13c72f3a 100644
--- a/src/Propellor/Property/Munin.hs
+++ b/src/Propellor/Property/Munin.hs
@@ -47,7 +47,7 @@ hostListFragment' hs os = concatMap muninHost hs
muninHost :: Host -> [String]
muninHost h = [ "[" ++ (hostName h) ++ "]"
, " address " ++ maybe (hostName h) (fromIPAddr . fst) (hOverride h)
- ] ++ (maybe [] (\x -> [" port " ++ (fromPort $ snd x)]) (hOverride h)) ++ [""]
+ ] ++ (maybe [] (\x -> [" port " ++ (val $ snd x)]) (hOverride h)) ++ [""]
hOverride :: Host -> Maybe (IPAddr, Port)
hOverride h = lookup (hostName h) os
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index 0abf38a6..00daa57d 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -28,7 +28,7 @@ providerFor users hn mp = propertyList desc $ props
where
baseurl = hn ++ case mp of
Nothing -> ""
- Just p -> ':' : fromPort p
+ Just p -> ':' : val p
url = "http://"++baseurl++"/simpleid"
desc = "openid provider " ++ url
setbaseurl l
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index db5982cd..aaa83e6f 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -111,8 +111,8 @@ type Suite = String
-- the same suite and the same architecture, so neither do we
data SbuildSchroot = SbuildSchroot Suite Architecture
-instance Show SbuildSchroot where
- show (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch
+instance ConfigurableValue SbuildSchroot where
+ val (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch
-- | Whether an sbuild schroot should use ccache during builds
--
@@ -151,7 +151,7 @@ built s@(SbuildSchroot suite arch) mirror cc =
where
go :: Property DebianLike
go = check (unpopulated (schrootRoot s) <||> ispartial) $
- property' ("built sbuild schroot for " ++ show s) make
+ property' ("built sbuild schroot for " ++ val s) make
make w = do
de <- liftIO standardPathEnv
let params = Param <$>
@@ -170,18 +170,18 @@ built s@(SbuildSchroot suite arch) mirror cc =
-- TODO we should kill any sessions still using the chroot
-- before destroying it (as suggested by sbuild-destroychroot)
deleted = check (not <$> unpopulated (schrootRoot s)) $
- property ("no sbuild schroot for " ++ show s) $ do
+ property ("no sbuild schroot for " ++ val s) $ do
liftIO $ removeChroot $ schrootRoot s
liftIO $ nukeFile
- ("/etc/sbuild/chroot" </> show s ++ "-sbuild")
+ ("/etc/sbuild/chroot" </> val s ++ "-sbuild")
makeChange $ nukeFile (schrootConf s)
enhancedConf =
- combineProperties ("enhanced schroot conf for " ++ show s) $ props
+ combineProperties ("enhanced schroot conf for " ++ val s) $ props
& aliasesLine
-- enable ccache and eatmydata for speed
& ConfFile.containsIniSetting (schrootConf s)
- ( show s ++ "-sbuild"
+ ( val s ++ "-sbuild"
, "command-prefix"
, intercalate "," commandPrefix
)
@@ -196,7 +196,7 @@ built s@(SbuildSchroot suite arch) mirror cc =
then ensureProperty w $
ConfFile.containsIniSetting
(schrootConf s)
- ( show s ++ "-sbuild"
+ ( val s ++ "-sbuild"
, "aliases"
, aliases
)
@@ -263,7 +263,7 @@ updatedFor system = property' ("updated sbuild schroot for " ++ show system) $
updated :: SbuildSchroot -> Property DebianLike
updated s@(SbuildSchroot suite arch) =
check (doesDirectoryExist (schrootRoot s)) $ go
- `describe` ("updated schroot for " ++ show s)
+ `describe` ("updated schroot for " ++ val s)
`requires` installed
where
go :: Property DebianLike
@@ -283,13 +283,13 @@ updated s@(SbuildSchroot suite arch) =
-- given suite and architecture, so we don't need the suffix to be random.
fixConfFile :: SbuildSchroot -> Property UnixLike
fixConfFile s@(SbuildSchroot suite arch) =
- property' ("schroot for " ++ show s ++ " config file fixed") $ \w -> do
+ property' ("schroot for " ++ val s ++ " config file fixed") $ \w -> do
confs <- liftIO $ dirContents dir
let old = concat $ filter (tempPrefix `isPrefixOf`) confs
liftIO $ moveFile old new
liftIO $ moveFile
- ("/etc/sbuild/chroot" </> show s ++ "-propellor")
- ("/etc/sbuild/chroot" </> show s ++ "-sbuild")
+ ("/etc/sbuild/chroot" </> val s ++ "-propellor")
+ ("/etc/sbuild/chroot" </> val s ++ "-sbuild")
ensureProperty w $
File.fileProperty "replace dummy suffix" (map munge) new
where
@@ -361,10 +361,10 @@ piupartsConf s@(SbuildSchroot _ arch) =
orig = "/etc/schroot/sbuild"
dir = "/etc/schroot/piuparts"
- sec = show s ++ "-piuparts"
+ sec = val s ++ "-piuparts"
f = schrootPiupartsConf s
munge = replace "-sbuild]" "-piuparts]"
- desc = "piuparts schroot conf for " ++ show s
+ desc = "piuparts schroot conf for " ++ val s
-- normally the piuparts schroot conf has no aliases, but we have to add
-- one, for dgit compatibility, if this is the default sid chroot
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 322cddef..828601b8 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -120,7 +120,7 @@ dotFile f user = do
listenPort :: Port -> RevertableProperty DebianLike DebianLike
listenPort port = enable <!> disable
where
- portline = "Port " ++ fromPort port
+ portline = "Port " ++ val port
enable = sshdConfig `File.containsLine` portline
`describe` ("ssh listening on " ++ portline)
`onChange` restarted
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 78529f73..e1e20974 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -421,7 +421,7 @@ class Publishable a where
toPublish :: a -> String
instance Publishable Port where
- toPublish port = fromPort port
+ toPublish port = val port
instance Publishable (Bound Port) where
toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 72bd45f5..24d5b687 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -128,7 +128,7 @@ hiddenService hn port = hiddenService' hn [port]
hiddenService' :: HiddenServiceName -> [Port] -> Property DebianLike
hiddenService' hn ports = ConfFile.adjustSection
- (unwords ["hidden service", hn, "available on ports", intercalate "," (map fromPort ports')])
+ (unwords ["hidden service", hn, "available on ports", intercalate "," (map val ports')])
(== oniondir)
(not . isPrefixOf "HiddenServicePort")
(const (oniondir : onionports))
@@ -139,7 +139,7 @@ hiddenService' hn ports = ConfFile.adjustSection
oniondir = unwords ["HiddenServiceDir", varLib </> hn]
onionports = map onionport ports'
ports' = sort ports
- onionport port = unwords ["HiddenServicePort", fromPort port, "127.0.0.1:" ++ fromPort port]
+ onionport port = unwords ["HiddenServicePort", val port, "127.0.0.1:" ++ val port]
-- | Same as `hiddenService` but also causes propellor to display
-- the onion address of the hidden service.
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 696c36b0..8d7f1ba3 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -18,10 +18,11 @@ module Propellor.Types.OS (
Group(..),
userGroup,
Port(..),
- fromPort,
systemToTargetOS,
) where
+import Propellor.Types.ConfigurableValue
+
import Network.BSD (HostName)
import Data.Typeable
import Data.String
@@ -75,10 +76,13 @@ instance IsString FBSDVersion where
fromString "9.3-RELEASE" = FBSD093
fromString _ = error "Invalid FreeBSD release"
+instance ConfigurableValue FBSDVersion where
+ val FBSD101 = "10.1-RELEASE"
+ val FBSD102 = "10.2-RELEASE"
+ val FBSD093 = "9.3-RELEASE"
+
instance Show FBSDVersion where
- show FBSD101 = "10.1-RELEASE"
- show FBSD102 = "10.2-RELEASE"
- show FBSD093 = "9.3-RELEASE"
+ show = val
isStable :: DebianSuite -> Bool
isStable (Stable _) = True
@@ -148,5 +152,5 @@ userGroup (User u) = Group u
newtype Port = Port Int
deriving (Eq, Ord, Show)
-fromPort :: Port -> String
-fromPort (Port p) = show p
+instance ConfigurableValue Port where
+ val (Port p) = show p
diff --git a/src/Propellor/Types/ZFS.hs b/src/Propellor/Types/ZFS.hs
index 3ce4b22c..42ff74ec 100644
--- a/src/Propellor/Types/ZFS.hs
+++ b/src/Propellor/Types/ZFS.hs
@@ -6,6 +6,8 @@
module Propellor.Types.ZFS where
+import Propellor.Types.ConfigurableValue
+
import Data.String
import qualified Data.Set as Set
import qualified Data.String.Utils as SU
@@ -37,8 +39,11 @@ fromPropertyList props =
zfsName :: ZFS -> String
zfsName (ZFS (ZPool pool) dataset) = intercalate "/" [pool, show dataset]
+instance ConfigurableValue ZDataset where
+ val (ZDataset paths) = intercalate "/" paths
+
instance Show ZDataset where
- show (ZDataset paths) = intercalate "/" paths
+ show = val
instance IsString ZDataset where
fromString s = ZDataset $ SU.split "/" s