hjugement-protocol/Protocol/Utils.hs

   1 module Protocol.Utils where
   2 import Control.Applicative (Applicative(..), Alternative(..))
   3 import Control.Monad (Monad(..), join, mapM, unless, zipWithM)
   4 import Control.Monad.Trans.Class (MonadTrans(..))
   5 import Data.Bool
   6 import Data.Either (either)
   7 import Data.Eq (Eq(..))
   8 import Data.Foldable (Foldable, foldMap, and, sequenceA_)
   9 import Data.Function (($), id, const)
  10 import Data.Functor (Functor, (<$>), (<$))
  11 import Data.Functor.Identity (Identity(..))
  12 import Data.Functor.Compose (Compose(..))
  13 import Data.Maybe (Maybe(..), maybe, fromMaybe)
  14 import Data.Ord (Ord(..))
  15 import Data.Semigroup (Semigroup(..))
  16 import Data.Text (Text)
  17 import Data.Traversable (Traversable(..))
  18 import Data.Tuple (fst, snd, uncurry)
  19 import GHC.Natural (minusNaturalMaybe)
  20 import Numeric.Natural (Natural)
  21 import Prelude (fromIntegral)
  22 import Text.Show (Show(..))
  23 import Control.Monad.Trans.Maybe (MaybeT(..))
  24 import qualified Control.Monad.Trans.Except as Exn
  25 import qualified Control.Monad.Trans.State.Strict as S
  26 import qualified Data.ByteString as BS
  27 import qualified Data.List as List
  28
  29 -- | NOTE: check the lengths before applying @f@.
  30 isoZipWith :: (a->b->c) -> [a]->[b]->Maybe [c]
  31 isoZipWith f as bs
  32  | List.length as /= List.length bs = Nothing
  33  | otherwise = Just (List.zipWith f as bs)
  34
  35 -- | NOTE: check the lengths before applying @f@.
  36 isoZipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->Maybe [d]
  37 isoZipWith3 f as bs cs
  38  | al /= List.length bs = Nothing
  39  | al /= List.length cs = Nothing
  40  | otherwise = Just (List.zipWith3 f as bs cs)
  41  where al = List.length as
  42
  43 isoZipWithM ::
  44  Applicative m =>
  45  m () ->
  46  (a -> b -> m c) ->
  47  [a] -> [b] -> m [c]
  48 isoZipWithM err f as bs =
  49         maybe ([] <$ err) sequenceA $
  50                 isoZipWith f as bs
  51
  52 isoZipWith3M ::
  53  Applicative m =>
  54  m () ->
  55  (a -> b -> c -> m d) ->
  56  [a] -> [b] -> [c] -> m [d]
  57 isoZipWith3M err f as bs cs =
  58         maybe ([] <$ err) sequenceA $
  59                 isoZipWith3 f as bs cs
  60
  61 isoZipWith3M_ ::
  62  Applicative m =>
  63  m () ->
  64  (a -> b -> c -> m d) ->
  65  [a] -> [b] -> [c] ->
  66  m ()
  67 isoZipWith3M_ err f as bs cs =
  68         maybe err sequenceA_ $
  69                 isoZipWith3 f as bs cs
  70