Move example utilities into examples directory.

1 files changed, 0 insertions, 105 deletions

diff --git a/pwrite.hs b/pwrite.hs
deleted file mode 100644
index bad6af06..00000000
--- a/pwrite.hs
+++ /dev/null
@@ -1,105 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE OverloadedStrings #-}
-import System.Environment
-import System.Posix.Files ( getFileStatus, fileMode )
-import Data.Bits          ( (.&.) )
-import Data.Text          ( Text )
-import qualified Data.Text    as Text
-import qualified Data.Text.IO as Text
-import Control.Applicative
-import Control.Monad
-import Data.Maybe
-import XMPPServer
-import Data.Monoid
-
--- Transforms a string of form language[_territory][.codeset][@modifier]
--- typically used in LC_ locale variables into the BCP 47
--- language codes used in xml:lang attributes.
-toBCP47 :: [Char] -> [Char]
-toBCP47 lang = map hyphen $ takeWhile (/='.') lang
- where hyphen '_' = '-'
-       hyphen  c  =  c
-
-
-#if MIN_VERSION_base(4,6,0)
-#else
-lookupEnv k = fmap (lookup k) getEnvironment
-#endif
-
-getPreferedLang :: IO Text
-getPreferedLang = do
-    lang <- do
-        lc_all <- lookupEnv "LC_ALL"
-        lc_messages <- lookupEnv "LC_MESSAGES"
-        lang <- lookupEnv "LANG"
-        return $ lc_all `mplus` lc_messages `mplus` lang
-    return $ maybe "en" (Text.pack . toBCP47) lang
-
-cimatch :: Text -> Text -> Bool
-cimatch w t = Text.toLower w == Text.toLower t
-
-cimatches :: Text -> [Text] -> [Text]
-cimatches w ts = dropWhile (not . cimatch w) ts
-
--- rfc4647 lookup of best match language tag
-lookupLang :: [Text] -> [Text] -> Maybe Text
-lookupLang (w:ws) tags
-    | Text.null w = lookupLang ws tags
-    | otherwise   = case cimatches w tags of
-                        (t:_) -> Just t
-                        []    -> lookupLang (reduce w:ws) tags
- where
-    reduce w = Text.concat $ reverse nopriv
-        where
-            rparts = reverse . init $ Text.groupBy (\_ c -> c/='-') w
-            nopriv = dropWhile ispriv rparts
-            ispriv t = Text.length t == 2 && Text.head t == '-'
-
-lookupLang [] tags | "" `elem` tags = Just ""
-                   | otherwise      = listToMaybe $ tags
-
-
-messageText :: Stanza -> IO Text
-messageText msg = do
-    pref <- getPreferedLang
-    let m = msgLangMap (stanzaType msg)
-        key = lookupLang [pref] (map fst m)
-        choice = do
-            k <- key
-            lookup k m
-    flip (maybe $ return "") choice $ \choice -> do
-    let subj = fmap ("Subject: " <>) $ msgSubject choice
-        ts = catMaybes [subj, msgBody choice]
-    return $ Text.intercalate "\n\n" ts
-
-crlf :: Text -> Text
-crlf t = Text.unlines $ map cr (Text.lines t)
- where
-    cr t | Text.last t == '\r'  = t
-         | otherwise            = t <> "\r"
-
-deliverTerminalMessage ::
-    forall t t1. t -> Text -> t1 -> Stanza -> IO Bool
-deliverTerminalMessage cw tty utmp msg = do
-    mode <- fmap fileMode (getFileStatus $ Text.unpack tty)
-    let mesgy = mode .&. 0o020 /= 0 -- verify mode g+w
-    if not mesgy then return False else do
-    text <- do
-        t <- messageText msg
-        return $ Text.unpack
-            $ case stanzaFrom msg of
-                Just from -> "\r\n" <> from <> " says...\r\n" <> crlf t <> "\r\n"
-                Nothing -> crlf t <> "\r\n"
-    writeFile (Text.unpack tty) text
-    return True -- return True if a message was delivered
-
-main = do
-    args <- getArgs
-    let mas = (,) <$> listToMaybe args <*> listToMaybe (drop 1 args)
-    flip (maybe $ putStrLn "pwrite user tty") mas $ \(usr,tty) -> do
-    bod <- Text.getContents
-    stanza <- makeMessage "jabber:client" "nobody" (Text.pack usr) bod
-    b <- deliverTerminalMessage () (Text.pack tty) () stanza
-    when b $ putStrLn "delivered."
-    return ()