{-# OPTIONS_GHC -fno-warn-orphans #-}
module Voting.Protocol.Utils where

import Control.Applicative (Applicative(..))
import Control.Arrow (first)
import Data.Bool
import Data.Either (Either(..), either)
import Data.Eq (Eq(..))
import Data.Foldable (sequenceA_)
import Data.Function (($), (.))
import Data.Functor ((<$))
import Data.Maybe (Maybe(..), maybe, listToMaybe)
import Data.String (String)
import Data.Traversable (Traversable(..))
import Data.Tuple (uncurry)
import Numeric.Natural (Natural)
import Prelude (Integer, fromIntegral)
import qualified Data.Aeson.Internal as JSON
import qualified Data.List as List
import qualified System.Random as Random
import qualified Text.ParserCombinators.ReadP as Read

-- | Like ('.') but with two arguments.
o2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d
o2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d
o2 c -> d
f a -> b -> c
g = \a
x b
y -> c -> d
f (a -> b -> c
g a
x b
y)
infixr 9 `o2`
{-# INLINE o2 #-}

-- | NOTE: check the lengths before applying @f@.
isoZipWith :: (a->b->c) -> [a]->[b]->Maybe [c]
isoZipWith :: (a -> b -> c) -> [a] -> [b] -> Maybe [c]
isoZipWith a -> b -> c
f [a]
as [b]
bs
 | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [a]
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [b]
bs = Maybe [c]
forall a. Maybe a
Nothing
 | Bool
otherwise = [c] -> Maybe [c]
forall a. a -> Maybe a
Just ((a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith a -> b -> c
f [a]
as [b]
bs)

-- | NOTE: check the lengths before applying @f@.
isoZipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->Maybe [d]
isoZipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> Maybe [d]
isoZipWith3 a -> b -> c -> d
f [a]
as [b]
bs [c]
cs
 | Int
al Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [b]
bs = Maybe [d]
forall a. Maybe a
Nothing
 | Int
al Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [c]
cs = Maybe [d]
forall a. Maybe a
Nothing
 | Bool
otherwise = [d] -> Maybe [d]
forall a. a -> Maybe a
Just ((a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
List.zipWith3 a -> b -> c -> d
f [a]
as [b]
bs [c]
cs)
 where al :: Int
al = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [a]
as

isoZipWithM ::
 Applicative f =>
 f () -> (a->b->f c) -> [a]->[b]->f [c]
isoZipWithM :: f () -> (a -> b -> f c) -> [a] -> [b] -> f [c]
isoZipWithM f ()
err a -> b -> f c
f [a]
as [b]
bs =
	f [c] -> ([f c] -> f [c]) -> Maybe [f c] -> f [c]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([] [c] -> f () -> f [c]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
err) [f c] -> f [c]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Maybe [f c] -> f [c]) -> Maybe [f c] -> f [c]
forall a b. (a -> b) -> a -> b
$
		(a -> b -> f c) -> [a] -> [b] -> Maybe [f c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> Maybe [c]
isoZipWith a -> b -> f c
f [a]
as [b]
bs

isoZipWithM_ ::
 Applicative f =>
 f () -> (a->b->f c) -> [a]->[b]->f ()
isoZipWithM_ :: f () -> (a -> b -> f c) -> [a] -> [b] -> f ()
isoZipWithM_ f ()
err a -> b -> f c
f [a]
as [b]
bs =
	f () -> ([f c] -> f ()) -> Maybe [f c] -> f ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f ()
err [f c] -> f ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ (Maybe [f c] -> f ()) -> Maybe [f c] -> f ()
forall a b. (a -> b) -> a -> b
$
		(a -> b -> f c) -> [a] -> [b] -> Maybe [f c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> Maybe [c]
isoZipWith a -> b -> f c
f [a]
as [b]
bs

isoZipWith3M ::
 Applicative f =>
 f () -> (a->b->c->f d) -> [a]->[b]->[c]->f [d]
isoZipWith3M :: f () -> (a -> b -> c -> f d) -> [a] -> [b] -> [c] -> f [d]
isoZipWith3M f ()
err a -> b -> c -> f d
f [a]
as [b]
bs [c]
cs =
	f [d] -> ([f d] -> f [d]) -> Maybe [f d] -> f [d]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([] [d] -> f () -> f [d]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
err) [f d] -> f [d]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Maybe [f d] -> f [d]) -> Maybe [f d] -> f [d]
forall a b. (a -> b) -> a -> b
$
		(a -> b -> c -> f d) -> [a] -> [b] -> [c] -> Maybe [f d]
forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> Maybe [d]
isoZipWith3 a -> b -> c -> f d
f [a]
as [b]
bs [c]
cs

isoZipWith3M_ ::
 Applicative f =>
 f () -> (a->b->c->f d) -> [a]->[b]->[c]->f ()
isoZipWith3M_ :: f () -> (a -> b -> c -> f d) -> [a] -> [b] -> [c] -> f ()
isoZipWith3M_ f ()
err a -> b -> c -> f d
f [a]
as [b]
bs [c]
cs =
	f () -> ([f d] -> f ()) -> Maybe [f d] -> f ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f ()
err [f d] -> f ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ (Maybe [f d] -> f ()) -> Maybe [f d] -> f ()
forall a b. (a -> b) -> a -> b
$
		(a -> b -> c -> f d) -> [a] -> [b] -> [c] -> Maybe [f d]
forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> Maybe [d]
isoZipWith3 a -> b -> c -> f d
f [a]
as [b]
bs [c]
cs

-- * JSON utils

-- | Copied from 'Data.Aeson''s 'eitherFormatError'
-- which is not exported.
jsonEitherFormatError :: Either (JSON.JSONPath, String) a -> Either String a
jsonEitherFormatError :: Either (JSONPath, String) a -> Either String a
jsonEitherFormatError = ((JSONPath, String) -> Either String a)
-> (a -> Either String a)
-> Either (JSONPath, String) a
-> Either String a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a)
-> ((JSONPath, String) -> String)
-> (JSONPath, String)
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSONPath -> String -> String) -> (JSONPath, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry JSONPath -> String -> String
JSON.formatError) a -> Either String a
forall a b. b -> Either a b
Right
{-# INLINE jsonEitherFormatError #-}

instance Random.Random Natural where
	randomR :: (Natural, Natural) -> g -> (Natural, g)
randomR (Natural
mini,Natural
maxi) =
		(Integer -> Natural) -> (Integer, g) -> (Natural, g)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral::Integer -> Natural) ((Integer, g) -> (Natural, g))
-> (g -> (Integer, g)) -> g -> (Natural, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		(Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
mini, Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
maxi)
	random :: g -> (Natural, g)
random = (Integer -> Natural) -> (Integer, g) -> (Natural, g)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral::Integer -> Natural) ((Integer, g) -> (Natural, g))
-> (g -> (Integer, g)) -> g -> (Natural, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> (Integer, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
Random.random

-- * Parsing utils

parseReadP :: Read.ReadP a -> String -> Maybe a
parseReadP :: ReadP a -> String -> Maybe a
parseReadP ReadP a
p String
s =
	let p' :: ReadS a
p' = ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
Read.readP_to_S ReadP a
p in
	[a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ do
		(a
x, String
"") <- ReadS a
p' String
s
		a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x