hjugement-protocol/src/Voting/Protocol/Utils.hs

   1 module Voting.Protocol.Utils where
   2
   3 import Control.Applicative (Applicative(..))
   4 import Data.Bool
   5 import Data.Eq (Eq(..))
   6 import Data.Foldable (sequenceA_)
   7 import Data.Function (($))
   8 import Data.Functor ((<$))
   9 import Data.Maybe (Maybe(..), maybe)
  10 import Data.Traversable (Traversable(..))
  11 import qualified Data.List as List
  12
  13 -- | Like ('.') but with two arguments.
  14 o2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d
  15 o2 f g = \x y -> f (g x y)
  16 infixr 9 `o2`
  17 {-# INLINE o2 #-}
  18
  19 -- | NOTE: check the lengths before applying @f@.
  20 isoZipWith :: (a->b->c) -> [a]->[b]->Maybe [c]
  21 isoZipWith f as bs
  22  | List.length as /= List.length bs = Nothing
  23  | otherwise = Just (List.zipWith f as bs)
  24
  25 -- | NOTE: check the lengths before applying @f@.
  26 isoZipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->Maybe [d]
  27 isoZipWith3 f as bs cs
  28  | al /= List.length bs = Nothing
  29  | al /= List.length cs = Nothing
  30  | otherwise = Just (List.zipWith3 f as bs cs)
  31  where al = List.length as
  32
  33 isoZipWithM ::
  34  Applicative f =>
  35  f () -> (a->b->f c) -> [a]->[b]->f [c]
  36 isoZipWithM err f as bs =
  37         maybe ([] <$ err) sequenceA $
  38                 isoZipWith f as bs
  39
  40 isoZipWithM_ ::
  41  Applicative f =>
  42  f () -> (a->b->f c) -> [a]->[b]->f ()
  43 isoZipWithM_ err f as bs =
  44         maybe err sequenceA_ $
  45                 isoZipWith f as bs
  46
  47 isoZipWith3M ::
  48  Applicative f =>
  49  f () -> (a->b->c->f d) -> [a]->[b]->[c]->f [d]
  50 isoZipWith3M err f as bs cs =
  51         maybe ([] <$ err) sequenceA $
  52                 isoZipWith3 f as bs cs
  53
  54 isoZipWith3M_ ::
  55  Applicative f =>
  56  f () -> (a->b->c->f d) -> [a]->[b]->[c]->f ()
  57 isoZipWith3M_ err f as bs cs =
  58         maybe err sequenceA_ $
  59                 isoZipWith3 f as bs cs
  60