Split commands off

[blackboard-dns.git] / DDNS / Zone.hs

diff --git a/DDNS/Zone.hs b/DDNS/Zone.hs
new file mode 100644 (file)
index 0000000..aca51e9
--- /dev/null
+++ b/DDNS/Zone.hs
@@ -0,0 +1,41 @@
+module DDNS.Zone
+    ( listZones
+    , completeZoneName
+    )
+    where
+
+import           Control.Monad
+import           Control.Monad.Trans
+import           Data.List
+import           Database.HaskellDB
+import qualified DDNS.DB.Zones as Zones
+import           Network.DNS.Message
+import           System.Console.Haskeline
+
+
+listZones :: Database -> IO [DomainName]
+listZones db
+    = do rows <- query db $ do t <- table Zones.zones
+                               project (Zones.zone << t!Zones.zone)
+         return $ map (read . (!Zones.zone)) rows
+
+completeZoneName :: MonadIO m => Database -> CompletionFunc m
+completeZoneName db
+    = completeWord Nothing "" $ \ prefix ->
+      do zones <- liftM (map show) $ liftIO $ listZones db
+         return $ produceCands zones prefix
+    where
+      produceCands :: [String] -> String -> [Completion]
+      produceCands zones prefix
+          = let cands = filter (prefix `isPrefixOf`) zones
+                comps = map mkComp cands
+            in
+              comps
+
+      mkComp :: String -> Completion
+      mkComp zn
+          = Completion {
+              replacement = zn
+            , display     = zn
+            , isFinished  = True
+            }