{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
module Predicate.Data.Extra (
HeadDef
, HeadFail
, HeadMay
, TailDef
, TailFail
, TailMay
, LastDef
, LastFail
, LastMay
, InitDef
, InitFail
, InitMay
, IsPrime
, PrimeNext
, PrimePrev
, PrimeFactors
, Primes
, IsLuhn
, LuhnDigit
) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.List (Uncons, Unsnoc)
import Predicate.Data.Maybe (JustDef, JustFail)
import Predicate.Data.Lifted (FMap)
import Control.Lens
import qualified Safe (headNote)
import Data.Proxy (Proxy(..))
import Data.Bool (bool)
data HeadDef p q deriving Int -> HeadDef p q -> ShowS
[HeadDef p q] -> ShowS
HeadDef p q -> String
(Int -> HeadDef p q -> ShowS)
-> (HeadDef p q -> String)
-> ([HeadDef p q] -> ShowS)
-> Show (HeadDef p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> HeadDef p q -> ShowS
forall k (p :: k) k (q :: k). [HeadDef p q] -> ShowS
forall k (p :: k) k (q :: k). HeadDef p q -> String
showList :: [HeadDef p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [HeadDef p q] -> ShowS
show :: HeadDef p q -> String
$cshow :: forall k (p :: k) k (q :: k). HeadDef p q -> String
showsPrec :: Int -> HeadDef p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> HeadDef p q -> ShowS
Show
type HeadDefT p q = JustDef p (q >> Uncons >> FMap Fst)
instance P (HeadDefT p q) x => P (HeadDef p q) x where
type PP (HeadDef p q) x = PP (HeadDefT p q) x
eval :: proxy (HeadDef p q) -> POpts -> x -> m (TT (PP (HeadDef p q) x))
eval proxy (HeadDef p q)
_ = Proxy (HeadDefT p q) -> POpts -> x -> m (TT (PP (HeadDefT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (HeadDefT p q)
forall k (t :: k). Proxy t
Proxy @(HeadDefT p q))
data HeadFail msg q deriving Int -> HeadFail msg q -> ShowS
[HeadFail msg q] -> ShowS
HeadFail msg q -> String
(Int -> HeadFail msg q -> ShowS)
-> (HeadFail msg q -> String)
-> ([HeadFail msg q] -> ShowS)
-> Show (HeadFail msg q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (msg :: k) k (q :: k). Int -> HeadFail msg q -> ShowS
forall k (msg :: k) k (q :: k). [HeadFail msg q] -> ShowS
forall k (msg :: k) k (q :: k). HeadFail msg q -> String
showList :: [HeadFail msg q] -> ShowS
$cshowList :: forall k (msg :: k) k (q :: k). [HeadFail msg q] -> ShowS
show :: HeadFail msg q -> String
$cshow :: forall k (msg :: k) k (q :: k). HeadFail msg q -> String
showsPrec :: Int -> HeadFail msg q -> ShowS
$cshowsPrec :: forall k (msg :: k) k (q :: k). Int -> HeadFail msg q -> ShowS
Show
type HeadFailT msg q = JustFail msg (q >> Uncons >> FMap Fst)
instance P (HeadFailT msg q) x => P (HeadFail msg q) x where
type PP (HeadFail msg q) x = PP (HeadFailT msg q) x
eval :: proxy (HeadFail msg q)
-> POpts -> x -> m (TT (PP (HeadFail msg q) x))
eval proxy (HeadFail msg q)
_ = Proxy (HeadFailT msg q)
-> POpts -> x -> m (TT (PP (HeadFailT msg q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (HeadFailT msg q)
forall k (t :: k). Proxy t
Proxy @(HeadFailT msg q))
data TailDef p q deriving Int -> TailDef p q -> ShowS
[TailDef p q] -> ShowS
TailDef p q -> String
(Int -> TailDef p q -> ShowS)
-> (TailDef p q -> String)
-> ([TailDef p q] -> ShowS)
-> Show (TailDef p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> TailDef p q -> ShowS
forall k (p :: k) k (q :: k). [TailDef p q] -> ShowS
forall k (p :: k) k (q :: k). TailDef p q -> String
showList :: [TailDef p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [TailDef p q] -> ShowS
show :: TailDef p q -> String
$cshow :: forall k (p :: k) k (q :: k). TailDef p q -> String
showsPrec :: Int -> TailDef p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> TailDef p q -> ShowS
Show
type TailDefT p q = JustDef p (q >> Uncons >> FMap Snd)
instance P (TailDefT p q) x => P (TailDef p q) x where
type PP (TailDef p q) x = PP (TailDefT p q) x
eval :: proxy (TailDef p q) -> POpts -> x -> m (TT (PP (TailDef p q) x))
eval proxy (TailDef p q)
_ = Proxy (TailDefT p q) -> POpts -> x -> m (TT (PP (TailDefT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (TailDefT p q)
forall k (t :: k). Proxy t
Proxy @(TailDefT p q))
data TailFail msg q deriving Int -> TailFail msg q -> ShowS
[TailFail msg q] -> ShowS
TailFail msg q -> String
(Int -> TailFail msg q -> ShowS)
-> (TailFail msg q -> String)
-> ([TailFail msg q] -> ShowS)
-> Show (TailFail msg q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (msg :: k) k (q :: k). Int -> TailFail msg q -> ShowS
forall k (msg :: k) k (q :: k). [TailFail msg q] -> ShowS
forall k (msg :: k) k (q :: k). TailFail msg q -> String
showList :: [TailFail msg q] -> ShowS
$cshowList :: forall k (msg :: k) k (q :: k). [TailFail msg q] -> ShowS
show :: TailFail msg q -> String
$cshow :: forall k (msg :: k) k (q :: k). TailFail msg q -> String
showsPrec :: Int -> TailFail msg q -> ShowS
$cshowsPrec :: forall k (msg :: k) k (q :: k). Int -> TailFail msg q -> ShowS
Show
type TailFailT msg q = JustFail msg (q >> Uncons >> FMap Snd)
instance P (TailFailT msg q) x => P (TailFail msg q) x where
type PP (TailFail msg q) x = PP (TailFailT msg q) x
eval :: proxy (TailFail msg q)
-> POpts -> x -> m (TT (PP (TailFail msg q) x))
eval proxy (TailFail msg q)
_ = Proxy (TailFailT msg q)
-> POpts -> x -> m (TT (PP (TailFailT msg q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (TailFailT msg q)
forall k (t :: k). Proxy t
Proxy @(TailFailT msg q))
data LastDef p q deriving Int -> LastDef p q -> ShowS
[LastDef p q] -> ShowS
LastDef p q -> String
(Int -> LastDef p q -> ShowS)
-> (LastDef p q -> String)
-> ([LastDef p q] -> ShowS)
-> Show (LastDef p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> LastDef p q -> ShowS
forall k (p :: k) k (q :: k). [LastDef p q] -> ShowS
forall k (p :: k) k (q :: k). LastDef p q -> String
showList :: [LastDef p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [LastDef p q] -> ShowS
show :: LastDef p q -> String
$cshow :: forall k (p :: k) k (q :: k). LastDef p q -> String
showsPrec :: Int -> LastDef p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> LastDef p q -> ShowS
Show
type LastDefT p q = JustDef p (q >> Unsnoc >> FMap Snd)
instance P (LastDefT p q) x => P (LastDef p q) x where
type PP (LastDef p q) x = PP (LastDefT p q) x
eval :: proxy (LastDef p q) -> POpts -> x -> m (TT (PP (LastDef p q) x))
eval proxy (LastDef p q)
_ = Proxy (LastDefT p q) -> POpts -> x -> m (TT (PP (LastDefT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (LastDefT p q)
forall k (t :: k). Proxy t
Proxy @(LastDefT p q))
data LastFail msg q deriving Int -> LastFail msg q -> ShowS
[LastFail msg q] -> ShowS
LastFail msg q -> String
(Int -> LastFail msg q -> ShowS)
-> (LastFail msg q -> String)
-> ([LastFail msg q] -> ShowS)
-> Show (LastFail msg q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (msg :: k) k (q :: k). Int -> LastFail msg q -> ShowS
forall k (msg :: k) k (q :: k). [LastFail msg q] -> ShowS
forall k (msg :: k) k (q :: k). LastFail msg q -> String
showList :: [LastFail msg q] -> ShowS
$cshowList :: forall k (msg :: k) k (q :: k). [LastFail msg q] -> ShowS
show :: LastFail msg q -> String
$cshow :: forall k (msg :: k) k (q :: k). LastFail msg q -> String
showsPrec :: Int -> LastFail msg q -> ShowS
$cshowsPrec :: forall k (msg :: k) k (q :: k). Int -> LastFail msg q -> ShowS
Show
type LastFailT msg q = JustFail msg (q >> Unsnoc >> FMap Snd)
instance P (LastFailT msg q) x => P (LastFail msg q) x where
type PP (LastFail msg q) x = PP (LastFailT msg q) x
eval :: proxy (LastFail msg q)
-> POpts -> x -> m (TT (PP (LastFail msg q) x))
eval proxy (LastFail msg q)
_ = Proxy (LastFailT msg q)
-> POpts -> x -> m (TT (PP (LastFailT msg q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (LastFailT msg q)
forall k (t :: k). Proxy t
Proxy @(LastFailT msg q))
data InitDef p q deriving Int -> InitDef p q -> ShowS
[InitDef p q] -> ShowS
InitDef p q -> String
(Int -> InitDef p q -> ShowS)
-> (InitDef p q -> String)
-> ([InitDef p q] -> ShowS)
-> Show (InitDef p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> InitDef p q -> ShowS
forall k (p :: k) k (q :: k). [InitDef p q] -> ShowS
forall k (p :: k) k (q :: k). InitDef p q -> String
showList :: [InitDef p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [InitDef p q] -> ShowS
show :: InitDef p q -> String
$cshow :: forall k (p :: k) k (q :: k). InitDef p q -> String
showsPrec :: Int -> InitDef p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> InitDef p q -> ShowS
Show
type InitDefT p q = JustDef p (q >> Unsnoc >> FMap Fst)
instance P (InitDefT p q) x => P (InitDef p q) x where
type PP (InitDef p q) x = PP (InitDefT p q) x
eval :: proxy (InitDef p q) -> POpts -> x -> m (TT (PP (InitDef p q) x))
eval proxy (InitDef p q)
_ = Proxy (InitDefT p q) -> POpts -> x -> m (TT (PP (InitDefT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (InitDefT p q)
forall k (t :: k). Proxy t
Proxy @(InitDefT p q))
data InitFail msg q deriving Int -> InitFail msg q -> ShowS
[InitFail msg q] -> ShowS
InitFail msg q -> String
(Int -> InitFail msg q -> ShowS)
-> (InitFail msg q -> String)
-> ([InitFail msg q] -> ShowS)
-> Show (InitFail msg q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (msg :: k) k (q :: k). Int -> InitFail msg q -> ShowS
forall k (msg :: k) k (q :: k). [InitFail msg q] -> ShowS
forall k (msg :: k) k (q :: k). InitFail msg q -> String
showList :: [InitFail msg q] -> ShowS
$cshowList :: forall k (msg :: k) k (q :: k). [InitFail msg q] -> ShowS
show :: InitFail msg q -> String
$cshow :: forall k (msg :: k) k (q :: k). InitFail msg q -> String
showsPrec :: Int -> InitFail msg q -> ShowS
$cshowsPrec :: forall k (msg :: k) k (q :: k). Int -> InitFail msg q -> ShowS
Show
type InitFailT msg q = JustFail msg (q >> Unsnoc >> FMap Fst)
instance P (InitFailT msg q) x => P (InitFail msg q) x where
type PP (InitFail msg q) x = PP (InitFailT msg q) x
eval :: proxy (InitFail msg q)
-> POpts -> x -> m (TT (PP (InitFail msg q) x))
eval proxy (InitFail msg q)
_ = Proxy (InitFailT msg q)
-> POpts -> x -> m (TT (PP (InitFailT msg q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (InitFailT msg q)
forall k (t :: k). Proxy t
Proxy @(InitFailT msg q))
data HeadMay deriving Int -> HeadMay -> ShowS
[HeadMay] -> ShowS
HeadMay -> String
(Int -> HeadMay -> ShowS)
-> (HeadMay -> String) -> ([HeadMay] -> ShowS) -> Show HeadMay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeadMay] -> ShowS
$cshowList :: [HeadMay] -> ShowS
show :: HeadMay -> String
$cshow :: HeadMay -> String
showsPrec :: Int -> HeadMay -> ShowS
$cshowsPrec :: Int -> HeadMay -> ShowS
Show
type HeadMayT = Uncons >> FMap Fst
instance P HeadMayT x => P HeadMay x where
type PP HeadMay x = PP HeadMayT x
eval :: proxy HeadMay -> POpts -> x -> m (TT (PP HeadMay x))
eval proxy HeadMay
_ = Proxy HeadMayT -> POpts -> x -> m (TT (PP HeadMayT x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy HeadMayT
forall k (t :: k). Proxy t
Proxy @HeadMayT)
data LastMay deriving Int -> LastMay -> ShowS
[LastMay] -> ShowS
LastMay -> String
(Int -> LastMay -> ShowS)
-> (LastMay -> String) -> ([LastMay] -> ShowS) -> Show LastMay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LastMay] -> ShowS
$cshowList :: [LastMay] -> ShowS
show :: LastMay -> String
$cshow :: LastMay -> String
showsPrec :: Int -> LastMay -> ShowS
$cshowsPrec :: Int -> LastMay -> ShowS
Show
type LastMayT = Unsnoc >> FMap Snd
instance P LastMayT x => P LastMay x where
type PP LastMay x = PP LastMayT x
eval :: proxy LastMay -> POpts -> x -> m (TT (PP LastMay x))
eval proxy LastMay
_ = Proxy LastMayT -> POpts -> x -> m (TT (PP LastMayT x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy LastMayT
forall k (t :: k). Proxy t
Proxy @LastMayT)
data TailMay deriving Int -> TailMay -> ShowS
[TailMay] -> ShowS
TailMay -> String
(Int -> TailMay -> ShowS)
-> (TailMay -> String) -> ([TailMay] -> ShowS) -> Show TailMay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TailMay] -> ShowS
$cshowList :: [TailMay] -> ShowS
show :: TailMay -> String
$cshow :: TailMay -> String
showsPrec :: Int -> TailMay -> ShowS
$cshowsPrec :: Int -> TailMay -> ShowS
Show
type TailMayT = Uncons >> FMap Snd
instance P TailMayT x => P TailMay x where
type PP TailMay x = PP TailMayT x
eval :: proxy TailMay -> POpts -> x -> m (TT (PP TailMay x))
eval proxy TailMay
_ = Proxy TailMayT -> POpts -> x -> m (TT (PP TailMayT x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy TailMayT
forall k (t :: k). Proxy t
Proxy @TailMayT)
data InitMay deriving Int -> InitMay -> ShowS
[InitMay] -> ShowS
InitMay -> String
(Int -> InitMay -> ShowS)
-> (InitMay -> String) -> ([InitMay] -> ShowS) -> Show InitMay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitMay] -> ShowS
$cshowList :: [InitMay] -> ShowS
show :: InitMay -> String
$cshow :: InitMay -> String
showsPrec :: Int -> InitMay -> ShowS
$cshowsPrec :: Int -> InitMay -> ShowS
Show
type InitMayT = Unsnoc >> FMap Fst
instance P InitMayT x => P InitMay x where
type PP InitMay x = PP InitMayT x
eval :: proxy InitMay -> POpts -> x -> m (TT (PP InitMay x))
eval proxy InitMay
_ = Proxy InitMayT -> POpts -> x -> m (TT (PP InitMayT x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy InitMayT
forall k (t :: k). Proxy t
Proxy @InitMayT)
data IsPrime deriving Int -> IsPrime -> ShowS
[IsPrime] -> ShowS
IsPrime -> String
(Int -> IsPrime -> ShowS)
-> (IsPrime -> String) -> ([IsPrime] -> ShowS) -> Show IsPrime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsPrime] -> ShowS
$cshowList :: [IsPrime] -> ShowS
show :: IsPrime -> String
$cshow :: IsPrime -> String
showsPrec :: Int -> IsPrime -> ShowS
$cshowsPrec :: Int -> IsPrime -> ShowS
Show
instance ( x ~ a
, Show a
, Integral a
) => P IsPrime x where
type PP IsPrime x = Bool
eval :: proxy IsPrime -> POpts -> x -> m (TT (PP IsPrime x))
eval proxy IsPrime
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"IsPrime"
b :: Bool
b = x
x x -> x -> Bool
forall a. Ord a => a -> a -> Bool
> x
1 Bool -> Bool -> Bool
&& Int -> Bool
isPrime (x -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x)
in TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
b (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " x
x) []
data PrimeNext deriving Int -> PrimeNext -> ShowS
[PrimeNext] -> ShowS
PrimeNext -> String
(Int -> PrimeNext -> ShowS)
-> (PrimeNext -> String)
-> ([PrimeNext] -> ShowS)
-> Show PrimeNext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimeNext] -> ShowS
$cshowList :: [PrimeNext] -> ShowS
show :: PrimeNext -> String
$cshow :: PrimeNext -> String
showsPrec :: Int -> PrimeNext -> ShowS
$cshowsPrec :: Int -> PrimeNext -> ShowS
Show
instance ( Show x
, Integral x
) => P PrimeNext x where
type PP PrimeNext x = Integer
eval :: proxy PrimeNext -> POpts -> x -> m (TT (PP PrimeNext x))
eval proxy PrimeNext
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"PrimeNext"
ret :: Integer
ret = String -> [Integer] -> Integer
forall a. Partial => String -> [a] -> a
Safe.headNote String
msg0 ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x) [Integer]
primeStream
in TT Integer -> m (TT Integer)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Integer -> m (TT Integer)) -> TT Integer -> m (TT Integer)
forall a b. (a -> b) -> a -> b
$ POpts -> Val Integer -> String -> [Tree PE] -> TT Integer
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Integer -> Val Integer
forall a. a -> Val a
Val Integer
ret) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " x
x) []
data PrimePrev deriving Int -> PrimePrev -> ShowS
[PrimePrev] -> ShowS
PrimePrev -> String
(Int -> PrimePrev -> ShowS)
-> (PrimePrev -> String)
-> ([PrimePrev] -> ShowS)
-> Show PrimePrev
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimePrev] -> ShowS
$cshowList :: [PrimePrev] -> ShowS
show :: PrimePrev -> String
$cshow :: PrimePrev -> String
showsPrec :: Int -> PrimePrev -> ShowS
$cshowsPrec :: Int -> PrimePrev -> ShowS
Show
instance ( Show x
, Integral x
) => P PrimePrev x where
type PP PrimePrev x = Integer
eval :: proxy PrimePrev -> POpts -> x -> m (TT (PP PrimePrev x))
eval proxy PrimePrev
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"PrimePrev"
ret :: Integer
ret = case [Integer] -> Maybe ([Integer], Integer)
forall s a. Snoc s s a a => s -> Maybe (s, a)
unsnoc ([Integer] -> Maybe ([Integer], Integer))
-> [Integer] -> Maybe ([Integer], Integer)
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x) [Integer]
primeStream of
Just ([Integer]
_,Integer
p) -> Integer
p
Maybe ([Integer], Integer)
Nothing -> Integer
2
in TT Integer -> m (TT Integer)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Integer -> m (TT Integer)) -> TT Integer -> m (TT Integer)
forall a b. (a -> b) -> a -> b
$ POpts -> Val Integer -> String -> [Tree PE] -> TT Integer
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Integer -> Val Integer
forall a. a -> Val a
Val Integer
ret) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " x
x) []
data Primes n deriving Int -> Primes n -> ShowS
[Primes n] -> ShowS
Primes n -> String
(Int -> Primes n -> ShowS)
-> (Primes n -> String) -> ([Primes n] -> ShowS) -> Show (Primes n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k). Int -> Primes n -> ShowS
forall k (n :: k). [Primes n] -> ShowS
forall k (n :: k). Primes n -> String
showList :: [Primes n] -> ShowS
$cshowList :: forall k (n :: k). [Primes n] -> ShowS
show :: Primes n -> String
$cshow :: forall k (n :: k). Primes n -> String
showsPrec :: Int -> Primes n -> ShowS
$cshowsPrec :: forall k (n :: k). Int -> Primes n -> ShowS
Show
instance ( Integral (PP n x)
, P n x
) => P (Primes n) x where
type PP (Primes n) x = [Integer]
eval :: proxy (Primes n) -> POpts -> x -> m (TT (PP (Primes n) x))
eval proxy (Primes n)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Primes"
TT (PP n x)
nn <- Proxy n -> POpts -> x -> m (TT (PP n x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy n
forall k (t :: k). Proxy t
Proxy @n) POpts
opts x
x
TT [Integer] -> m (TT [Integer])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [Integer] -> m (TT [Integer]))
-> TT [Integer] -> m (TT [Integer])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP n x)
-> [Tree PE]
-> Either (TT [Integer]) (PP n x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP n x)
nn [] of
Left TT [Integer]
e -> TT [Integer]
e
Right (PP n x -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n) ->
let ret :: [Integer]
ret = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take Int
n [Integer]
primeStream
in POpts -> Val [Integer] -> String -> [Tree PE] -> TT [Integer]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([Integer] -> Val [Integer]
forall a. a -> Val a
Val [Integer]
ret) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Int -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Int
n) [TT (PP n x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n x)
nn]
data PrimeFactors n deriving Int -> PrimeFactors n -> ShowS
[PrimeFactors n] -> ShowS
PrimeFactors n -> String
(Int -> PrimeFactors n -> ShowS)
-> (PrimeFactors n -> String)
-> ([PrimeFactors n] -> ShowS)
-> Show (PrimeFactors n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k). Int -> PrimeFactors n -> ShowS
forall k (n :: k). [PrimeFactors n] -> ShowS
forall k (n :: k). PrimeFactors n -> String
showList :: [PrimeFactors n] -> ShowS
$cshowList :: forall k (n :: k). [PrimeFactors n] -> ShowS
show :: PrimeFactors n -> String
$cshow :: forall k (n :: k). PrimeFactors n -> String
showsPrec :: Int -> PrimeFactors n -> ShowS
$cshowsPrec :: forall k (n :: k). Int -> PrimeFactors n -> ShowS
Show
instance ( Integral (PP n x)
, P n x
) => P (PrimeFactors n) x where
type PP (PrimeFactors n) x = [Integer]
eval :: proxy (PrimeFactors n)
-> POpts -> x -> m (TT (PP (PrimeFactors n) x))
eval proxy (PrimeFactors n)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"PrimeFactors"
TT (PP n x)
nn <- Proxy n -> POpts -> x -> m (TT (PP n x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy n
forall k (t :: k). Proxy t
Proxy @n) POpts
opts x
x
TT [Integer] -> m (TT [Integer])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [Integer] -> m (TT [Integer]))
-> TT [Integer] -> m (TT [Integer])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP n x)
-> [Tree PE]
-> Either (TT [Integer]) (PP n x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP n x)
nn [] of
Left TT [Integer]
e -> TT [Integer]
e
Right (PP n x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Integer
n :: Integer)
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 -> POpts -> Val [Integer] -> String -> [Tree PE] -> TT [Integer]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [Integer]
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" number<=0")) String
"" [TT (PP n x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n x)
nn]
| Bool
otherwise ->
let ret :: [Integer]
ret = Integer -> [Integer]
primeFactors Integer
n
in POpts -> Val [Integer] -> String -> [Tree PE] -> TT [Integer]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([Integer] -> Val [Integer]
forall a. a -> Val a
Val [Integer]
ret) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Integer -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Integer
n) [TT (PP n x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n x)
nn]
data IsLuhn deriving Int -> IsLuhn -> ShowS
[IsLuhn] -> ShowS
IsLuhn -> String
(Int -> IsLuhn -> ShowS)
-> (IsLuhn -> String) -> ([IsLuhn] -> ShowS) -> Show IsLuhn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsLuhn] -> ShowS
$cshowList :: [IsLuhn] -> ShowS
show :: IsLuhn -> String
$cshow :: IsLuhn -> String
showsPrec :: Int -> IsLuhn -> ShowS
$cshowsPrec :: Int -> IsLuhn -> ShowS
Show
instance x ~ [Int]
=> P IsLuhn x where
type PP IsLuhn x = Bool
eval :: proxy IsLuhn -> POpts -> x -> m (TT (PP IsLuhn x))
eval proxy IsLuhn
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"IsLuhn"
in TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case POpts
-> String -> [Int] -> [Tree PE] -> Either (TT Bool) (Int, [Int])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 x
[Int]
x [] of
Left TT Bool
e -> TT Bool
e
Right (Int
wsLen,[Int]
ws) ->
let ys :: [Int]
ys = Bool -> [Int] -> [Int]
luhnImpl (Int -> Bool
forall a. Integral a => a -> Bool
even Int
wsLen) [Int]
ws
z :: Int
z = [Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum' [Int]
ys
ret :: Int
ret = Int
z Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts (Int
ret Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" map=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [Int] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [Int]
ys String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" sum=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
z String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ret=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
ret String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [Int] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [Int]
ws) []
data LuhnDigit deriving Int -> LuhnDigit -> ShowS
[LuhnDigit] -> ShowS
LuhnDigit -> String
(Int -> LuhnDigit -> ShowS)
-> (LuhnDigit -> String)
-> ([LuhnDigit] -> ShowS)
-> Show LuhnDigit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LuhnDigit] -> ShowS
$cshowList :: [LuhnDigit] -> ShowS
show :: LuhnDigit -> String
$cshow :: LuhnDigit -> String
showsPrec :: Int -> LuhnDigit -> ShowS
$cshowsPrec :: Int -> LuhnDigit -> ShowS
Show
instance x ~ [Int]
=> P LuhnDigit x where
type PP LuhnDigit x = Int
eval :: proxy LuhnDigit -> POpts -> x -> m (TT (PP LuhnDigit x))
eval proxy LuhnDigit
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"LuhnDigit"
in TT Int -> m (TT Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Int -> m (TT Int)) -> TT Int -> m (TT Int)
forall a b. (a -> b) -> a -> b
$ case POpts
-> String -> [Int] -> [Tree PE] -> Either (TT Int) (Int, [Int])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 x
[Int]
x [] of
Left TT Int
e -> TT Int
e
Right (Int
wsLen,[Int]
ws) ->
let ys :: [Int]
ys = Bool -> [Int] -> [Int]
luhnImpl (Int -> Bool
forall a. Integral a => a -> Bool
odd Int
wsLen) [Int]
ws
z :: Int
z = [Int] -> Int
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum' [Int]
ys
ret :: Int
ret = (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
9) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10
in POpts -> Val Int -> String -> [Tree PE] -> TT Int
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Int -> Val Int
forall a. a -> Val a
Val Int
ret) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" map=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [Int] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [Int]
ys String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" sum=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
z String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" | sum*9=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
9) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" | mod 10=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
ret String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [Int] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [Int]
ws) []
luhnImpl :: Bool -> [Int] -> [Int]
luhnImpl :: Bool -> [Int] -> [Int]
luhnImpl Bool
b [Int]
ws =
let xs :: [Int]
xs = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) [Int]
ws ([Int] -> [Int]
forall a. [a] -> [a]
cycle' ([Int] -> [Int] -> Bool -> [Int]
forall a. a -> a -> Bool -> a
bool [Int
1,Int
2] [Int
2,Int
1] Bool
b))
in (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Bool) -> (Int -> Int) -> (Int -> Int) -> Int -> Int
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
10) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
9) Int -> Int
forall a. a -> a
id) [Int]
xs