Skip to content

Instantly share code, notes, and snippets.

@mergeconflict
Created June 24, 2012 19:09
Show Gist options
  • Save mergeconflict/2984512 to your computer and use it in GitHub Desktop.
Save mergeconflict/2984512 to your computer and use it in GitHub Desktop.
*sigh*
module Main (main) where
import Control.Monad.RWS
import Control.Monad.Writer
import Data.Binary.Builder
import qualified Data.ByteString.Lazy as Lazy
import Data.Hashable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as Map
-- import Data.Map (Map)
-- import qualified Data.Map as Map
import Data.Word
data Node = Node
{ val :: Word8
, next :: Node
}
instance Eq Node where
Node a _ == Node b _ = a == b
instance Ord Node where -- for use in Data.Map
Node a _ < Node b _ = a < b
instance Hashable Node where -- for use in Data.HashMap.Lazy
hash (Node a _) = fromIntegral a
type M = HashMap Node Word8
-- type M = Map Node Word8
type Encoder = RWST M M Word8 (Writer Builder) ()
runEncoder :: Encoder -> [Word8]
runEncoder rwst =
let knot ~(_, _, m) = runRWST rwst m 0
(_, b) = runWriter $ mfix knot
in Lazy.unpack $ toLazyByteString b
encodeNode :: Node -> Encoder
encodeNode n = do
pos <- get
put $ pos + 1
m <- ask
tell $ Map.singleton n pos
let valbuilder = singleton $ val n
nextbuilder = singleton $ m Map.! (next n)
lift . tell $ valbuilder <> nextbuilder
encodeCycle :: Encoder
encodeCycle =
let n0 = Node 0 n1
n1 = Node 1 n0
in do
encodeNode n0
encodeNode n1
main :: IO ()
main = putStrLn . show . runEncoder $ encodeCycle
name: test
version: 0.1
build-type: Simple
cabal-version: >= 1.2
executable test
hs-source-dirs: src
build-depends: base,
binary,
bytestring,
containers,
hashable,
unordered-containers,
mtl
ghc-options: -Wall
main-is: Main.hs
@danr
Copy link

danr commented Jul 7, 2012

No! It's <= or compare :) Cheers!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment