Merge pull request #1 from RoboNickBot/cleanup

Cleanup

Author: octalsrc

README.md

@@ -0,0 +1,45 @@
+# A Gentle Introduction to Linked Lists
+
+An interactive web-page demonstration of Linked Lists and how they are
+stored in memory based (very very closely) on a Java Applet written by
+[Michael Goldwasser](http://mathcs.slu.edu/~goldwasser/)
+
+This was written as a SLU Senior Capstone Project for Fall 2014 and is
+released under a BSD-style two-clause license (see
+[LICENSE](LICENSE)).
+
+It's now finished as far as the assignment goes, so I guess
+pull-requests are welcome!  I've added a
+[feature backlog](backlog.org) if you want ideas for contribution.
+
+#### Building
+
+You'll need to build the [GHCJS](https://github.com/GHCJS/GHCJS)
+(which is kind of a pain right now).  Follow that link for
+instructions.
+
+When you have GHCJS, just ```make``` and then install any dependencies
+that cabal asks for (oh yeah, you also need cabal-install) and then
+```make``` again and it should work.
+
+The files should all end up in a folder called
+```linked-list-dist```.  Navigating a web-browser to
+```linked-list-dist/index.html``` will give you the demo.
+
+#### Other ways to use it
+
+Since building is a pain, you can also grab a ```.tgz``` from
+[releases](https://github.com/RoboNickBot/linked-list-web-demo/releases)
+or (for now) go to
+[Linked List Demo](http://octalsrc.net/demos/linked_list.html)
+
+#### Code Guide
+
+This is written in Haskell and uses the JQuery and Canvas libraries
+from the [GHCJS project](https://github.com/ghcjs) as well as
+[Reactive-Banana](https://www.haskell.org/haskellwiki/Reactive-banana)
+for some minimal FRP business.
+
+All the JQuery and Canvas things are in ```JS.hs``` and all FRP
+happens in ```LinkedListDemo.hs``` (which is also the Main file).
+List parsing and Layout generation happens in ```Links.hs```.

backlog.org

@@ -0,0 +1,21 @@
+Some features I intend to implement: 
+
+(this is an Emacs Org-Mode notes file; I'm sorry if GitHub renders it
+weirdly)
+
+* Improve randomInput function
+  Empty cells tend to bunch up at the end
+
+* Highlight cell-drawing relationships
+  On mouse-over of boxes and arrows in the drawn list, they and the
+  cell in the memory-edit area that they represent should highlight in
+  some way as a quick indication of their relationship
+
+* Improve sizing and centering of drawing area
+** Properly center the drawn lists in the drawing area
+** Get rid of that white-space at the bottom of the screen
+   (while making sure not to make a scroll-bar appear)
+** Make the drawing auto-resize whenever the window-size changes
+
+* General re-factoring
+  Particularly in JS.hs, it's kind of a mess in there

src/Demo/Links.hs

@@ -16,19 +16,20 @@ import qualified Data.List as L (delete, length)
 randomEmptyCells = 2 :: Int
 randomValueRange = ('A','Z')
 
-{- I think there is a lot of refactoring-opportunity in here,
-   especially concerning the use of monads, but we'll leave that
-   for later.
+{- I think there is a lot of refactoring-opportunity in this file,
+   especially concerning the use of monads for parsing, but we'll 
+   leave that for later.
    -}
 
-mismatches :: InputState -> InputState -> (Bool,[Int])
-mismatches (InSt i1 s1 h1 m1) (InSt i2 s2 h2 m2) = 
+mismatches :: InputState -> Maybe InputState -> (Bool,[Int])
+mismatches (InSt i1 s1 h1 m1) (Just (InSt i2 s2 h2 m2)) = 
   let headChanged = h1 /= h2
       f = (matchIndex m1 m2)
   in (headChanged, (foldr 
                      f
                      []
                      [i1 .. (i1 + s1 - 1)] ))
+mismatches _ _ = (False,[]) -- if last InSt is Nothing, no change
 
 matchIndex :: M.Map Int Cell -> M.Map Int Cell -> Int -> [Int] -> [Int]
 matchIndex c b i is = let f m = (fmap snd (M.lookup i m)) 
@@ -76,9 +77,9 @@ box _ _ = []
 {- Failure for arrow: (end list)
    1. the arrow cell is empty/non-existant
    2. the value of the arrow cell is not an Int
-   2. the cell which the arrow points to is empty/invalid
+   3. the cell which the arrow points to is empty/invalid
    Special failure: (add loopback and end list)
-   3. the cell which the arrow points to is already seen
+   4. the cell which the arrow points to is already seen
    -}
 arrow :: Step
 arrow (m,s) (Just (i,val)) = 

src/Demo/Types.hs

@@ -1,3 +1,5 @@
+{- Some types and constructors for the project -}
+
 module Demo.Types ( InputState (..)
                   , emptyInput
                   , emptyCell
@@ -15,23 +17,23 @@ module Demo.Types ( InputState (..)
 
 import qualified Data.Map as M (Map, empty, lookup, insert)
 
-{- Here's a map of how these types are used:
+{- Here's a map of how the main types are used:
 
-   InputState ---> Diagram ---> Layout ----*----> Drawable
+   InputState ---> Diagram ---> Layout ----*----> LayoutD
                                           /
                  (canvas dimensions) ----*
 -}
 
--- (Cell Index, Cell contents)
+-- (cell Index, cell contents)
 type Cell = (Int, String)
--- M.Map (Cell Index) Cell
+-- M.Map (cell Index) Cell
 type MemSt = M.Map Int Cell
 
 mkMemSt :: [Cell] -> MemSt
 mkMemSt = foldr (\(i,s) -> M.insert i (i,s)) M.empty
 
 {- InputState: The current state of all the inputs on the
-               the webpage right now -}
+               the webpage  -}
 data InputState = InSt { startIndex :: Int
                        , cellCount :: Int
                        , headVal :: String
@@ -65,4 +67,6 @@ type LElem = (DElem, (Int, Int), (Int, Int))
            unit-size -}
 type Layout = [LElem]
 
+{- LayoutD: The Layout transformed with the scale-size as a Double
+            replacing the previous unit-size Ints -}
 type LayoutD = [(DElem, (Double, Double), (Double, Double))]

src/LinkedListDemo.hs

@@ -14,18 +14,22 @@ defaultHeadIndex = 23
 defaultNumCells = 14
 
 main = do initializePage (defaultHeadIndex, defaultNumCells)
-          (draw, rando, gener, clicks, keys) <- mkSources
-          wireButton draw sDrawButton (cullErrors >> readInputState)
+          
+          -- init and connect reactive event-sources
+          (draw, rando, gener, clicks, keys) <- mkSources 
+          wireButton draw sDrawButton (cullErrors
+                                       >> readInputState)
           wireButton rando sRandomButton (cullErrors 
                                           >> mkCanvas
-                                          >>mkRandomInput
+                                          >> mkRandomInput
                                           >> readInputState)
-          wireButton 
-            gener 
-            sCellGen 
-            (cullErrors >> generateCells >> readInputState)
-          wireClicks clicks
+          wireButton gener sCellGen (cullErrors 
+                                     >> generateCells
+                                     >> readInputState)
+          wireClicks clicks -- does nothing for now
           wireKeys keys readInputState
+          
+          -- build and "actuate" the reactive event network
           n <- compile (mkNetwork (draw, rando, gener, clicks, keys))
           actuate n
 
@@ -36,6 +40,8 @@ generateCells =
        Right (start,size) -> initializePage (start,size)
        Left err -> printHighError err
 
+{- Tests number of cells and starting index to make sure they're valid.
+   Readability as Ints was already checked for in JS.hs code -}
 checkGenInfo :: (Int,Int) -> Either String (Int,Int)
 checkGenInfo (i,s) 
   | i < 0 = Left "Starting Index cannot be negative"
@@ -48,50 +54,76 @@ initializePage (start,size) =
   >> mkCanvas
 
 wireClicks _ = return () -- maybe implement this later?
+
+-- Events responding to keypresses in the memory editing area
 wireKeys (addHandler, fire) f = do let handler _ = f >>= fire
                                    box <- sLowerControls
                                    keyup handler def box
 
+-- convenience function for wiring all the buttons
 wireButton (addHandler, fire) button f = do 
   let handler _ = f >>= fire
   b <- button
   click handler def b
 
+-- sources are in the IO monad, so we have to do this?
 mkSources = do a <- newAddHandler
                b <- newAddHandler
                c <- newAddHandler
                d <- newAddHandler
                e <- newAddHandler
                return (a,b,c,d,e)
 
+-- convenience
 addHandler = fst
 fire = snd
 
-mkNetwork (drawSource, randomSource, genSource, clickSource, keySource) = do 
+{- And now the fun stuff, describes the reactive "signal graph" of
+    events and behaviors, mainly used here to control when cells
+    are highlighted to show that they have been edited -}
+mkNetwork ( drawSource
+          , randomSource
+          , genSource
+          , clickSource
+          , keySource ) = do 
+
   eDraws <- fromAddHandler (addHandler drawSource)
   eRandoms <- fromAddHandler (addHandler randomSource)
   eGens <- fromAddHandler (addHandler genSource)
   eKeys <- fromAddHandler (addHandler keySource)
-  let eResets = eRandoms `union` eGens
+  
+  let -- some useful collections of event-sources
+      eResets = eRandoms `union` eGens
       eInputs = eRandoms `union` eGens `union` eKeys
-      --bInputState :: Behavior t InputState 
-      bInputState = stepper (emptyInput 5 20) eInputs
-      eDrawnInputState = bInputState <@ eDraws
-      bLastInputState = stepper (emptyInput 5 20)
-                                (eDrawnInputState `union` eResets)
+      
+      -- convenience for processing LastInputStates
+      bNothing :: Behavior t (Maybe InputState)
+      bNothing = pure Nothing
+      -- clicking 'draw' should only count if it actually draws
+      bTest :: Behavior t (InputState -> Maybe InputState)
+      bTest = pure (\inState -> case parseInput inState of
+                                  Left _ -> Nothing
+                                  Right _ -> Just inState)
+
+      bInputState = stepper (emptyInput 5 20) eInputs 
+      bLastInputState = 
+        stepper Nothing
+                ((bTest <@> eDraws) `union` (bNothing <@ eResets))
       bDirty = mismatches <$> bInputState <*> bLastInputState
+  
   cIn <- changes bInputState
   cLIn <- changes bLastInputState
   cDirty <- changes bDirty
 
-
-  --reactimate' $ fmap (\is -> process is) eISChanged
-  --reactimate' <$> (fmap (fmap process) eISChanged)
+  -- Draw the list!
   reactimate (fmap (\a -> mkCanvas >> process a) eDraws)
-  reactimate' $ fmap (\d -> mark d >> print (show d) >> return ()) <$> cDirty
+  -- Mark the "dirty" edited cells (or unmark them if clean)
+  reactimate' (fmap (\d -> mark d >> return ()) <$> cDirty)
+
+  -- (These are for debugging purposes and print only to the console)
   reactimate' $ fmap (\d -> print ("InputState: " ++ show d)) <$> cIn
   reactimate' $ fmap (\d -> print ("LastState: " ++ show d)) <$> cLIn
-  --reactimate (fmap (\_ -> fmap process bInputState) eDraws)
+
 
 process :: InputState -> IO ()
 process = displayOutput . fmap mkLayout . parseInput