rizary’s gists

rizary / Main.hs

Created July 5, 2019 03:14

	bodyElement4 = do
	...
	RoutePackage pn -> pure $ do
	...
	addTag0 <- elClass "form" "form" $ do
	el "p" $ text "Tag : "
	tagName <- textInput iCfg
	tagButton <- button_ "Add Tag"
	let tVal = _textInput_value tagName
	evAdd = (tagPromptlyDyn tVal tagButton)

rizary / button.hs

Created July 5, 2019 03:14

	button_ :: forall t m a. (DomBuilder t m, PostBuild t m) => T.Text -> m (Event t ())
	button_ t = do
	let cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))
	& elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault)
	(e, _) <- element "button" cfg $ text t
	pure $ domEvent Click e

rizary / wrong.hs

Created July 5, 2019 06:06

	tagsMapDyn <- elClass "p" "tagging" $ mdo
	let evMapTags = Map.fromList . (fmap (\t -> (t,t))) . (fmap tagNToText) . V.toList <$> evPkgTags
	result <- foldDyn Map.union Map.empty $ fold
	[ evMapTags
	, addTag0
	, deleteTag0
	]
	deleteTag0 :: Event t (Map.Map T.Text T.Text) <- listViewWithKey result $ \tId tag' -> do
	-- tagDyn <- holdUniqDyn tag'
	el "li" $ do

rizary / ghci-ben.hs

Created July 5, 2019 06:21

	GHCi, version 8.6.4: http://www.haskell.org/ghc/ :? for help
	Prelude> import qualified Data.Map as Map
	Prelude Map> import Data.Monoid.Endo
	Prelude Map Data.Monoid.Endo> let m = Map.fromList [("A",'a'),("B",'b'),("C",'c')]
	Prelude Map Data.Monoid.Endo> let deleteA = Endo $ Map.delete "A"
	Prelude Map Data.Monoid.Endo> let deleteC = Endo $ Map.delete "C"
	Prelude Map Data.Monoid.Endo> appEndo deleteA m
	fromList [("B",'b'),("C",'c')]
	Prelude Map Data.Monoid.Endo> appEndo deleteC m
	fromList [("A",'a'),("B",'b')]

rizary / working-tag.hs

Created July 5, 2019 11:48

	tagsMapDyn <- elClass "p" "tagging" $ mdo
	let evMapTags = Map.fromList . (fmap (\t -> (t,t))) . (fmap tagNToText) . V.toList <$> evPkgTags
	result <- foldDyn appEndo Map.empty $ fold
	[ Endo . const <$> evMapTags
	, (\nTag -> Endo $ Map.insert nTag nTag) <$> addTag0
	, (foldMap (Endo . Map.delete) . Map.keys) <$> deleteTag0
	]
	deleteTag0 :: Event t (Map.Map T.Text T.Text) <- listViewWithKey result $ \tId _ -> do
	el "li" $ do
	el "span" $ text tId

rizary / Api.hs

Created July 6, 2019 00:32

	type API = "v2" :> "idxstates" :> "latest" :> Get '[JSON] PkgIdxTs
	:<\|> "v2" :> "info" :> Get '[JSON] ControllerInfo -- static meta-information
	:<\|> "v2" :> "packages" :> Get '[JSON] (Vector PkgN)
	:<\|> "v2" :> "packages" :> "*" :> "history" :> QueryParam "min" PkgIdxTs :> QueryParam "max" PkgIdxTs :> Get '[JSON] (Vector IdxHistoryEntry)
	...

	--- The following Type API is heavily inspired by QFPL's reflex-realworld-example: https://github.com/qfpl/reflex-realworld-example
	getV2IdxStates :: SupportsServantReflex t m => Event t () -> m (Event t (ReqResult () PkgIdxTs))
	getV2Info :: SupportsServantReflex t m => Event t () -> m (Event t (ReqResult () ControllerInfo))
	getV2Packages :: SupportsServantReflex t m => Event t () -> m (Event t (ReqResult () (Vector PkgN)))

rizary / Route.hs

Created July 16, 2019 09:26

	{-# LANGUAGE ApplicativeDo #-}
	{-# LANGUAGE CPP #-}
	{-# LANGUAGE RecursiveDo #-}
	{-# LANGUAGE StandaloneDeriving #-}
	{-# LANGUAGE ConstraintKinds #-}
	{-# LANGUAGE DefaultSignatures #-}
	{-# LANGUAGE FlexibleContexts #-}
	{-# LANGUAGE FlexibleInstances #-}
	{-# LANGUAGE GADTs #-}
	{-# LANGUAGE KindSignatures #-}

rizary / manageHistory.hs

Created August 19, 2019 23:40

	window <- DOM.currentWindowUnchecked
	location <- Window.getLocation window
	history <- Window.getHistory window
	let getCurrentHistoryItem = HistoryItem
	<$> History.getState history
	<*> getLocationUri location
	item0 <- liftJSM getCurrentHistoryItem
	itemSetInternal <- performEvent $ ffor runCmd $ \cmd -> liftJSM $ do
	runHistoryCommand history cmd
	getCurrentHistoryItem

rizary / runRouteViewT'.hs

Created August 19, 2019 23:42

	window <- DOM.currentWindowUnchecked
	history <- Window.getHistory window
	location <- Window.getLocation window
	oldUri <- (decodeFrag . T.pack . uriFragment) <$> getLocationUri location
	backState <- wrapDomEvent window (`DOM.on` DOM.popState) $ do
	e <- DOM.event
	jV <- PopStateEvent.getState e
	oUri <- liftJSM $ fromJSVal jV
	pure $ decodeFrag $ fromMaybe (T.pack "") oUri
	setState <- performEvent $ attachWith (switchRoutingState' history) (current route) changeStateE

rizary / deepNested.hs

Created August 19, 2019 23:52

rizary rizary