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

   1 {-# OPTIONS_GHC -fno-warn-orphans #-}
   2 module Voting.Protocol.Utils where
   3
   4 import Control.Applicative (Applicative(..))
   5 import Control.Arrow (first)
   6 import Data.Bool
   7 import Data.Either (Either(..), either)
   8 import Data.Eq (Eq(..))
   9 import Data.Foldable (sequenceA_)
  10 import Data.Function (($), (.))
  11 import Data.Functor ((<$))
  12 import Data.Maybe (Maybe(..), maybe, listToMaybe)
  13 import Data.String (String)
  14 import Data.Traversable (Traversable(..))
  15 import Data.Tuple (uncurry)
  16 import Numeric.Natural (Natural)
  17 import Prelude (Integer, fromIntegral)
  18 import qualified Data.Aeson.Internal as JSON
  19 import qualified Data.List as List
  20 import qualified System.Random as Random
  21 import qualified Text.ParserCombinators.ReadP as Read
  22 import qualified Text.Read as Read
  23
  24 -- | Like ('.') but with two arguments.
  25 o2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d
  26 o2 f g = \x y -> f (g x y)
  27 infixr 9 `o2`
  28 {-# INLINE o2 #-}
  29
  30 -- | NOTE: check the lengths before applying @f@.
  31 isoZipWith :: (a->b->c) -> [a]->[b]->Maybe [c]
  32 isoZipWith f as bs
  33  | List.length as /= List.length bs = Nothing
  34  | otherwise = Just (List.zipWith f as bs)
  35
  36 -- | NOTE: check the lengths before applying @f@.
  37 isoZipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->Maybe [d]
  38 isoZipWith3 f as bs cs
  39  | al /= List.length bs = Nothing
  40  | al /= List.length cs = Nothing
  41  | otherwise = Just (List.zipWith3 f as bs cs)
  42  where al = List.length as
  43
  44 isoZipWithM ::
  45  Applicative f =>
  46  f () -> (a->b->f c) -> [a]->[b]->f [c]
  47 isoZipWithM err f as bs =
  48         maybe ([] <$ err) sequenceA $
  49                 isoZipWith f as bs
  50
  51 isoZipWithM_ ::
  52  Applicative f =>
  53  f () -> (a->b->f c) -> [a]->[b]->f ()
  54 isoZipWithM_ err f as bs =
  55         maybe err sequenceA_ $
  56                 isoZipWith f as bs
  57
  58 isoZipWith3M ::
  59  Applicative f =>
  60  f () -> (a->b->c->f d) -> [a]->[b]->[c]->f [d]
  61 isoZipWith3M err f as bs cs =
  62         maybe ([] <$ err) sequenceA $
  63                 isoZipWith3 f as bs cs
  64
  65 isoZipWith3M_ ::
  66  Applicative f =>
  67  f () -> (a->b->c->f d) -> [a]->[b]->[c]->f ()
  68 isoZipWith3M_ err f as bs cs =
  69         maybe err sequenceA_ $
  70                 isoZipWith3 f as bs cs
  71
  72 -- * JSON utils
  73
  74 -- | Copied from 'Data.Aeson''s 'eitherFormatError'
  75 -- which is not exported.
  76 jsonEitherFormatError :: Either (JSON.JSONPath, String) a -> Either String a
  77 jsonEitherFormatError = either (Left . uncurry JSON.formatError) Right
  78 {-# INLINE jsonEitherFormatError #-}
  79
  80 instance Random.Random Natural where
  81         randomR (mini,maxi) =
  82                 first (fromIntegral::Integer -> Natural) .
  83                 Random.randomR (fromIntegral mini, fromIntegral maxi)
  84         random = first (fromIntegral::Integer -> Natural) . Random.random
  85
  86 -- * Parsing utils
  87
  88 parseReadP :: Read.ReadP a -> String -> Maybe a
  89 parseReadP p s =
  90         let p' = Read.readP_to_S p in
  91         listToMaybe $ do
  92                 (x, "") <- p' s
  93                 pure x