{-# LANGUAGE GADTSyntax, NoMonoLocalBinds #-}
{-# LANGUAGE LambdaCase #-}
module Midair.Handy (
Fx(..)
, runFx
, sPrint
, sPutStrLn
, sMax
, sMaxHS
, sMin
, sMinHS
, sSum
, sSumHS
, sProduct
, sProductHS
, sAnd
, sOr
, sAny
, sAnyHS
, sAll
, sAllHS
, sMappend
, sMappendHS
, sMappendL
, sMappendLHS
, sMappendR
, sMappendRHS
, sToList
, sToListHS
, sElem
, sNotElem
, sMapMaybe
, sFilterWDefault
, sFoldHS
, sCountJust
, sCountJustHS
, sCountJustBy
, sCountJustByHS
, sCountFires
, sCountFiresBy
, sCountFiresByHS
) where
import Midair.Core
import Control.Arrow
import Data.Maybe
import Data.Monoid
data Fx a where
Fx_Void :: IO () -> Fx a
Fx_Return :: IO a -> Fx a
runFx :: Fx a -> IO (Maybe a)
runFx (Fx_Void action) = do
() <- action
return Nothing
runFx (Fx_Return action) = Just <$> action
sFoldHS :: c -> (a -> c -> c) -> (Maybe c -> SFlow a c)
sFoldHS defaultVal foldF = \lastValMay ->
sFold (fromMaybe defaultVal lastValMay) foldF
sPrint :: Show a => SFlow a (Fx b)
sPrint = sMap (Fx_Void . print)
sPutStrLn :: SFlow String (Fx b)
sPutStrLn = sMap (Fx_Void . putStrLn)
sSum :: Num n => SFlow n n
sSum = sFold 0 (+)
sSumHS :: Num n => Maybe n -> SFlow n n
sSumHS =
\x -> sFold (fromMaybe 0 x) (+)
sProduct :: Num n => SFlow n n
sProduct = sFold 1 (*)
sProductHS :: Num n => Maybe n -> SFlow n n
sProductHS =
\x -> sFold (fromMaybe 1 x) (*)
sCountFires :: Num n => SFlow x n
sCountFires = sCountFiresBy 1
sCountFiresBy :: Num n => n -> SFlow x n
sCountFiresBy stepsToCountBy =
sFold 0 $ \_ -> (+stepsToCountBy)
sCountFiresByHS :: Num n => n -> (Maybe n -> SFlow x n)
sCountFiresByHS stepsToCountBy = \lastValMay ->
sFold (fromMaybe 0 lastValMay) $ \_ -> (+stepsToCountBy)
sCountJust :: Num n => SFlow (Maybe a) n
sCountJust = sCountJustBy 1
sCountJustHS :: Num n => Maybe n -> SFlow (Maybe a) n
sCountJustHS = sCountJustByHS 1
sCountJustBy :: Num n => n -> SFlow (Maybe a) n
sCountJustBy stepsToCountBy = sFold 0 $ \case
Nothing -> id
Just _ -> (+ stepsToCountBy)
sCountJustByHS :: Num n => n -> (Maybe n -> SFlow (Maybe a) n)
sCountJustByHS stepsToCountBy = \lastOutput ->
sFold (fromMaybe 0 lastOutput) $ \case
Nothing -> id
Just _ -> (+ stepsToCountBy)
sMax :: Ord x => SFlow x x
sMax = sFoldNoDefault $ \newVal -> \case
Nothing -> newVal
Just oldVal -> max oldVal newVal
sMaxHS :: Ord x => Maybe x -> SFlow x x
sMaxHS = \lastOutMay -> sFoldAccum lastOutMay $ \newVal -> \case
Nothing -> newVal
Just oldVal -> max oldVal newVal
sMin :: Ord x => SFlow x x
sMin = sFoldNoDefault $ \newVal -> \case
Nothing -> newVal
Just oldVal -> min oldVal newVal
sMinHS :: Ord x => Maybe x -> SFlow x x
sMinHS = \lastOutMay -> sFoldAccum lastOutMay $ \newVal -> \case
Nothing -> newVal
Just oldVal -> min oldVal newVal
sMappendR :: Monoid x => SFlow x x
sMappendR = sFold mempty $
\newVal oldVal -> oldVal <> newVal
sMappendRHS :: Monoid x => Maybe x -> SFlow x x
sMappendRHS = \lastOutput ->
sFold (fromMaybe mempty lastOutput) $
\newVal oldVal ->
oldVal <> newVal
sMappendL :: Monoid x => SFlow x x
sMappendL = sFold mempty $
\newVal oldVal -> newVal <> oldVal
sMappendLHS :: Monoid x => Maybe x -> SFlow x x
sMappendLHS = \lastOutput ->
sFold (fromMaybe mempty lastOutput) $
\newVal oldVal ->
newVal <> oldVal
sMappend :: Monoid x => SFlow x x
sMappend = sMappendL
sMappendHS :: Monoid x => Maybe x -> SFlow x x
sMappendHS = sMappendLHS
sAnd :: SFlow Bool Bool
sAnd = sFold True (&&)
sOr :: SFlow Bool Bool
sOr = sFold False (||)
sAny :: (a -> Bool) -> SFlow a Bool
sAny predicate = sFoldNoDefault $ sAnyF predicate
sAnyF :: (a -> Bool) -> a -> (Maybe Bool -> Bool)
sAnyF predicate = \inVal -> \case
Nothing -> predicate inVal
Just False -> predicate inVal
Just True -> True
sAnyHS :: (a -> Bool) -> (Maybe Bool -> SFlow a Bool)
sAnyHS predicate = \lastValMay ->
sFoldAccum lastValMay $ sAnyF predicate
sAll :: (a -> Bool) -> SFlow a Bool
sAll predicate = sFoldNoDefault $ sAllF predicate
sAllF :: (a -> Bool) -> a -> (Maybe Bool -> Bool)
sAllF predicate = \inVal -> \case
Nothing -> predicate inVal
Just False -> False
Just True -> predicate inVal
sAllHS :: (a -> Bool) -> (Maybe Bool -> SFlow a Bool)
sAllHS predicate = \lastValMaybe ->
sFoldAccum lastValMaybe $ sAllF predicate
sToList :: SFlow a [a]
sToList = sFold [] (:)
sToListHS :: Maybe [a] -> SFlow a [a]
sToListHS = \lastValMaybe -> sFold (fromMaybe [] lastValMaybe) (:)
sElem :: Eq x => x -> SFlow x Bool
sElem x = sAny (==x)
sNotElem :: Eq x => x -> SFlow x Bool
sNotElem x = sAll (/=x)
sMapMaybe :: state -> (update -> Maybe state) -> SFlow update state
sMapMaybe startVal maybeF =
sFold startVal f
where
f update previousVal = case maybeF update of
Just x -> x
Nothing -> previousVal
sFilterWDefault :: (b -> Bool) -> b -> SFlow b b
sFilterWDefault f defaultVal =
sMap (fromMaybe defaultVal) <<< sFilter f