Skip to content

Instantly share code, notes, and snippets.

@cppxor2arr
Last active June 29, 2018 15:55

Revisions

  1. cppxor2arr revised this gist Jun 29, 2018. 1 changed file with 2 additions and 3 deletions.
    5 changes: 2 additions & 3 deletions nickMsgCnt.hs
    Original file line number Diff line number Diff line change
    @@ -43,9 +43,8 @@ nickMsgCnt = frequency . delPrefixes . nicks . msgs . slice . filterInvalid . pa
    nicks = map nick
    where nick (x,y) = if x == "*" then y else x
    delPrefixes = map delPrefix
    where delPrefix all@(x:xs) = if c `elem` prefixes then xs else all
    where c = x
    prefixes = "+@"
    where delPrefix all@(x:xs) = if x `elem` prefixes then xs else all
    where prefixes = "+@"
    frequency = toList . fromListWith (+) . assocList
    where assocList = map (\x -> (x,1))

  2. cppxor2arr revised this gist Jun 29, 2018. 1 changed file with 9 additions and 0 deletions.
    9 changes: 9 additions & 0 deletions nickMsgCnt.hs
    Original file line number Diff line number Diff line change
    @@ -19,6 +19,15 @@ main = do
    \date time @llama bye mwaaa\n\
    \date time * cppxor2arr wants to be bogs\n"
    print $ nickMsgCnt log
    {-
    output:
    Zerock: 1
    chainsol: 1
    cppxor2arr: 2
    letty: 1
    llama: 2
    uptime: 1
    -}

    nickMsgCnt :: String -> [(String,Int)]
    nickMsgCnt = frequency . delPrefixes . nicks . msgs . slice . filterInvalid . parse
  3. cppxor2arr created this gist Jun 29, 2018.
    45 changes: 45 additions & 0 deletions nickMsgCnt.hs
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,45 @@
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE OverlappingInstances #-}

    module Main where

    import Data.Map (fromListWith, toList)

    main :: IO ()
    main = do
    let log = "date time Zerock henlo\n\
    \date time uptime i'm up\n\
    \date time cppxor2arr mwaaa\n\
    \date time -- nick change\n\
    \date time --> join info\n\
    \date time <-- quit info\n\
    \date time letty mwaa everyone\n\
    \date time @llama mwaaa\n\
    \date time * chainsol is morky\n\
    \date time @llama bye mwaaa\n\
    \date time * cppxor2arr wants to be bogs\n"
    print $ nickMsgCnt log

    nickMsgCnt :: String -> [(String,Int)]
    nickMsgCnt = frequency . delPrefixes . nicks . msgs . slice . filterInvalid . parse
    where parse = map words . lines
    filterInvalid = filter ((>= 3) . length)
    slice = map (\x -> (x !! 2, x !! 3))
    msgs = filter condition
    where condition x = not . or $ map' x [join,quit,nickChange]
    where map' x = map (\y -> y x)
    join (x,_) = x == "-->"
    quit (x,_) = x == "<--"
    nickChange (x,_) = x == "--"
    nicks = map nick
    where nick (x,y) = if x == "*" then y else x
    delPrefixes = map delPrefix
    where delPrefix all@(x:xs) = if c `elem` prefixes then xs else all
    where c = x
    prefixes = "+@"
    frequency = toList . fromListWith (+) . assocList
    where assocList = map (\x -> (x,1))

    instance Show [(String,Int)] where
    show = unlines . map format
    where format (x,y) = x ++ ": " ++ show y