liamoc/Main.hs Secret

## index.html
<!DOCTYPE html>
<html>
  <head>
    <script language="javascript" src="rts.js"></script>
    <script language="javascript" src="lib.js"></script>
    <script language="javascript" src="out.js"></script>
<script src="Sortable.js"></script>
<script>
function createSortableRaw(id,cb) {
  var el = document.getElementById(id);
  Sortable.create(el, {
    animation: 150,
    easing: "cubic-bezier(1, 0, 0, 1)",
    onEnd: function (evt, origevt) {
      cb(evt.newIndex, evt.oldIndex);

      //the code below can be uncommented to get a "working" but not ideal solution

      //var s = Sortable.get(el);
      //var els = s.toArray();
      //var it = els[evt.newIndex];
      //els.splice(evt.newIndex,1);
      //els.splice(evt.oldIndex,0,it);
      //s.sort(els,false);
    },
  });
}
</script>
  <title> Minimal Demo </title>
</head>
  <body>
  </body>
  <script language="javascript" src="runmain.js" defer></script>
</html>

## Main.hs
{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Main where
import Miso
import qualified Miso.String as Miso
import qualified Data.Map as M
import           GHCJS.Foreign.Callback ( Callback )
import qualified GHCJS.Foreign.Callback as JSCallback
import           GHCJS.Marshal ( ToJSVal(..), fromJSValUnchecked )
import           GHCJS.Types ( IsJSVal, JSVal )
import           Miso.Html

foreign import javascript unsafe "createSortableRaw($1, $2);"
  createSortable' :: JSVal -> Callback a -> IO ()

createSortable :: Miso.MisoString -> (Int -> Int -> IO ()) -> IO ()
createSortable d c = do d' <- toJSVal d
                        cb <- JSCallback.syncCallback2 JSCallback.ThrowWouldBlock
                          (\v1 v2 -> do v1' <- fromJSValUnchecked v1; v2' <- fromJSValUnchecked v2; c v1' v2')
                        createSortable' d' cb

main :: IO ()
main = startApp App {..}
  where
    initialAction = Setup
    model         = ["Hello","This","Is","A","Test"]
    update        = updateModel
    view          = viewModel
    events        = defaultEvents
    subs          = []
    mountPoint    = Nothing
    logLevel      = Off

type State = [Miso.MisoString]
data Action = Setup | Noop | MoveItem Int Int
viewModel = div_ [id_ "document"] . map (\(i,s) -> div_ [class_ "item"] [text (Miso.pack (show i)), " : ", text s]) . zip [0..]

updateModel :: Action -> State -> Effect Action State
updateModel Setup = \m -> effectSub m act
  where
    act sink = do
      createSortable "document" (\i1 i2 -> sink (MoveItem i2 i1))
      sink Noop
updateModel Noop = \s -> noEff s
updateModel (MoveItem i j) = \m -> noEff $ act m
  where
    act m = let (lefts,it:rights) = splitAt i m
                (lefts',rights') = splitAt j (lefts ++ rights)
             in lefts' ++ (it:rights')
	<!DOCTYPE html>
	<html>
	<head>
	<script language="javascript" src="rts.js"></script>
	<script language="javascript" src="lib.js"></script>
	<script language="javascript" src="out.js"></script>
	<script src="Sortable.js"></script>
	<script>
	function createSortableRaw(id,cb) {
	var el = document.getElementById(id);
	Sortable.create(el, {
	animation: 150,
	easing: "cubic-bezier(1, 0, 0, 1)",
	onEnd: function (evt, origevt) {
	cb(evt.newIndex, evt.oldIndex);

	//the code below can be uncommented to get a "working" but not ideal solution

	//var s = Sortable.get(el);
	//var els = s.toArray();
	//var it = els[evt.newIndex];
	//els.splice(evt.newIndex,1);
	//els.splice(evt.oldIndex,0,it);
	//s.sort(els,false);
	},
	});
	}
	</script>
	<title> Minimal Demo </title>
	</head>
	<body>
	</body>
	<script language="javascript" src="runmain.js" defer></script>
	</html>
	{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
	module Main where
	import Miso
	import qualified Miso.String as Miso
	import qualified Data.Map as M
	import GHCJS.Foreign.Callback ( Callback )
	import qualified GHCJS.Foreign.Callback as JSCallback
	import GHCJS.Marshal ( ToJSVal(..), fromJSValUnchecked )
	import GHCJS.Types ( IsJSVal, JSVal )
	import Miso.Html

	foreign import javascript unsafe "createSortableRaw($1, $2);"
	createSortable' :: JSVal -> Callback a -> IO ()

	createSortable :: Miso.MisoString -> (Int -> Int -> IO ()) -> IO ()
	createSortable d c = do d' <- toJSVal d
	cb <- JSCallback.syncCallback2 JSCallback.ThrowWouldBlock
	(\v1 v2 -> do v1' <- fromJSValUnchecked v1; v2' <- fromJSValUnchecked v2; c v1' v2')
	createSortable' d' cb

	main :: IO ()
	main = startApp App {..}
	where
	initialAction = Setup
	model = ["Hello","This","Is","A","Test"]
	update = updateModel
	view = viewModel
	events = defaultEvents
	subs = []
	mountPoint = Nothing
	logLevel = Off

	type State = [Miso.MisoString]
	data Action = Setup \| Noop \| MoveItem Int Int
	viewModel = div_ [id_ "document"] . map (\(i,s) -> div_ [class_ "item"] [text (Miso.pack (show i)), " : ", text s]) . zip [0..]

	updateModel :: Action -> State -> Effect Action State
	updateModel Setup = \m -> effectSub m act
	where
	act sink = do
	createSortable "document" (\i1 i2 -> sink (MoveItem i2 i1))
	sink Noop
	updateModel Noop = \s -> noEff s
	updateModel (MoveItem i j) = \m -> noEff $ act m
	where
	act m = let (lefts,it:rights) = splitAt i m
	(lefts',rights') = splitAt j (lefts ++ rights)
	in lefts' ++ (it:rights')