module Potoki.Core.Consume where
import Potoki.Core.Prelude
import qualified Potoki.Core.Fetch as A
newtype Consume input output =
Consume (A.Fetch input -> IO output)
instance Profunctor Consume where
dimap inputMapping outputMapping (Consume consume) =
Consume (\ fetch -> fmap outputMapping (consume (fmap inputMapping fetch)))
instance Choice Consume where
right' (Consume rightConsumeIO) =
Consume $ \ (A.Fetch eitherFetchIO) -> do
fetchedLeftMaybeRef <- newIORef Nothing
consumedRight <-
rightConsumeIO $ A.Fetch $ \ nil just -> join $ eitherFetchIO (return nil) $ \ case
Right !fetchedRight -> return (just fetchedRight)
Left !fetchedLeft -> writeIORef fetchedLeftMaybeRef (Just fetchedLeft) >> return nil
fetchedLeftMaybe <- readIORef fetchedLeftMaybeRef
case fetchedLeftMaybe of
Nothing -> return (Right consumedRight)
Just fetchedLeft -> return (Left fetchedLeft)
instance Functor (Consume input) where
fmap = rmap
instance Applicative (Consume input) where
pure x =
Consume (const (pure x))
(<*>) (Consume leftConsumeIO) (Consume rightConsumeIO) =
Consume $ \ fetch -> do
(leftFetch, rightFetch) <- A.duplicate fetch
rightOutputVar <- newEmptyMVar
forkIO $ do
!rightOutput <- rightConsumeIO rightFetch
putMVar rightOutputVar rightOutput
!leftOutput <- leftConsumeIO leftFetch
rightOutput <- takeMVar rightOutputVar
return (leftOutput rightOutput)
list :: Consume input [input]
list =
Consume $ \ (A.Fetch fetchIO) ->
let
build !acc =
join
(fetchIO
(pure (acc []))
(\ !element -> build (acc . (:) element)))
in build id
sum :: Num num => Consume num num
sum =
Consume $ \ (A.Fetch fetchIO) ->
let
build !acc =
join
(fetchIO
(pure acc)
(\ !element -> build (element + acc)))
in build 0