jfischoff

2019-12-29 21:13:35 GMT [42602]: LOG:  duration: 2.476 ms  plan:
	Query Text: INSERT INTO users (email, password, name) VALUES ('example@example1.com', 'password', 'name1') RETURNING id
	Insert on public.users  (cost=0.00..0.02 rows=1 width=382) (actual time=2.471..2.472 rows=1 loops=1)
	  Output: id
	  Buffers: shared hit=9 read=11 dirtied=9
	  I/O Timings: read=1.879
	  ->  Result  (cost=0.00..0.02 rows=1 width=382) (actual time=1.100..1.100 rows=1 loops=1)
	        Output: nextval('users_id_seq'::regclass), clock_timestamp(), clock_timestamp(), 'example@example1.com'::character varying(140), '\x70617373776f7264'::bytea, 'name1'::text
	        Buffers: shared hit=9 read=4 dirtied=2
	        I/O Timings: read=1.028

jfischoff

aroundAll :: forall a. ((a -> IO ()) -> IO ()) -> SpecWith a -> Spec
aroundAll withFunc specWith = do
  (var, stopper, asyncer) <- runIO $
    (,,) <$> newEmptyMVar <*> newEmptyMVar <*> newIORef Nothing
  let theStart :: IO a
      theStart = do

        thread <- async $ do
          withFunc $ \x -> do
            putMVar var x

jfischoff

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

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 

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

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

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

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

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