{-# 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 #-}
-- | extra promoted functions

module Predicate.Data.Extra (
 -- ** list functions

    HeadDef
  , HeadFail
  , HeadMay
  , TailDef
  , TailFail
  , TailMay
  , LastDef
  , LastFail
  , LastMay
  , InitDef
  , InitFail
  , InitMay

 -- ** primes

  , IsPrime
  , PrimeNext
  , PrimePrev
  , PrimeFactors
  , Primes

 -- ** luhn check

  , 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)
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> import qualified Data.Text as T

-- >>> import qualified Data.Sequence as Seq

-- >>> import Predicate

-- >>> import qualified Data.Semigroup as SG

-- >>> import Data.These


-- | takes the head of a list-like object or uses the given default value

--

-- see 'ConsT' for other supported types eg 'Data.Sequence.Seq'

--

-- >>> pz @(HeadDef 444 Id) []

-- Val 444

--

-- >>> pz @(HeadDef 444 Id) [1..5]

-- Val 1

--

-- >>> pz @(HeadDef 444 Id) [1..5]

-- Val 1

--

-- >>> pz @(HeadDef (C "w") Id) (Seq.fromList "abcdef")

-- Val 'a'

--

-- >>> pz @(HeadDef (C "w") Id) Seq.empty

-- Val 'w'

--

-- >>> pz @(HeadDef (MEmptyT _) Id) ([] :: [SG.Sum Int])

-- Val (Sum {getSum = 0})

--

-- >>> pz @(HeadDef (MEmptyT String) '["abc","def","asdfadf"]) ()

-- Val "abc"

--

-- >>> pz @(HeadDef (MEmptyT _) Snd) (123,["abc","def","asdfadf"])

-- Val "abc"

--

-- >>> pz @(HeadDef (MEmptyT _) Snd) (123,[])

-- Val ()

--

-- >>> pl @(HeadDef 9 Fst) ([],True)

-- Present 9 (JustDef Nothing)

-- Val 9

--

-- >>> pl @(HeadDef 99 Fst) ([10..15],True)

-- Present 10 (JustDef Just)

-- Val 10

--

-- >>> pl @(HeadDef 12 Fst >> Le 6) ([],True)

-- False ((>>) False | {12 <= 6})

-- Val False

--

-- >>> pl @(HeadDef 1 Fst >> Le 6) ([],True)

-- True ((>>) True | {1 <= 6})

-- Val True

--

-- >>> pl @(HeadDef 10 Fst >> Le 6) ([],True)

-- False ((>>) False | {10 <= 6})

-- Val False

--

-- >>> pl @(HeadDef (MEmptyT _) Id) (map (:[]) ([] :: [Int]))

-- Present [] (JustDef Nothing)

-- Val []

--

-- >>> pl @(HeadDef (MEmptyT _) Id) (map (:[]) ([10..14] :: [Int]))

-- Present [10] (JustDef Just)

-- Val [10]

--

-- >>> pl @(HeadDef Fst Snd) (99,[10..14])

-- Present 10 (JustDef Just)

-- Val 10

--

-- >>> pl @(HeadDef Fst Snd) (99,[] :: [Int])

-- Present 99 (JustDef Nothing)

-- Val 99

--

-- >>> pl @(HeadDef 43 Snd) (99,[] :: [Int])

-- Present 43 (JustDef Nothing)

-- Val 43

--

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))


-- | takes the head of a list or fails with the given message

--

-- see 'ConsT' for other supported types eg 'Data.Sequence.Seq'

--

-- >>> pz @(HeadFail "oops" Id) ["abc","def","asdfadf"]

-- Val "abc"

--

-- >>> pz @(HeadFail "empty list" Id) []

-- Fail "empty list"

--

-- >>> pl @(HeadFail "zz" Fst >> Le 6) ([],True)

-- Error zz (JustFail Nothing)

-- Fail "zz"

--

-- >>> pl @((HeadFail "failed1" Fst >> Le 6) || 'False) ([],True)

-- Error failed1 (JustFail Nothing | ||)

-- Fail "failed1"

--

-- >>> pl @((Fst >> HeadFail "failed2" Id >> Le (6 -% 1)) || 'False) ([-9],True)

-- True (True || False)

-- Val True

--

-- >>> pl @(HeadFail "Asdf" Id) ([] :: [()]) -- breaks otherwise

-- Error Asdf (JustFail Nothing)

-- Fail "Asdf"

--

-- >>> pl @(HeadFail (PrintF "msg=%s def" Fst) Snd) ("Abc",[])

-- Error msg=Abc def (JustFail Nothing)

-- Fail "msg=Abc def"

--

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))

-- | takes the tail of a list-like object or uses the given default value

--

-- >>> pl @(TailDef '[9,7] Fst) ([],True)

-- Present [9,7] (JustDef Nothing)

-- Val [9,7]

--

-- >>> pl @(TailDef '[9,7] Fst) ([1..5],True)

-- Present [2,3,4,5] (JustDef Just)

-- Val [2,3,4,5]

--

-- >>> pl @(TailDef '[3] Fst) ([10..15],True)

-- Present [11,12,13,14,15] (JustDef Just)

-- Val [11,12,13,14,15]

--

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))


-- | takes the tail of a list-like object or fails with the given message

--

-- >>> pl @(TailFail (PrintT "a=%d b=%s" Snd) Fst) ([]::[()],(4,"someval"))

-- Error a=4 b=someval (JustFail Nothing)

-- Fail "a=4 b=someval"

--

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))

-- | takes the last value of a list-like object or a default value

--

-- >>> pl @(LastDef 9 Fst) ([],True)

-- Present 9 (JustDef Nothing)

-- Val 9

--

-- >>> pl @(LastDef 9 Fst) ([1..5],True)

-- Present 5 (JustDef Just)

-- Val 5

--

-- >>> pl @(LastDef 3 Fst) ([10..15],True)

-- Present 15 (JustDef Just)

-- Val 15

--

-- >>> pl @(LastDef 0 Id) [1..12]

-- Present 12 (JustDef Just)

-- Val 12

--

-- >>> pl @(LastDef 0 Id) []

-- Present 0 (JustDef Nothing)

-- Val 0

--

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))

-- | takes the init of a list-like object or fails with the given message

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))

-- | takes the init of a list-like object or uses the given default value

--

-- >>> pl @(InitDef '[9,7] Fst) ([],True)

-- Present [9,7] (JustDef Nothing)

-- Val [9,7]

--

-- >>> pl @(InitDef '[9,7] Fst) ([1..5],True)

-- Present [1,2,3,4] (JustDef Just)

-- Val [1,2,3,4]

--

-- >>> pl @(InitDef '[3] Fst) ([10..15],True)

-- Present [10,11,12,13,14] (JustDef Just)

-- Val [10,11,12,13,14]

--

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))

-- | takes the init of a list-like object or fails with the given message

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))

-- | similar to 'Safe.headMay'

--

-- >>> pl @HeadMay []

-- Present Nothing ((>>) Nothing | {FMap <skipped>})

-- Val Nothing

--

-- >>> pl @HeadMay [99,7,3]

-- Present Just 99 ((>>) Just 99 | {FMap Fst 99 | (99,[7,3])})

-- Val (Just 99)

--

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)

-- | similar to 'Safe.lastMay'

--

-- >>> pz @LastMay "hello"

-- Val (Just 'o')

--

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)

-- | similar to 'Safe.tailMay'

--

-- >>> pz @TailMay "hello"

-- Val (Just "ello")

--

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)

-- | similar to 'Safe.initMay'

--

-- >>> pz @InitMay "hello"

-- Val (Just "hell")

--

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)

-- | a predicate on prime numbers

--

-- >>> pz @IsPrime 2

-- Val True

--

-- >>> pz @(Map '(Id,IsPrime)) [0..12]

-- Val [(0,False),(1,False),(2,True),(3,True),(4,False),(5,True),(6,False),(7,True),(8,False),(9,False),(10,False),(11,True),(12,False)]

--

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) []

-- | get the next prime number

--

-- >>> pz @PrimeNext 6

-- Val 7

--

-- >>> pz @(ScanN 4 PrimeNext Id) 3

-- Val [3,5,7,11,13]

--

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) []

-- | get the next prime number

--

-- >>> pz @PrimePrev 6

-- Val 5

--

-- >>> pz @PrimePrev 5

-- Val 3

--

-- >>> pz @PrimePrev (-206)

-- Val 2

--

-- >>> pz @(ScanN 6 PrimePrev Id) 11

-- Val [11,7,5,3,2,2,2]

--

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) []

-- | get list of @n@ primes

--

-- >>> pz @(Primes Id) 5

-- Val [2,3,5,7,11]

--

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]

-- | prime factorisation of positive numbers

--

-- >>> pz @(PrimeFactors Id) 17

-- Val [17]

--

-- >>> pz @(PrimeFactors Id) 1

-- Val [1]

--

-- >>> pz @(PrimeFactors Id) 30

-- Val [2,3,5]

--

-- >>> pz @(PrimeFactors Id) 64

-- Val [2,2,2,2,2,2]

--

-- >>> pz @(PrimeFactors Id) (-30)

-- Fail "PrimeFactors number<=0"

--

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]

-- | IsLuhn predicate check on last digit

--

-- >>> pl @IsLuhn [9,8,7,5,6]

-- True (IsLuhn map=[9,7,7,1,6] sum=30 ret=0 | [9,8,7,5,6])

-- Val True

--

-- >>> pl @IsLuhn [9,8,7,5,4]

-- False (IsLuhn map=[9,7,7,1,4] sum=28 ret=8 | [9,8,7,5,4])

-- Val False

--

-- >>> pz @IsLuhn [1,2,3,0]

-- Val True

--

-- >>> pz @IsLuhn [1,2,3,4]

-- Val False

--

-- >>> pz @(GuardSimple IsLuhn) [15,4,3,1,99]

-- Fail "(IsLuhn map=[6,8,3,2,90] sum=109 ret=9 | [15,4,3,1,99])"

--

-- >>> pl @IsLuhn [15,4,3,1,99]

-- False (IsLuhn map=[6,8,3,2,90] sum=109 ret=9 | [15,4,3,1,99])

-- Val False

--

-- >>> pz @(Ones >> Map (ReadP Int Id) >> IsLuhn) "9501234400008"

-- Val True

--

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) []

-- | get Luhn check digit

--

-- >>> pz @(Ones >> Map (ReadP Int Id) >> LuhnDigit) "7992739871"

-- Val 3

--

-- >>> pl @LuhnDigit [9,8,7,6]

-- Present 4 (LuhnDigit map=[9,7,7,3] sum=26 | sum*9=234 | mod 10=4 | [9,8,7,6])

-- Val 4

--

-- >>> pz @LuhnDigit [1,2,3]

-- Val 0

--

-- >>> pz @(Ones >> Map (ReadP Int Id) >> LuhnDigit) "950123440000"

-- Val 8

--

-- >>> pz @(Ones >> Map (ReadP Int Id) >> GuardSimple (Len == 18) >> '(Id,Drop 6 Id) >> Both LuhnDigit) "896101950123440000"

-- Val (1,8)

--

-- >>> pz @(Ones >> Map (ReadP Int Id) >> GuardSimple (Len == 18) >> '(Id,Drop 6 Id) >> Both LuhnDigit) "89610195012344000"

-- Fail "(17 == 18)"

--

-- >>> pz @(Ones >> Map (ReadP Int Id) >> GuardSimple (Len == 18) >> '(Id,Drop 6 Id) >> Both LuhnDigit >> GuardSimple (Id == '(2,8))) "896101950123440000"

-- Fail "((1,8) == (2,8))"

--

-- >>> pz @(Ones >> Map (ReadP Int Id) >> GuardSimple (Len == 20) >> SplitAt 18 Id >> '(LuhnDigit << Fst,LuhnDigit << Drop 6 Fst,Snd) >> GuardSimple (Thd == '[ Fst, Snd ])) "89610195012344000018"

-- Val (1,8,[1,8])

--

-- >>> pl @(IterateNWhile 5 'True (Id +: LuhnDigit) >> Map IsLuhn) [1]

-- Present [False,True,True,True,True] ((>>) [False,True,True,True,True] | {Map [False,True,True,True,True] | [[1],[1,8],[1,8,2],[1,8,2,6],[1,8,2,6,7]]})

-- Val [False,True,True,True,True]

--

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