Browse files

Remove unicode syntax

  • Loading branch information...
1 parent 280ff73 commit 9178d620dba89462cc44736e49e458d13e97d888 Jonas Westerlund committed Dec 4, 2013
Showing with 223 additions and 287 deletions.
  1. +11 −12 src/Bot.hs
  2. +35 −37 src/Commands.hs
  3. +22 −23 src/Eval.hs
  4. +55 −70 src/L.hs
  5. +4 −6 src/Main.hs
  6. +15 −16 src/Messages.hs
  7. +50 −55 src/Parser.hs
  8. +6 −7 src/TestSettings.hs
  9. +1 −2 src/Types.hs
  10. +0 −34 src/Unicode.hs
  11. +24 −25 src/Utils.hs
View
23 src/Bot.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
module Bot (Net, connect, socket, listen, run, write) where
@@ -9,38 +8,38 @@ import Control.Exception (bracket_)
import Control.Monad.Reader hiding (join)
import Data.ByteString (hGetLine)
import Data.ByteString.Char8 (pack, putStrLn)
+import Data.Monoid ((<>))
import Messages
import Network
import Parser
import Prelude hiding (init, putStrLn)
import Settings
import System.IO hiding (hGetLine, putStrLn)
import Types
-import Unicode
-connect HostName PortNumber IO Bot
+connect :: HostName -> PortNumber -> IO Bot
connect s p = notify $ do
- sock connectTo s $ PortNumber p
+ sock <- connectTo s $ PortNumber p
hSetBinaryMode sock True
hSetBuffering sock LineBuffering
return $ Bot sock
where notify = bracket_
- (putStrLn ("Connecting to " pack s "") hFlush stdout)
+ (putStrLn ("Connecting to " <> pack s <> "") >> hFlush stdout)
(putStrLn "Done.")
-run Net ()
-run = mapM_ write [nickMsg, userMsg] asks socket = listen
+run :: Net ()
+run = mapM_ write [nickMsg, userMsg] >> asks socket >>= listen
where nickMsg = Message Nothing "NICK" [nick]
userMsg = Message Nothing "USER" [nick, "0", "*", name]
-listen Handle Net ()
+listen :: Handle -> Net ()
listen h = forever $ do
- s liftIO $ hGetLine h
- liftIO putStrLn $ "got: " s
+ s <- liftIO $ hGetLine h
+ liftIO . putStrLn $ "got: " <> s
-- Uh oh! NON-EXHAUSTIVE PATTERNS
let Just msg = decode s
-- Handle each message in a new thread
- liftIO forkIO runReaderT (eval msg) = ask
+ liftIO . forkIO . runReaderT (eval msg) =<< ask
-eval Message Net ()
+eval :: Message -> Net ()
eval msg = sequence_ $ fmap ($ msg) commands
View
72 src/Commands.hs
@@ -1,88 +1,86 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
module Commands (commands) where
import Control.Monad (ap, when)
import Control.Monad.Reader (liftIO)
-import Data.ByteString hiding (drop, last)
+import Data.ByteString hiding (drop, elem, last)
import Data.Maybe
import Eval
import Messages
import Prelude hiding (concat, head)
import Settings (admins, channels)
import System.Exit
import Types
-import Unicode
import Utils
-commands [Message Net ()]
+commands :: [Message -> Net ()]
commands =
- [ matchCommand "PING" $ pingHandler params
+ [ matchCommand "PING" $ pingHandler . params
, matchCommand "001" $ connectHandler
, matchCommand "INVITE" $ inviteHandler
- , matchPrefix' "'join " $ joinHandler last params
- , matchPrefix' "'part " $ partHandler last params
- , matchPrefix' "'quit " $ quitHandler last params
- , matchPrefix' "'say " $ sayHandler last params
+ , matchPrefix' "'join " $ joinHandler . last . params
+ , matchPrefix' "'part " $ partHandler . last . params
+ , matchPrefix' "'quit " $ quitHandler . last . params
+ , matchPrefix' "'say " $ sayHandler . last . params
, matchPrefix "> " $ replyWith evalHandler
, matchPrefix "'pf " $ replyWith pointFreeHandler
, matchPrefix "'unpf " $ replyWith pointFulHandler
, matchPrefix "'type " $ replyWith typeHandler
]
where
params (Message _ _ ps) = ps
- replyWith handler = ap ((=) handler last params) reply
+ replyWith handler = ap ((>>=) . handler . last . params) reply
-match Message (Message Bool) (Message Net ()) Net ()
+match :: Message -> (Message -> Bool) -> (Message -> Net ()) -> Net ()
match msg p a = when (p msg) (a msg)
-matchPrefix ByteString (Message Net ()) Message Net ()
+matchPrefix :: ByteString -> (Message -> Net ()) -> Message -> Net ()
matchPrefix pfx a msg = match msg p a
where
p (Message _ _ (_:x:_)) = pfx `isPrefixOf` x
p _ = False
-matchPrefix' ByteString (Message Net ()) Message Net ()
+matchPrefix' :: ByteString -> (Message -> Net ()) -> Message -> Net ()
matchPrefix' pfx a msg = match msg p a
where
- p (Message (Just (User n _ _)) _ (_:x:_)) = n admins pfx `isPrefixOf` x
+ p (Message (Just (User n _ _)) _ (_:x:_)) = n `elem` admins && pfx `isPrefixOf` x
p _ = False
-matchCommand ByteString (Message Net ()) Message Net ()
+matchCommand :: ByteString -> (Message -> Net ()) -> Message -> Net ()
matchCommand cmd a msg = match msg p a
where
- p (Message _ cmd' _) = cmd cmd'
+ p (Message _ cmd' _) = cmd == cmd'
-connectHandler Message Net ()
-connectHandler = const join $ intercalate "," channels
+connectHandler :: Message -> Net ()
+connectHandler = const . join $ intercalate "," channels
-evalHandler Param Net ByteString
-evalHandler = liftIO evalHsExt dropFirstWord
+evalHandler :: Param -> Net ByteString
+evalHandler = liftIO . evalHsExt . dropFirstWord
-inviteHandler Message Net ()
+inviteHandler :: Message -> Net ()
inviteHandler (Message _ _ ps) = join $ concat ps
-joinHandler Param Net ()
-joinHandler = join nthWord 1
+joinHandler :: Param -> Net ()
+joinHandler = join . nthWord 1
-partHandler Param Net ()
-partHandler = part nthWord 1
+partHandler :: Param -> Net ()
+partHandler = part . nthWord 1
-pingHandler Params Net ()
-pingHandler = write Message Nothing "PONG"
+pingHandler :: Params -> Net ()
+pingHandler = write . Message Nothing "PONG"
-pointFreeHandler Param Net ByteString
-pointFreeHandler = liftIO pointFree dropFirstWord
+pointFreeHandler :: Param -> Net ByteString
+pointFreeHandler = liftIO . pointFree . dropFirstWord
-pointFulHandler Param Net ByteString
-pointFulHandler = liftIO pointFul dropFirstWord
+pointFulHandler :: Param -> Net ByteString
+pointFulHandler = liftIO . pointFul . dropFirstWord
-sayHandler Param Net ()
-sayHandler = ap (privmsg nthWord 1) (dropNWords 2)
+sayHandler :: Param -> Net ()
+sayHandler = ap (privmsg . nthWord 1) (dropNWords 2)
-quitHandler Param Net ()
-quitHandler = ( liftIO exitSuccess) quit dropFirstWord
+quitHandler :: Param -> Net ()
+quitHandler = (>> liftIO exitSuccess) . quit . dropFirstWord
-typeHandler Param Net ByteString
-typeHandler = liftIO typeOf dropFirstWord
+typeHandler :: Param -> Net ByteString
+typeHandler = liftIO . typeOf . dropFirstWord
View
45 src/Eval.hs
@@ -1,11 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
module Eval where
-- import Control.Monad.Reader
import Data.ByteString (ByteString, intercalate, split)
import Data.ByteString.Char8 (pack, unpack)
+import Data.Monoid ((<>))
-- import Mueval.ArgsParse
-- import Mueval.Context (defaultModules)
-- import Mueval.Interpreter
@@ -14,47 +14,46 @@ import Language.Haskell.Interpreter as I
import System.Process
import Types
-import Unicode
import Utils
-hsFile String
+hsFile :: String
hsFile = "L" -- A bit dumb, relies on the current working directory
-- Call out to the mueval binary
-evalHsExt Param IO ByteString
+evalHsExt :: Param -> IO ByteString
evalHsExt expr = do
- (_, out, err) liftIO $ readProcessWithExitCode "mueval" args ""
- return $ " " pack out pack err
+ (_, out, err) <- liftIO $ readProcessWithExitCode "mueval" args ""
+ return $ " " <> pack out <> pack err
where args = [ "-XExtendedDefaultRules"
, "-XUnicodeSyntax"
- , "-l", hsFile ".hs"
- , "--expression=" unpack expr
+ , "-l", hsFile ++ ".hs"
+ , "--expression=" ++ unpack expr
, "-t30" ]
-- Get inferred type of an expression
-typeOf Param IO ByteString
+typeOf :: Param -> IO ByteString
typeOf expr = do
- t liftIO I.runInterpreter
+ t <- liftIO . I.runInterpreter
$ I.loadModules [hsFile]
- I.setTopLevelModules [hsFile]
- I.setImports ["Prelude"]
- I.typeOf (unpack expr)
+ >> I.setTopLevelModules [hsFile]
+ >> I.setImports ["Prelude"]
+ >> I.typeOf (unpack expr)
case t of
- Left (I.WontCompile errs) return $ niceErrors errs
- Left err return pack $ show err
- Right val return $ pack val
+ Left (I.WontCompile errs) -> return $ niceErrors errs
+ Left err -> return . pack $ show err
+ Right val -> return $ pack val
-niceErrors [GhcError] ByteString
-niceErrors = excerpt' intercalate " " concatMap (split 10) fmap (pack I.errMsg)
+niceErrors :: [GhcError] -> ByteString
+niceErrors = excerpt' . intercalate " " . concatMap (split 10) . fmap (pack . I.errMsg)
-- Pointfree refactoring
-pointy FilePath Param IO ByteString
+pointy :: FilePath -> Param -> IO ByteString
pointy p expr = do
- (_, out, _) liftIO $ readProcessWithExitCode p [unpack expr] ""
- return intercalate " " split 10 $ pack out
+ (_, out, _) <- liftIO $ readProcessWithExitCode p [unpack expr] ""
+ return . intercalate " " . split 10 $ pack out
-pointFree Param IO ByteString
+pointFree :: Param -> IO ByteString
pointFree = pointy "pointfree"
-pointFul Param IO ByteString
+pointFul :: Param -> IO ByteString
pointFul = pointy "pointful"
View
125 src/L.hs
@@ -1,7 +1,6 @@
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE UnicodeSyntax #-}
{-# OPTIONS -fno-warn-unused-imports #-}
module L where
@@ -23,126 +22,112 @@ import Numeric
import Prelude
import Text.Printf
-import Control.Monad.Unicode ((≫=), (≫), (=≪))
-import Data.Bool.Unicode ((∧), (∨), (¬))
-import Data.Eq.Unicode ((≡), (≢), (≠))
-import Data.Function.Unicode ((∘))
-import Data.List.Unicode ((⧺), (∈), (∋), (∉), (∌))
-import Data.Monoid.Unicode ((⊕))
-import Data.Ord.Unicode ((≤), (≥), (≮), (≯))
-
-interleave a . [a] [a] [a]
+interleave :: [a] -> [a] -> [a]
interleave [] _ = []
interleave (x:xs) ys = x : interleave ys xs
-padl α. Int α [α] ]
-padl n p s = pad n p s s
+padl :: Int -> a -> [a] -> [a]
+padl n p s = pad n p s ++ s
-padr α. Int α [α] ]
-padr = (ap (⧺) ) pad
+padr :: Int -> a -> [a] -> [a]
+padr = (ap (++) .) . pad
-pad a a1. Int a [a1] [a]
-pad = (flip (drop length) ) replicate
+pad :: Int -> a -> [a1] -> [a]
+pad = (flip (drop . length) .) . replicate
-rgbToHex Word8 Word8 Word8 String
-rgbToHex r g b = '#' : concatMap (padl 2 '0' flip showHex "") [r, g, b]
+rgbToHex :: Word8 -> Word8 -> Word8 -> String
+rgbToHex r g b = '#' : concatMap (padl 2 '0' . flip showHex "") [r, g, b]
-- temp01's magical function
-oOo [Char] [Char]
+oOo :: [Char] -> [Char]
oOo [] = []
oOo s = concat [init s, [toUpper (last s)], tail (reverse s)]
-ben Integer Peen
-ben n = '8' : genericReplicate n '=' "D"
+ben :: Integer -> Peen
+ben n = '8' : genericReplicate n '=' ++ "D"
type Peen = String
-fap (f ) a b. Functor f (a b) f a f b
-fap = fmap
-
-gf Integer String
+gf :: Integer -> String
gf n | n < 0 = "NEGATIVE U"
- | n 0 = "N'T U"
- | n 9000 = printf "%s U" (unwords $ genericReplicate n "NO")
+ | n == 0 = "N'T U"
+ | n <= 9000 = printf "%s U" (unwords $ genericReplicate n "NO")
| otherwise = "It's over 9000!"
-ajpiano String
+ajpiano :: String
ajpiano = "PANDEMONIUM!!!"
-akahn Integer String
+akahn :: Integer -> String
akahn 0 = "akahn :)"
akahn n = printf "AK%sHN!!" (genericReplicate n 'A')
-coldhead String String
+coldhead :: String -> String
coldhead s | null s = ">: |"
| otherwise = printf "these are truly the last %s" s
-dabear String String
-dabear = printf "your mom %s"
-
-dytrivedi String String
+dytrivedi :: String -> String
dytrivedi s | null s = "my wife is happy"
| otherwise = mappend "my wife is annoyed i spend so much time " s
-matjas Char String
-matjas = interleave "matjas" enumFrom
+matjas :: Char -> String
+matjas = interleave "matjas" . enumFrom
-miketaylr String String
+miketaylr :: String -> String
miketaylr s | null ts = "here, let me open that... wait a minute, there's nothing there, you bitch!"
| otherwise = unwords ["here, let me open that", ts, "for you!"]
where ts = trim s
-nimbupani String String
+nimbupani :: String -> String
nimbupani s | null ts = "HERE LET ME OPEN THAT... WAIT A MINUTE THERES NOTHING THERE U BITCH"
| otherwise = unwords ["HERE LET ME OPEN THAT", ts, "FOR U"]
where ts = trim $ map toUpper s
-nlogax String String
+nlogax :: String -> String
nlogax = printf "%sn't"
-paul_irish (effin rad) effin rad
+paul_irish :: (effin -> rad) -> effin -> rad
paul_irish = ($)
-rwaldron String String
+rwaldron :: String -> String
rwaldron = printf "%s. Questions?"
-sean String
+sean :: String
sean = "koole"
-seutje String String
+seutje :: String -> String
seutje = printf "I would have %s"
-temp01 Maybe String
+temp01 :: Maybe String
temp01 = Just "awesome"
-vladikoff String String
+vladikoff :: String -> String
vladikoff = printf "flod %s!!"
-mlu String
+mlu :: String
mlu = "much like urself"
-muu String
+muu :: String
muu = "much unlike urself"
-source String
+source :: String
source = "https://github.com/nlogax/norby"
-sauce String
+sauce :: String
sauce = source
-trim String String
-trim = let t = reverse dropWhile isSpace in t t
+trim :: String -> String
+trim = let t = reverse . dropWhile isSpace in t . t
-dropInit a. [a] [a]
-dropInit = drop = subtract 1 length
+dropInit :: [a] -> [a]
+dropInit = drop =<< subtract 1 . length
-relTime (Integral a, PrintfArg a) a String
-relTime n = printTime take 3 $ omg n times
+relTime :: (Integral a, PrintfArg a) => a -> String
+relTime n = printTime . take 3 $ omg n times
where omg _ [] = []
omg t ((x, s):xs)
- | divs 0 = rest
- | divs 1 = (divs, s) : rest
- | otherwise = (divs, s "s") : rest
+ | divs == 0 = rest
+ | divs == 1 = (divs, s) : rest
+ | otherwise = (divs, s ++ "s") : rest
where divs = div t x
rest = omg (mod t x) xs
times = [ (31556926, "year")
@@ -152,28 +137,28 @@ relTime n = printTime ∘ take 3 $ omg n times
, (3600, "hour")
, (60, "minute")
, (1, "second")
- ] Integral a [(a, String)]
+ ] :: Integral a => [(a, String)]
-printTime (PrintfArg a, PrintfArg b) [(a, b)] String
+printTime :: (PrintfArg a, PrintfArg b) => [(a, b)] -> String
printTime xs = case xs of
- [] []
- [(n, s)] printf "%d %s" n s
- [(n1, s1), (n2, s2)] printf "%d %s and %d %s" n1 s1 n2 s2
- ((n, s):xs') printf "%d %s, %s" n s (printTime xs')
+ [] -> []
+ [(n, s)] -> printf "%d %s" n s
+ [(n1, s1), (n2, s2)] -> printf "%d %s and %d %s" n1 s1 n2 s2
+ ((n, s):xs') -> printf "%d %s, %s" n s (printTime xs')
-- Omg postfix function application so you can `car & drive` instead of `drive car`!
infixl 0 &
-(&) a b. b (b a) a
+(&) :: b -> (b -> a) -> a
x & g = g x
-ftoc a. Fractional a a a
+ftoc :: Fractional a => a -> a
ftoc t = 5/9 * (t - 32)
-ctof a. Fractional a a a
+ctof :: Fractional a => a -> a
ctof t = (9/5 * t) + 32
-f a b. Integral a a (b String) b String
-f = (∘) (⧺) flip genericReplicate 'F' (Integral a1) a1 (a String) a String
+f :: Integral a => a -> (b -> String) -> b -> String
+f = (.) . (++) . flip genericReplicate 'F' :: (Integral a1) => a1 -> (a -> String) -> a -> String
-u a. Integral a a [Char]
+u :: Integral a => a -> [Char]
u = flip genericReplicate 'U'
View
10 src/Main.hs
@@ -1,17 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
import Bot
import Control.Exception
import Control.Monad.Reader
-import Prelude hiding (catch)
+import Prelude
import System.IO
import Settings
-import Unicode
-- Set up actions to run on start and end, and run the main loop
-main IO ()
+main :: IO ()
main = bracket (connect server port) disconnect loop
- where disconnect = hClose socket
- loop st = (catch IO a (IOException IO a) IO a)
+ where disconnect = hClose . socket
+ loop st = (catch :: IO a -> (IOException -> IO a) -> IO a)
(runReaderT run st) (const $ return ())
View
31 src/Messages.hs
@@ -1,39 +1,38 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
module Messages where
import Control.Monad.Reader (asks, liftIO)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (hPutStrLn, putStrLn)
+import Data.Monoid ((<>))
import Parser
import Prelude hiding (putStrLn)
import Settings
import Types
-import Unicode
import Utils
-write Message Net ()
+write :: Message -> Net ()
write msg = do
- h asks socket
- liftIO hPutStrLn h $ encode msg
- liftIO putStrLn $ "sent: " encode msg
+ h <- asks socket
+ liftIO . hPutStrLn h $ encode msg
+ liftIO . putStrLn $ "sent: " <> encode msg
-privmsg Param ByteString Net ()
+privmsg :: Param -> ByteString -> Net ()
privmsg c m = write $ Message Nothing "PRIVMSG" [c, excerpt' m]
-join Param Net ()
-join = write Message Nothing "JOIN" return
+join :: Param -> Net ()
+join = write . Message Nothing "JOIN" . return
-part Param Net ()
-part = write Message Nothing "PART" return
+part :: Param -> Net ()
+part = write . Message Nothing "PART" . return
-quit Param Net ()
-quit = write Message Nothing "QUIT" return
+quit :: Param -> Net ()
+quit = write . Message Nothing "QUIT" . return
-- Convenience function to reply to the correct channel or person
-reply Message ByteString Net ()
+reply :: Message -> ByteString -> Net ()
reply msg bs = case msg of
(Message (Just (User nn _ _)) _ (p:_))
- let recp = if p nick then nn else p in privmsg recp bs
- _ return ()
+ -> let recp = if p == nick then nn else p in privmsg recp bs
+ _ -> return ()
View
105 src/Parser.hs
@@ -1,95 +1,90 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
module Parser (decode, encode) where
import Control.Applicative ((<|>), Alternative)
import Data.Attoparsec.ByteString
-import Data.ByteString (ByteString, intercalate)
+import Data.ByteString (ByteString)
+import Data.Monoid ((<>))
import Data.Word (Word8)
import Prelude hiding (or, take, takeWhile)
import Types
-import Unicode
-or Alternative f f a f a f a
-or = (<|>)
+decode :: ByteString -> Maybe Message
+decode = maybeResult . parse message
-decode ByteString Maybe Message
-decode = maybeResult parse message
-
-encode Message ByteString
-encode (Message Nothing cmd ps) = intercalate " " [cmd, paramize ps]
-encode (Message (Just pfx) cmd ps) =
- intercalate " " [":" enc pfx, cmd, paramize ps]
+encode :: Message -> ByteString
+encode (Message Nothing cmd ps) = cmd <> " " <> paramize ps
+encode (Message (Just pfx) cmd ps) = ":" <> enc pfx <> " " <> cmd <> " " <> paramize ps
where enc (Server s) = s
- enc (User n u h) = n maybe "" ("!" ) u
- maybe "" ("@" ) h
+ enc (User n u h) = n <> maybe "" ("!" <>) u
+ <> maybe "" ("@" <>) h
-paramize Params ByteString
+paramize :: Params -> ByteString
paramize ps = case ps of
- [] ""
- [x] ":" x
- (x:xs) intercalate " " [x, paramize xs]
+ [] -> ""
+ [x] -> ":" <> x
+ (x:xs) -> x <> " " <> paramize xs
-message Parser Message
+message :: Parser Message
message = do
- p prefix
- c command
- ps option [] params
- -- _ crlf
+ p <- prefix
+ c <- command
+ ps <- option [] params
+ -- _ <- crlf
return $ Message p c ps
-prefix Parser (Maybe Prefix)
-prefix = option Nothing fmap Just $ word8 58 nickPrefix `or` serverPrefix
+prefix :: Parser (Maybe Prefix)
+prefix = option Nothing . fmap Just $ word8 58 >> nickPrefix <|> serverPrefix
-nickPrefix Parser Prefix
+nickPrefix :: Parser Prefix
nickPrefix = do
- n nick
- u option Nothing fmap Just $ word8 33 user
- h option Nothing fmap Just $ word8 64 host
- _ space
+ n <- nick
+ u <- option Nothing . fmap Just $ word8 33 >> user
+ h <- option Nothing . fmap Just $ word8 64 >> host
+ _ <- space
return $ User n u h
-serverPrefix Parser Prefix
-serverPrefix = host = (space =) const return Server
+serverPrefix :: Parser Prefix
+serverPrefix = host >>= (space >>=) . const . return . Server
-params Parser Params
-params = many1 $ space (word8 58 trailing) `or` middle
+params :: Parser Params
+params = many1 $ space >> (word8 58 >> trailing) <|> middle
-command Parser ByteString
-command = takeWhile1 letter `or` takeWhile1 number
+command :: Parser ByteString
+command = takeWhile1 letter <|> takeWhile1 number
{-
-crlf Parser ()
-crlf = string "\CR\LF" return ()
+crlf :: Parser ()
+crlf = string "\CR\LF" >> return ()
-}
-host Parser ByteString
-host = let good w = w 32 w 33 w 64 in takeWhile1 good -- noneOf " @!"
+host :: Parser ByteString
+host = let good w = w /= 32 && w /= 33 && w /= 64 in takeWhile1 good -- noneOf " @!"
-letter Word8 Bool
-letter w = (65 w w 90) (97 w w 122) -- oneOf $ ['a'..'z'] ['A'..'Z']
+letter :: Word8 -> Bool
+letter w = (65 <= w && w <= 90) || (97 <= w && w <= 122) -- oneOf $ ['a'..'z'] <> ['A'..'Z']
-middle Parser ByteString
+middle :: Parser ByteString
middle = takeWhile1 nonWhite
-nick Parser ByteString
-nick = let good w = letter w number w special w in takeWhile1 good
+nick :: Parser ByteString
+nick = let good w = letter w || number w || special w in takeWhile1 good
-nonWhite Word8 Bool
-nonWhite w = w 0 w 10 w 13 w 32 -- noneOf "\SP\NUL\CR\LF"
+nonWhite :: Word8 -> Bool
+nonWhite w = w /= 0 && w /= 10 && w /= 13 && w /= 32 -- noneOf "\SP\NUL\CR\LF"
-number Word8 Bool
-number w = 48 w w 57 -- oneOf ['0'..'9']
+number :: Word8 -> Bool
+number w = 48 <= w && w <= 57 -- oneOf ['0'..'9']
-space Parser ByteString
-space = takeWhile1 ( 32) -- many1 $ char '\SP'
+space :: Parser ByteString
+space = takeWhile1 (== 32) -- many1 $ char '\SP'
-special Word8 Bool
+special :: Word8 -> Bool
special = inClass "-[]\\`^{}_|"
-trailing Parser ByteString
-trailing = let good w = w 0 w 10 w 13 in takeWhile good
+trailing :: Parser ByteString
+trailing = let good w = w /= 0 && w /= 10 && w /= 13 in takeWhile good
-user Parser ByteString
+user :: Parser ByteString
user = takeWhile1 $ notInClass "\SP\NUL\CR\LF\64"
View
13 src/TestSettings.hs
@@ -1,30 +1,29 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
module Settings where
import Data.ByteString (ByteString)
import Data.ByteString.Char8 ()
import Network
-server String
+server :: String
server = "chat.freenode.net"
-port PortNumber
+port :: PortNumber
port = 6667
-nick ByteString
+nick :: ByteString
nick = "hsbot"
-name ByteString
+name :: ByteString
name = "hsbot"
-channels [ByteString]
+channels :: [ByteString]
channels =
[ "#nlogax"
]
-admins [ByteString]
+admins :: [ByteString]
admins =
[ "nlogax"
]
View
3 src/Types.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
module Types where
@@ -8,7 +7,7 @@ import Data.ByteString
import System.IO
data Bot = Bot {
- socket Handle
+ socket :: Handle
}
type Net = ReaderT Bot IO
View
34 src/Unicode.hs
@@ -1,34 +0,0 @@
-{-# LANGUAGE UnicodeSyntax #-}
-
--- Just re-exports commonly used unicode operators:
--- ⊛∅≫=≫=≪∧∨¬≡≢≠∘⧺∈∋∉∌⊕≤≥≮≯
-
-module Unicode (
--- Control
- -- Applicative
- -- (⊛), (∅),
- -- Monad
- (≫=), (≫), (=≪),
--- Data
- -- Bool
- (∧), (∨), (¬),
- -- Eq
- (≡), (≢), (≠),
- -- Function
- (∘),
- -- List
- (⧺), (∈), (∋), (∉), (∌),
- -- Monoid
- (⊕),
- -- Ord
- (≤), (≥), (≮), (≯)
-) where
-
---import Control.Applicative.Unicode
-import Control.Monad.Unicode
-import Data.Bool.Unicode
-import Data.Eq.Unicode
-import Data.Function.Unicode
-import Data.List.Unicode
-import Data.Monoid.Unicode
-import Data.Ord.Unicode
View
49 src/Utils.hs
@@ -1,46 +1,45 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UnicodeSyntax #-}
module Utils where
import Data.ByteString
import Data.ByteString.Char8 ()
+import Data.Monoid ((<>))
import Prelude hiding (concat, drop, dropWhile, length, null, reverse, take, takeWhile)
import Text.Printf
-import Unicode
import qualified Data.List as List
-nthWord Int ByteString ByteString
-nthWord n s | n 0 = dropWhile ( 32) $ takeWhile ( 32) s
- | n > 0 = nthWord (n - 1) (dropWhile ( 32) $ dropWhile ( 32) s)
+nthWord :: Int -> ByteString -> ByteString
+nthWord n s | n == 0 = dropWhile (== 32) $ takeWhile (/= 32) s
+ | n > 0 = nthWord (n - 1) (dropWhile (== 32) $ dropWhile (/= 32) s)
| otherwise = error "nthWord: negative n"
-dropFirstWord ByteString ByteString
-dropFirstWord = dropWhile ( 32) dropWhile (not ( 32))
+dropFirstWord :: ByteString -> ByteString
+dropFirstWord = dropWhile (== 32) . dropWhile (not . (== 32))
-dropNWords Int ByteString ByteString
-dropNWords n s | n 0 = s
- | n > 0 = dropNWords (n - 1) (dropFirstWord s)
+dropNWords :: Int -> ByteString -> ByteString
+dropNWords n s | n == 0 = s
+ | n > 0 = dropNWords (n - 1) (dropFirstWord s)
| otherwise = error "dropNWords: negative n"
-trim ByteString ByteString
-trim = let trim' = reverse dropWhile ( 32) in trim' trim'
+trim :: ByteString -> ByteString
+trim = let trim' = reverse . dropWhile (== 32) in trim' . trim'
-excerpt Int ByteString ByteString ByteString
+excerpt :: Int -> ByteString -> ByteString -> ByteString
excerpt len end s | null $ drop len s = s
- | otherwise = take (len - length end) s end
+ | otherwise = take (len - length end) s <> end
-excerpt' ByteString ByteString
+excerpt' :: ByteString -> ByteString
excerpt' s = excerpt 225 "..." s
-relTime Int String
-relTime t = printTime List.take 3 $ omg t times
+relTime :: Int -> String
+relTime t = printTime . List.take 3 $ omg t times
where omg _ [] = []
omg t' ((x, s):xs)
- | divs 0 = rest
- | divs 1 = (divs, s) : rest
- | otherwise = (divs, s "s") : rest
+ | divs == 0 = rest
+ | divs == 1 = (divs, s) : rest
+ | otherwise = (divs, s ++ "s") : rest
where divs = div t' x
rest = omg (mod t' x) xs
times = [ (31556926, "year")
@@ -52,9 +51,9 @@ relTime t = printTime ∘ List.take 3 $ omg t times
, (1, "second")
]
-printTime (PrintfArg a, Integral a) [(a, String)] String
+printTime :: (PrintfArg a, Integral a) => [(a, String)] -> String
printTime xs = case xs of
- [] []
- [(n, s)] printf "%d %s ago" n s
- [(n1, s1), (n2, s2)] printf "%d %s and %d %s ago" n1 s1 n2 s2
- ((n, s):xs') printf "%d %s, %s" n s (printTime xs')
+ [] -> []
+ [(n, s)] -> printf "%d %s ago" n s
+ [(n1, s1), (n2, s2)] -> printf "%d %s and %d %s ago" n1 s1 n2 s2
+ ((n, s):xs') -> printf "%d %s, %s" n s (printTime xs')

0 comments on commit 9178d62

Please sign in to comment.