]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/src/Voting/Protocol/Utils.hs
cli: admin: directly use election_hash
[majurity.git] / 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