Skip to content

Instantly share code, notes, and snippets.

™️
Jonathaning

Jonathan Fischoff jfischoff

™️
Jonathaning
  • San Diego
Block or report user

Report or block jfischoff

Hide content and notifications from this user.

Learn more about blocking users

Contact Support about this user’s behavior.

Learn more about reporting abuse

Report abuse
View GitHub Profile
View Lastoid.hs
-- I think this is a a monoid. Basically it is used to either mappend to a value or replace the value
data Lastoid a = Replace a | Mappend a | Nope
instance Semigroup a => Semigroup (Lastoid a) where
x <> y = case (x, y) of
(r@Replace {}, _ ) -> r
(Mappend a , Replace b) -> Replace $ a <> b
(Mappend a , Mappend b) -> Mappend $ a <> b
(Nope , x ) -> x
View WorkflowTest.hs
type WidgetFlow t m a = Workflow t (VtyWidget t m) a
testScreen
:: (Reflex t, Show a, Show b, Monad m)
=> a
-- ^ Input
-> (a -> VtyWidget t m (Event t b))
-- ^ Screen to test
-> (b -> WidgetFlow t m ())
-- ^ Next continuation
View advance.hs
-- What I am struggling to do is sequence to looping things. First I have a loop where the output is feed into the
-- next step as input until it completes. Then the next loop starts.
-- I doubt this works ... I'm trying to test it now ... anyway I don't like it and feel like
-- there must be an easier way.
advance :: (Adjustable t m, MonadHold t m, Monad m, MonadFix m)
=> m (Event t (Maybe a))
-- ^ initial
-> (a -> m (Event t (Maybe a)))
View delayOne.hs
delayOne :: (MonadHold t m, Reflex t) => Event t a -> m (Event t (a, a))
delayOne e = do
b <- hold Nothing $ Just <$> e
let eOld = W.catMaybes $ b <@ e
pure $ liftF2 (,) eOld e
@jfischoff
jfischoff / Fold.hs
Created Jul 15, 2019
Fold like thing with termination
View Fold.hs
-- The idea is to compose fold like things that can terminate. This is primarily so I can
-- make a Alternative instance that returns the first finished fold.
-- I copied much of this from foldl and folds but unlike those libraries you cannot call the `extractor` until the
-- fold is finished.
data StepState = Running | Finished
deriving (Eq, Show, Ord, Read, Generic)
anyFinished :: StepState -> StepState -> StepState
anyFinished x y = case (x, y) of
View relative filepath thingy
{-# LANGUAGE RecordWildCards #-}
module TH where
import Language.Haskell.TH
import System.FilePath
import Control.Monad ((<=<))
import System.Directory (getCurrentDirectory, canonicalizePath)
fileRelativeToAbsolute :: String -> Q Exp
fileRelativeToAbsolute = stringE <=< fileRelativeToAbsoluteStr
@jfischoff
jfischoff / WaitFor.hs
Created Sep 15, 2017
Common wait for a socket function
View WaitFor.hs
waitForServer :: Int -> IO ()
waitForServer port = handle (\(_ :: IOException) -> waitForServer port) $ do
let hints = S.defaultHints { S.addrFlags = [ S.AI_NUMERICHOST
, S.AI_NUMERICSERV
]
, S.addrSocketType = S.Stream
}
addr:_ <- S.getAddrInfo (Just hints) (Just "127.0.0.1") (Just $ show port)
bracket (S.socket (S.addrFamily addr) (S.addrSocketType addr) (S.addrProtocol addr))
S.close
View SimpleDBSpec.hs
{-# LANGUAGE QuasiQuotes #-}
module SimpleDBSpec (spec, main) where
import Database.PostgreSQL.Simple.SqlQQ
import qualified Database.PostgreSQL.Simple as Simple
import Database.PostgreSQL.Transact
import Test.Hspec (Spec, hspec)
import Test.Hspec.Expectations.Lifted
import Test.Hspec.DB
import Control.Monad
View Wait For Port
waitForPort :: Int -> IO ()
waitForPort port = handle (\(_ :: IOException) -> threadDelay 10000 >> waitForDB port) $ do
let hints = defaultHints
{ addrFlags =
[ AI_NUMERICHOST
, AI_NUMERICSERV
]
, addrSocketType = Stream
}
addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just $ show port)
View TCPStateTransitions.hs
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE LambdaCase #-}
module Network.TCP where
import Data.Set (Set)
data PacketFlag = NS | CWR | ECE | URG | ACK | PSH | RST | SYN | FIN
deriving (Eq, Show, Ord)
type Packet = Set PacketFlag
You can’t perform that action at this time.