jfischoff

data Edit a
    = Insert a
    | Delete a
    | Same   a 
    deriving (Show, Eq)
    
isSame :: Edit a -> Bool
isSame x = case x of
  Insert {} -> False
  Delete {} -> False

jfischoff

{-# 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

jfischoff

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)

jfischoff

{-# 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

jfischoff

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

jfischoff

{-# 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

-- 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

jfischoff

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

-- 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)))

jfischoff

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