yo big rich

Monads are monoids in the category of endofunctors.

I'm writing all of my Sythe parsing shit in Haskell.

Code:

module Parsing
  (
    getAuthorName
  , getMessages
  , getMessageList
  , getAuthorIdNode
  , getAuthorIdFromNode
  , getDateFromString
  , getDateFromPost
  , getThreadNameFromPage
  , getThreadIdFromPage
  ) where

import Text.HTML.TagSoup
import Text.Regex.Posix
import Data.List.Split
import Data.Time.Format
import Data.Time.Clock
import Data.Time.LocalTime

getThreadUrlFromPage :: [Tag String] -> String
getThreadUrlFromPage tags = (fromAttrib "content" $ head $ take 1 $ (dropWhile (~/= "<meta property=og:url>") tags))

getThreadIdFromPage :: [Tag String] -> Int
getThreadIdFromPage tags = read $ last $ head ((getThreadUrlFromPage tags) =~ "\\.([0-9]*)/" :: [[String]])

getThreadNameFromPage :: [Tag String] -> String
getThreadNameFromPage = fromAttrib "content" . head . take 1 . dropWhile (~/= "<meta property=og:title>")

getDateFromPost :: [Tag String] -> String
getDateFromPost = filter (/= '\n') . innerText . take 2 . dropWhile (~/= "<a class=datePermalink>")

getDateFromString dateString = parseTimeOrError True defaultTimeLocale "%b %-d, %Y at %-I:%M %p" dateString :: LocalTime

getAuthorName = fromAttrib "data-author" . head . filter (\tag -> tag ~== TagOpen "li" [("data-author", "")])

getAuthorIdFromNode tags = head $ head ((getAuthorIdNode tags) =~ "([0-9])*$" :: [[String]])

getAuthorIdNode :: [Tag String] -> String
getAuthorIdNode = fromAttrib "href" . head . dropWhile (\tag -> not (tag ~== TagOpen "a" [("href", "")] && fromAttrib "href" tag =~ "search/member\\?user_id=[0-9]*"))

getMessages :: [Tag String] -> [[Tag String]]
getMessages = drop 1 . splitWhen messageHeaderStart

getMessageList :: [Tag String] -> [Tag String]
getMessageList = getRidOfFooter . getRidOfHeader

getRidOfHeader :: [Tag String] -> [Tag String]
getRidOfHeader = drop 2 . dropWhile (not . messageListStart)

getRidOfFooter :: [Tag String] -> [Tag String]
getRidOfFooter = reverse . drop 2 . dropWhile (~/= "</ol>") . dropWhile (~/= "</ol>") . reverse

getMessage :: [Tag String] -> [Tag String]
getMessage tags = (getNextMessageHeaderTags tags) ++ (getNextMessageTags tags)

getNextMessageHeaderTags :: [Tag String] -> [Tag String]
getNextMessageHeaderTags = takeWhile (not . isMessageStart)

getNextMessageTags :: [Tag String] -> [Tag String]
getNextMessageTags = takeWhile (not . messageHeaderStart) . dropWhile (not . isMessageStart)

messageHeaderStart :: Tag String -> Bool
messageHeaderStart = (~== "<li class=msgHeader>")

messageListStart :: Tag String -> Bool
messageListStart = (~== "<ol class=messageList>")

isMessageStart :: Tag String -> Bool
isMessageStart tag = tag ~== TagOpen "li" [] && fromAttrib "id" tag =~ "post-[0-9]*"

I have a somewhat done basic CPU simulation using the State monad:

Code:

{-|
Module      : Host.Cpu
Description : A virtual CPU loosely based on the 6502

This virual CPU is loosely based on the 6502. It is not designed to be a pure
hardware implementation. Instead it is designed to run user programs while a
kernel written in Haskell is able to control extra features added to the 6502.

These extra features include:
  -> Kernel Mode
  -> Virtual Addressing Support
  -> Return Register
  -> System Call Instruction

The idea for this implementation comes from my Fall 2014 Operating Systems
class in which I did something similar in Typescript.
-}

module Host.Cpu (
  -- Types
  Cpu

  -- Constructors
, initCpu

  -- Functions
, setXRegister
, xRegister

, executeInstruction
, writeByte
, bytesToShort
, incrementProgramCounter
, programCounter
, loadByteProgramCounterImmediate
, memory
) where

import Control.Monad.Trans.State

import Host.Device (Device, Byte, Short, Bit, bytesToShort)
import Host.Memory

type CpuState = State Cpu

-- Disabling some of the features for the initial implementation
data Cpu = Cpu { accumulator :: Byte
               --, highAddress :: Short
               --, lowAddress :: Short
               , programCounter :: Short
               --, return :: Short
               , stackPointer :: Byte
               , status :: StatusFlags
               , xRegister :: Byte
               , yRegister :: Byte
               , memory :: Memory
               }

setAccumulator :: Byte -> CpuState()
setAccumulator value = do
  modify (\cpu -> cpu { accumulator = value } )
  return ()

setYRegister :: Byte -> CpuState()
setYRegister value = do
  modify (\cpu -> cpu { yRegister = value } )
  return ()

setXRegister :: Byte -> CpuState()
setXRegister value = do
  modify (\cpu -> cpu { xRegister = value } )
  return ()

setProgramCounter :: Short -> CpuState()
setProgramCounter value = do
  modify (\cpu -> cpu { programCounter = value} )
  return ()

data StatusFlags = StatusFlags { break :: Bit
                               , carry :: Bit
                               , interruptDisable :: Bit
                               , kernelMode :: Bit
                               , negative :: Bit
                               , overflow :: Bit
                               , zero :: Bit
                               , zFlag :: Bit
                               } deriving (Show)

-- Easy way to get Cpu will all blanks
initCpu :: Cpu
initCpu = Cpu
  0
  0
  0
  (StatusFlags False False False False False False False False)
  0
  0
  initMemoryNew



writeByte :: Short -> Byte -> CpuState()
writeByte address value = do
  memory <- gets memory
  modify (\cpu -> cpu { memory = setByte address value memory})

-- Helper function
loadByteProgramCounterImmediate :: CpuState Byte
loadByteProgramCounterImmediate = do
  programCounter <- gets programCounter
  memory <- gets memory
  let byte = getByte programCounter memory
  incrementProgramCounter
  return (byte)

loadShortProgramCounterImmediate :: CpuState Short
loadShortProgramCounterImmediate = do
  lowByte <- loadByteProgramCounterImmediate
  highByte <- loadByteProgramCounterImmediate
  return $ bytesToShort lowByte highByte

incrementProgramCounter :: CpuState ()
incrementProgramCounter = do
  modify (\cpu -> cpu { programCounter = (programCounter cpu) + 1 })
  return ()

transferRegisterToRegister :: (Cpu -> Byte) -> (Byte -> CpuState()) ->
                              CpuState()
transferRegisterToRegister source destination = do
  sourceValue <- gets source
  destination sourceValue
  return ()

loadRegisterImmediate :: (Byte -> CpuState ()) -> CpuState ()
loadRegisterImmediate register = do
  value <- loadByteProgramCounterImmediate
  register value
  return ()

loadRegisterAbsolute :: (Byte -> CpuState ()) -> CpuState ()
loadRegisterAbsolute register = do
  address <- loadShortProgramCounterImmediate
  memory <- gets memory
  let value = getByte address memory
  register value
  return ()

storeRegisterAbsolute :: (Cpu -> Byte) -> CpuState ()
storeRegisterAbsolute register = do
  address <- loadShortProgramCounterImmediate
  register <- gets register
  writeByte address register
  return ()

-- Helper function
executeInstruction :: Byte -> CpuState ()
executeInstruction 0x00 = return ()
--executeInstruction 0x40 = returnFromInterupt
executeInstruction 0x4C = jump
--executeInstruction 0x6D = addWithCarry
executeInstruction 0x8A = transferXRegisterToAccumulator
executeInstruction 0x8C = storeYRegisterAbsolute
executeInstruction 0x8D = storeAccumulatorAbsolute
executeInstruction 0x8E = storeXRegisterAbsolute
executeInstruction 0x98 = transferYRegisterToAccumulator
executeInstruction 0xA0 = loadYRegisterImmediate
executeInstruction 0xA2 = loadXRegisterImmediate
executeInstruction 0xA8 = transferAccumulatorToYRegister
executeInstruction 0xA9 = loadAccumulatorImmediate
executeInstruction 0xAA = transferAccumulatorToXRegister
executeInstruction 0xAC = loadYRegisterAbsolute
executeInstruction 0xAD = loadAccumulatorAbsolute
executeInstruction 0xAE = loadXRegisterAbsolute
executeInstruction 0xCC = compareY
--executeInstruction 0xD0 = branchNotEqual
executeInstruction 0xEA = noOperation
executeInstruction 0xEC = compareX
executeInstruction 0xEE = increment
--executeInstruction 0xF0 = branchEqual
--executeInstruction 0xFF = systemCall

compareY :: CpuState ()
compareY = do
  address <- loadShortProgramCounterImmediate
  memory <- gets memory
  let value = getByte address memory
  modify (\cpu -> cpu
    { status = (status cpu) { zFlag = ((yRegister cpu) == value) } } )
  return ()

compareX :: CpuState ()
compareX = do
  address <- loadShortProgramCounterImmediate
  memory <- gets memory
  let value = getByte address memory
  modify (\cpu -> cpu
    { status = (status cpu) { zFlag = ((xRegister cpu) == value) } } )
  return ()

increment :: CpuState ()
increment = do
  address <- loadShortProgramCounterImmediate
  memory <- gets memory
  let value = getByte address memory
  modify (\cpu -> cpu { memory = setByte address (value + 1) memory })
  return ()

noOperation :: CpuState ()
noOperation = return ()

-- Transfer instructions

transferXRegisterToAccumulator :: CpuState ()
transferXRegisterToAccumulator
  = transferRegisterToRegister xRegister setAccumulator

transferYRegisterToAccumulator :: CpuState ()
transferYRegisterToAccumulator
  = transferRegisterToRegister yRegister setAccumulator

transferAccumulatorToXRegister :: CpuState ()
transferAccumulatorToXRegister
= transferRegisterToRegister accumulator setXRegister

transferAccumulatorToYRegister :: CpuState ()
transferAccumulatorToYRegister
  = transferRegisterToRegister accumulator setYRegister

-- Load immediate

loadAccumulatorImmediate :: CpuState ()
loadAccumulatorImmediate = loadRegisterImmediate setAccumulator

loadXRegisterImmediate :: CpuState ()
loadXRegisterImmediate = loadRegisterImmediate setXRegister

loadYRegisterImmediate :: CpuState ()
loadYRegisterImmediate = loadRegisterImmediate setYRegister

-- Load Absolute

loadAccumulatorAbsolute :: CpuState ()
loadAccumulatorAbsolute = loadRegisterAbsolute setAccumulator

loadYRegisterAbsolute :: CpuState ()
loadYRegisterAbsolute = loadRegisterAbsolute setYRegister

loadXRegisterAbsolute :: CpuState ()
loadXRegisterAbsolute = loadRegisterAbsolute setXRegister

-- Store Absolute

storeAccumulatorAbsolute :: CpuState ()
storeAccumulatorAbsolute = storeRegisterAbsolute accumulator

storeXRegisterAbsolute :: CpuState ()
storeXRegisterAbsolute = storeRegisterAbsolute xRegister

storeYRegisterAbsolute:: CpuState ()
storeYRegisterAbsolute = storeRegisterAbsolute yRegister

jump :: CpuState ()
jump = do
  address <- loadShortProgramCounterImmediate
  modify (\cpu -> cpu { programCounter = address })
  return ()

Super basic arithmetic parser:

Code:

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative ((<|>))
import Data.Attoparsec.Text
import System.Environment
import Data.Text

data Expression = Expression Int Op Expression |
                  Value Int
                  deriving (Show)

data Op = Add | Subtract | Divide | Multiply deriving (Show)

eval :: Expression -> Int
eval (Expression x Add y)       = x + (eval y)
eval (Expression x Subtract y)  = x - (eval y)
eval (Expression x Divide y)    = x `quot` (eval y)
eval (Expression x Multiply y)  = x * (eval y)
eval (Value x)                  = x

parseValue :: Parser Int
parseValue = decimal

parseExpression :: Parser Expression
parseExpression =
       (parseValue >>= \p1 ->
        parseOp >>= \p2 ->
        parseExpression >>= \p3 ->
        return (Expression p1 p2 p3))

   <|> (parseValue >>= \p1 ->
        return (Value p1))

parseOp :: Parser Op
parseOp =
        (char '+' >> return Add)
    <|> (char '-' >> return Subtract)
    <|> (char '/' >> return Divide)
    <|> (char '*' >> return Multiply)

test :: String -> IO ()
test string =
    case parseOnly parseExpression (pack string) of
        (Left a) -> print a
        (Right a) -> print (eval a)

main :: IO ()
main = do
    args <- getArgs
    (print (parseOnly parseExpression (pack (args !! 0))))

 

Triggered

 

LOLOL @Sythe, fun times

 

I wrote a very basic IRC daemon in Golang that doesn't mean I'm a Golang programmer, feel me? Semantics, maybe, but to me there's a difference between writing some entry-level undergrad scripts and minimalist programs compared to being an actual programmer in the language.

 

Omg Syed this is why I have always loved you forever! Omg... Im dying

 

if not being a function is code smell

 

I'll come back with my full parser done and we'll see where you stand.

Also I develop AngularJS professionally and I'd say I know Haskell better than that lol

 

@SuF DO IT! Whatever it is I am sure itll be great

 

uhg games. but meh maybe. how about i make sexy charts instead?

 

Can I PLEASE change my FUCKING username dammit

 

I'll code whatever the fuck it takes

 

I want to change mine to Pure, but rules holdin' me back fam :L

 

No I can't rules still holdin' me back :L

 

I tried boss. I would really appreciate Delano, but I tried to get the shall dropped and the k lowercased with no luck...

 

I tried boss. I would really appreciate Delano, but I tried to get the shall dropped and the k lowercased with no luck...