{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Predicate.Misc (
AndT
, OrT
, NotT
, RepeatT
, IntersperseT
, LenT
, FlipT
, IfT
, SumT
, MapT
, ConsT
, type (%%)
, type (%&)
, type (<%>)
, ExtractAFromList
, ExtractAFromTA
, ExtractTFromTA
, MaybeT
, LeftT
, RightT
, ThisT
, ThatT
, TheseT
, FnT
, ApplyConstT
, JoinT
, FailWhenT
, FailUnlessT
, BetweenT
, GetBool(..)
, GetLen(..)
, GetThese(..)
, getThese
, GetOrdering(..)
, OrderingP(..)
, GetOrd(..)
, nat
, symb
, ToITupleC(..)
, FromITupleC(..)
, ToITupleListC(..)
, ReverseITupleC(..)
, TupleC(..)
, T4_1
, T4_2
, T4_3
, T4_4
, T5_1
, T5_2
, T5_3
, T5_4
, T5_5
, ExtractL1C(..)
, ExtractL2C(..)
, ExtractL3C(..)
, ExtractL4C(..)
, ExtractL5C(..)
, ExtractL6C(..)
, ExtractL7C(..)
, ExtractL8C(..)
, isPrime
, primeStream
, primeFactors
, compileRegex
, ROpt(..)
, GetROpts(..)
, RReplace(..)
, GetReplaceFnSub(..)
, ReplaceFnSub(..)
, displayROpts
, SColor(..)
, GetColor(..)
, SStyle(..)
, GetStyle(..)
, SwapC(..)
, showTK
, showT
, showThese
, prettyOrd
, unlessNull
, unlessNullM
, nullSpace
, nullIf
, pureTryTest
, pureTryTestPred
, (~>)
, errorInProgram
, drawTreeU
, removeAnsi
, _Id
, sum'
, product'
, foldMapStrict
, cycle'
, cmpOf
, ifM
, AssocC(..)
, simpleAlign
) where
import qualified GHC.TypeNats as GN
import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat,ErrorMessage((:$$:),(:<>:)))
import qualified GHC.TypeLits as GL
import Data.Proxy (Proxy(Proxy))
import Data.Typeable (Typeable, typeRep)
import System.Console.Pretty (Color(..), Style(..))
import GHC.Exts (Constraint)
import qualified Text.Regex.PCRE.Heavy as RH
import qualified Text.Regex.PCRE.Light as RL
import qualified Data.Text.Encoding as TE
import qualified Data.Text as T
import GHC.Word (Word8)
import Data.Sequence (Seq)
import Control.Applicative (ZipList)
import Data.Kind (Type)
import Data.These (These(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.ByteString (ByteString)
import GHC.Stack (HasCallStack)
import Data.Containers.ListUtils (nubOrd)
import Control.Arrow (Arrow((***)),ArrowChoice(left))
import Data.List (foldl', intercalate, unfoldr, isPrefixOf, isInfixOf)
import qualified Safe (headNote)
import Data.Char (isSpace)
import qualified Control.Exception as E
import Data.Tree (Tree(Node))
import Control.Lens
import qualified Data.Semigroup as SG
import Data.List.Lens (suffixed)
type family BetweenT (s :: Symbol) (a :: Nat) (b :: Nat) (v :: Nat) :: Constraint where
BetweenT s m n v =
FailUnlessT (AndT (m GL.<=? v) (v GL.<=? n))
('GL.Text s
':<>: 'GL.Text " failed"
':$$: 'GL.ShowType v
':<>: 'GL.Text " is outside the range ["
':<>: 'GL.ShowType m
':<>: 'GL.Text ".."
':<>: 'GL.ShowType n
':<>: 'GL.Text "]")
type family FailWhenT (b :: Bool) (msg :: GL.ErrorMessage) :: Constraint where
FailWhenT 'False _ = ()
FailWhenT 'True e = GL.TypeError e
type family FailUnlessT (b :: Bool) (msg :: GL.ErrorMessage) :: Constraint where
FailUnlessT 'True _ = ()
FailUnlessT 'False e = GL.TypeError e
type family AndT (b :: Bool) (b1 :: Bool) :: Bool where
AndT 'False _ = 'False
AndT 'True b1 = b1
type family OrT (b :: Bool) (b1 :: Bool) :: Bool where
OrT 'True _ = 'True
OrT 'False b1 = b1
type family NotT (b :: Bool) :: Bool where
NotT 'True = 'False
NotT 'False = 'True
class GetLen xs where
getLen :: Int
instance GetLen '[] where
getLen :: Int
getLen = Int
0
instance GetLen xs => GetLen (x ': xs) where
getLen :: Int
getLen = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GetLen xs => Int
forall k (xs :: k). GetLen xs => Int
getLen @xs
instance GetLen ('Just a) where
getLen :: Int
getLen = Int
1
instance GetLen 'Nothing where
getLen :: Int
getLen = Int
0
instance GetLen ('Left a) where
getLen :: Int
getLen = Int
0
instance GetLen ('Right a) where
getLen :: Int
getLen = Int
1
instance GetLen ('This a) where
getLen :: Int
getLen = Int
0
instance GetLen ('That a) where
getLen :: Int
getLen = Int
1
instance GetLen ('These a b) where
getLen :: Int
getLen = Int
1
instance GetLen xs => GetLen (x ':| xs) where
getLen :: Int
getLen = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GetLen xs => Int
forall k (xs :: k). GetLen xs => Int
getLen @xs
showThese :: These a b -> String
showThese :: These a b -> String
showThese = \case
This {} -> String
"This"
That {} -> String
"That"
These {} -> String
"These"
class GetThese (th :: These a b) where
getThese' :: These () ()
instance GetThese ('This x) where
getThese' :: These () ()
getThese' = () -> These () ()
forall a b. a -> These a b
This ()
instance GetThese ('That y) where
getThese' :: These () ()
getThese' = () -> These () ()
forall a b. b -> These a b
That ()
instance GetThese ('These x y) where
getThese' :: These () ()
getThese' = () -> () -> These () ()
forall a b. a -> b -> These a b
These () ()
getThese :: forall th . GetThese th => These () ()
getThese :: These () ()
getThese = GetThese th => These () ()
forall a b (th :: These a b). GetThese th => These () ()
getThese' @_ @_ @th
class GetOrdering (cmp :: Ordering) where
getOrdering :: Ordering
instance GetOrdering 'LT where
getOrdering :: Ordering
getOrdering = Ordering
LT
instance GetOrdering 'EQ where
getOrdering :: Ordering
getOrdering = Ordering
EQ
instance GetOrdering 'GT where
getOrdering :: Ordering
getOrdering = Ordering
GT
data OrderingP = CGt | CGe | CEq | CLe | CLt | CNe
deriving stock (ReadPrec [OrderingP]
ReadPrec OrderingP
Int -> ReadS OrderingP
ReadS [OrderingP]
(Int -> ReadS OrderingP)
-> ReadS [OrderingP]
-> ReadPrec OrderingP
-> ReadPrec [OrderingP]
-> Read OrderingP
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrderingP]
$creadListPrec :: ReadPrec [OrderingP]
readPrec :: ReadPrec OrderingP
$creadPrec :: ReadPrec OrderingP
readList :: ReadS [OrderingP]
$creadList :: ReadS [OrderingP]
readsPrec :: Int -> ReadS OrderingP
$creadsPrec :: Int -> ReadS OrderingP
Read, Int -> OrderingP -> ShowS
[OrderingP] -> ShowS
OrderingP -> String
(Int -> OrderingP -> ShowS)
-> (OrderingP -> String)
-> ([OrderingP] -> ShowS)
-> Show OrderingP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderingP] -> ShowS
$cshowList :: [OrderingP] -> ShowS
show :: OrderingP -> String
$cshow :: OrderingP -> String
showsPrec :: Int -> OrderingP -> ShowS
$cshowsPrec :: Int -> OrderingP -> ShowS
Show, OrderingP -> OrderingP -> Bool
(OrderingP -> OrderingP -> Bool)
-> (OrderingP -> OrderingP -> Bool) -> Eq OrderingP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderingP -> OrderingP -> Bool
$c/= :: OrderingP -> OrderingP -> Bool
== :: OrderingP -> OrderingP -> Bool
$c== :: OrderingP -> OrderingP -> Bool
Eq, Int -> OrderingP
OrderingP -> Int
OrderingP -> [OrderingP]
OrderingP -> OrderingP
OrderingP -> OrderingP -> [OrderingP]
OrderingP -> OrderingP -> OrderingP -> [OrderingP]
(OrderingP -> OrderingP)
-> (OrderingP -> OrderingP)
-> (Int -> OrderingP)
-> (OrderingP -> Int)
-> (OrderingP -> [OrderingP])
-> (OrderingP -> OrderingP -> [OrderingP])
-> (OrderingP -> OrderingP -> [OrderingP])
-> (OrderingP -> OrderingP -> OrderingP -> [OrderingP])
-> Enum OrderingP
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OrderingP -> OrderingP -> OrderingP -> [OrderingP]
$cenumFromThenTo :: OrderingP -> OrderingP -> OrderingP -> [OrderingP]
enumFromTo :: OrderingP -> OrderingP -> [OrderingP]
$cenumFromTo :: OrderingP -> OrderingP -> [OrderingP]
enumFromThen :: OrderingP -> OrderingP -> [OrderingP]
$cenumFromThen :: OrderingP -> OrderingP -> [OrderingP]
enumFrom :: OrderingP -> [OrderingP]
$cenumFrom :: OrderingP -> [OrderingP]
fromEnum :: OrderingP -> Int
$cfromEnum :: OrderingP -> Int
toEnum :: Int -> OrderingP
$ctoEnum :: Int -> OrderingP
pred :: OrderingP -> OrderingP
$cpred :: OrderingP -> OrderingP
succ :: OrderingP -> OrderingP
$csucc :: OrderingP -> OrderingP
Enum, OrderingP
OrderingP -> OrderingP -> Bounded OrderingP
forall a. a -> a -> Bounded a
maxBound :: OrderingP
$cmaxBound :: OrderingP
minBound :: OrderingP
$cminBound :: OrderingP
Bounded)
class GetOrd (k :: OrderingP) where
getOrd :: Ord a => (String, a -> a -> Bool)
instance GetOrd 'CGt where getOrd :: (String, a -> a -> Bool)
getOrd = (String
">", a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>))
instance GetOrd 'CGe where getOrd :: (String, a -> a -> Bool)
getOrd = (String
">=",a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=))
instance GetOrd 'CEq where getOrd :: (String, a -> a -> Bool)
getOrd = (String
"==",a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==))
instance GetOrd 'CLe where getOrd :: (String, a -> a -> Bool)
getOrd = (String
"<=",a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=))
instance GetOrd 'CLt where getOrd :: (String, a -> a -> Bool)
getOrd = (String
"<", a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<))
instance GetOrd 'CNe where getOrd :: (String, a -> a -> Bool)
getOrd = (String
"/=",a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=))
showT :: forall (t :: Type) . Typeable t => String
showT :: String
showT = TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall k (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t
forall k (t :: k). Proxy t
Proxy @t))
type family RepeatT (n :: Nat) (p :: k) :: [k] where
RepeatT 0 _p = GL.TypeError ('GL.Text "RepeatT is not defined for zero")
RepeatT 1 p = p ': '[]
RepeatT n p = p ': RepeatT (n GN.- 1) p
type s <%> t = GL.AppendSymbol s t
infixr 7 <%>
type family IntersperseT (s :: Symbol) (xs :: [Symbol]) :: Symbol where
IntersperseT _s '[] = ""
IntersperseT _s '[x] = x
IntersperseT s (x ': y ': xs) = x <%> s <%> IntersperseT s (y ': xs)
type family LenT (xs :: [k]) :: Nat where
LenT '[] = 0
LenT (_x ': xs) = 1 GN.+ LenT xs
class ToITupleC x where
type ToITupleP x
toITupleC :: x -> ToITupleP x
instance (GL.TypeError ('GL.Text "ToITupleC: invalid empty tuple")) => ToITupleC () where
type ToITupleP () = ()
toITupleC :: () -> ToITupleP ()
toITupleC () = ()
instance ToITupleC (a,b) where
type ToITupleP (a,b) = (a,(b,()))
toITupleC :: (a, b) -> ToITupleP (a, b)
toITupleC (a
a,b
b) = (a
a,(b
b,()))
instance ToITupleC (a,b,c) where
type ToITupleP (a,b,c) = (a,(b,(c,())))
toITupleC :: (a, b, c) -> ToITupleP (a, b, c)
toITupleC (a
a,b
b,c
c) = (a
a,(b
b,(c
c,())))
instance ToITupleC (a,b,c,d) where
type ToITupleP (a,b,c,d) = (a,(b,(c,(d,()))))
toITupleC :: (a, b, c, d) -> ToITupleP (a, b, c, d)
toITupleC (a
a,b
b,c
c,d
d) = (a
a,(b
b,(c
c,(d
d,()))))
instance ToITupleC (a,b,c,d,e) where
type ToITupleP (a,b,c,d,e) = (a,(b,(c,(d,(e,())))))
toITupleC :: (a, b, c, d, e) -> ToITupleP (a, b, c, d, e)
toITupleC (a
a,b
b,c
c,d
d,e
e) = (a
a,(b
b,(c
c,(d
d,(e
e,())))))
instance ToITupleC (a,b,c,d,e,f) where
type ToITupleP (a,b,c,d,e,f) = (a,(b,(c,(d,(e,(f,()))))))
toITupleC :: (a, b, c, d, e, f) -> ToITupleP (a, b, c, d, e, f)
toITupleC (a
a,b
b,c
c,d
d,e
e,f
f) = (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,()))))))
instance ToITupleC (a,b,c,d,e,f,g) where
type ToITupleP (a,b,c,d,e,f,g) = (a,(b,(c,(d,(e,(f,(g,())))))))
toITupleC :: (a, b, c, d, e, f, g) -> ToITupleP (a, b, c, d, e, f, g)
toITupleC (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,())))))))
instance ToITupleC (a,b,c,d,e,f,g,h) where
type ToITupleP (a,b,c,d,e,f,g,h) = (a,(b,(c,(d,(e,(f,(g,(h,()))))))))
toITupleC :: (a, b, c, d, e, f, g, h) -> ToITupleP (a, b, c, d, e, f, g, h)
toITupleC (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,()))))))))
instance ToITupleC (a,b,c,d,e,f,g,h,i) where
type ToITupleP (a,b,c,d,e,f,g,h,i) = (a,(b,(c,(d,(e,(f,(g,(h,(i,())))))))))
toITupleC :: (a, b, c, d, e, f, g, h, i)
-> ToITupleP (a, b, c, d, e, f, g, h, i)
toITupleC (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,(i
i,())))))))))
instance ToITupleC (a,b,c,d,e,f,g,h,i,j) where
type ToITupleP (a,b,c,d,e,f,g,h,i,j) = (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,()))))))))))
toITupleC :: (a, b, c, d, e, f, g, h, i, j)
-> ToITupleP (a, b, c, d, e, f, g, h, i, j)
toITupleC (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j) = (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,(i
i,(j
j,()))))))))))
instance ToITupleC (a,b,c,d,e,f,g,h,i,j,k) where
type ToITupleP (a,b,c,d,e,f,g,h,i,j,k) = (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,())))))))))))
toITupleC :: (a, b, c, d, e, f, g, h, i, j, k)
-> ToITupleP (a, b, c, d, e, f, g, h, i, j, k)
toITupleC (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k) = (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,(i
i,(j
j,(k
k,())))))))))))
instance ToITupleC (a,b,c,d,e,f,g,h,i,j,k,l) where
type ToITupleP (a,b,c,d,e,f,g,h,i,j,k,l) = (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,(l,()))))))))))))
toITupleC :: (a, b, c, d, e, f, g, h, i, j, k, l)
-> ToITupleP (a, b, c, d, e, f, g, h, i, j, k, l)
toITupleC (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l) = (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,(i
i,(j
j,(k
k,(l
l,()))))))))))))
class FromITupleC x where
type FromITupleP x
fromITupleC :: x -> FromITupleP x
instance FromITupleC () where
type FromITupleP () = ()
fromITupleC :: () -> FromITupleP ()
fromITupleC () = ()
instance FromITupleC (a,()) where
type FromITupleP (a,()) = a
fromITupleC :: (a, ()) -> FromITupleP (a, ())
fromITupleC (a
a,()) = a
FromITupleP (a, ())
a
instance FromITupleC (a,(b,())) where
type FromITupleP (a,(b,())) = (a,b)
fromITupleC :: (a, (b, ())) -> FromITupleP (a, (b, ()))
fromITupleC (a
a,(b
b,())) = (a
a,b
b)
instance FromITupleC (a,(b,(c,()))) where
type FromITupleP (a,(b,(c,()))) = (a,b,c)
fromITupleC :: (a, (b, (c, ()))) -> FromITupleP (a, (b, (c, ())))
fromITupleC (a
a,(b
b,(c
c,()))) = (a
a,b
b,c
c)
instance FromITupleC (a,(b,(c,(d,())))) where
type FromITupleP (a,(b,(c,(d,())))) = (a,b,c,d)
fromITupleC :: (a, (b, (c, (d, ())))) -> FromITupleP (a, (b, (c, (d, ()))))
fromITupleC (a
a,(b
b,(c
c,(d
d,())))) = (a
a,b
b,c
c,d
d)
instance FromITupleC (a,(b,(c,(d,(e,()))))) where
type FromITupleP (a,(b,(c,(d,(e,()))))) = (a,b,c,d,e)
fromITupleC :: (a, (b, (c, (d, (e, ())))))
-> FromITupleP (a, (b, (c, (d, (e, ())))))
fromITupleC (a
a,(b
b,(c
c,(d
d,(e
e,()))))) = (a
a,b
b,c
c,d
d,e
e)
instance FromITupleC (a,(b,(c,(d,(e,(f,())))))) where
type FromITupleP (a,(b,(c,(d,(e,(f,())))))) = (a,b,c,d,e,f)
fromITupleC :: (a, (b, (c, (d, (e, (f, ()))))))
-> FromITupleP (a, (b, (c, (d, (e, (f, ()))))))
fromITupleC (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,())))))) = (a
a,b
b,c
c,d
d,e
e,f
f)
instance FromITupleC (a,(b,(c,(d,(e,(f,(g,()))))))) where
type FromITupleP (a,(b,(c,(d,(e,(f,(g,()))))))) = (a,b,c,d,e,f,g)
fromITupleC :: (a, (b, (c, (d, (e, (f, (g, ())))))))
-> FromITupleP (a, (b, (c, (d, (e, (f, (g, ())))))))
fromITupleC (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,()))))))) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g)
instance FromITupleC (a,(b,(c,(d,(e,(f,(g,(h,())))))))) where
type FromITupleP (a,(b,(c,(d,(e,(f,(g,(h,())))))))) = (a,b,c,d,e,f,g,h)
fromITupleC :: (a, (b, (c, (d, (e, (f, (g, (h, ()))))))))
-> FromITupleP (a, (b, (c, (d, (e, (f, (g, (h, ()))))))))
fromITupleC (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,())))))))) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h)
instance FromITupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,()))))))))) where
type FromITupleP (a,(b,(c,(d,(e,(f,(g,(h,(i,()))))))))) = (a,b,c,d,e,f,g,h,i)
fromITupleC :: (a, (b, (c, (d, (e, (f, (g, (h, (i, ())))))))))
-> FromITupleP (a, (b, (c, (d, (e, (f, (g, (h, (i, ())))))))))
fromITupleC (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,(i
i,()))))))))) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i)
instance FromITupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,())))))))))) where
type FromITupleP (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,())))))))))) = (a,b,c,d,e,f,g,h,i,j)
fromITupleC :: (a, (b, (c, (d, (e, (f, (g, (h, (i, (j, ()))))))))))
-> FromITupleP (a, (b, (c, (d, (e, (f, (g, (h, (i, (j, ()))))))))))
fromITupleC (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,(i
i,(j
j,())))))))))) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j)
instance FromITupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,()))))))))))) where
type FromITupleP (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,()))))))))))) = (a,b,c,d,e,f,g,h,i,j,k)
fromITupleC :: (a, (b, (c, (d, (e, (f, (g, (h, (i, (j, (k, ())))))))))))
-> FromITupleP
(a, (b, (c, (d, (e, (f, (g, (h, (i, (j, (k, ())))))))))))
fromITupleC (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,(i
i,(j
j,(k
k,()))))))))))) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k)
instance FromITupleC (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,(l,())))))))))))) where
type FromITupleP (a,(b,(c,(d,(e,(f,(g,(h,(i,(j,(k,(l,())))))))))))) = (a,b,c,d,e,f,g,h,i,j,k,l)
fromITupleC :: (a, (b, (c, (d, (e, (f, (g, (h, (i, (j, (k, (l, ()))))))))))))
-> FromITupleP
(a, (b, (c, (d, (e, (f, (g, (h, (i, (j, (k, (l, ()))))))))))))
fromITupleC (a
a,(b
b,(c
c,(d
d,(e
e,(f
f,(g
g,(h
h,(i
i,(j
j,(k
k,(l
l,())))))))))))) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l)
class ToITupleListC (n :: Nat) (a :: Type) where
type ToITupleListP n a
toITupleListC :: [a] -> Either String (ToITupleListP n a)
instance (GL.TypeError ('GL.Text "ToITupleListC: inductive tuple cannot be empty")) => ToITupleListC 0 a where
type ToITupleListP 0 a = ()
toITupleListC :: [a] -> Either String (ToITupleListP 0 a)
toITupleListC [a]
_ = String -> Either String ()
forall a b. a -> Either a b
Left String
"ToITupleListC 0: shouldnt be called"
instance ToITupleListC 1 a where
type ToITupleListP 1 a = (a,())
toITupleListC :: [a] -> Either String (ToITupleListP 1 a)
toITupleListC [a
a] = (a, ()) -> Either String (a, ())
forall a b. b -> Either a b
Right (a
a,())
toITupleListC [a]
_ = String -> Either String (a, ())
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 1 value"
instance ToITupleListC 2 a where
type ToITupleListP 2 a = (a,(a,()))
toITupleListC :: [a] -> Either String (ToITupleListP 2 a)
toITupleListC [a
a,a
b] = (a, (a, ())) -> Either String (a, (a, ()))
forall a b. b -> Either a b
Right (a
a,(a
b,()))
toITupleListC [a]
_ = String -> Either String (a, (a, ()))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 2 values"
instance ToITupleListC 3 a where
type ToITupleListP 3 a = (a,(a,(a,())))
toITupleListC :: [a] -> Either String (ToITupleListP 3 a)
toITupleListC [a
a,a
b,a
c] = (a, (a, (a, ()))) -> Either String (a, (a, (a, ())))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,())))
toITupleListC [a]
_ = String -> Either String (a, (a, (a, ())))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 3 values"
instance ToITupleListC 4 a where
type ToITupleListP 4 a = (a,(a,(a,(a,()))))
toITupleListC :: [a] -> Either String (ToITupleListP 4 a)
toITupleListC [a
a,a
b,a
c,a
d] = (a, (a, (a, (a, ())))) -> Either String (a, (a, (a, (a, ()))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,()))))
toITupleListC [a]
_ = String -> Either String (a, (a, (a, (a, ()))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 4 values"
instance ToITupleListC 5 a where
type ToITupleListP 5 a = (a,(a,(a,(a,(a,())))))
toITupleListC :: [a] -> Either String (ToITupleListP 5 a)
toITupleListC [a
a,a
b,a
c,a
d,a
e] = (a, (a, (a, (a, (a, ())))))
-> Either String (a, (a, (a, (a, (a, ())))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,(a
e,())))))
toITupleListC [a]
_ = String -> Either String (a, (a, (a, (a, (a, ())))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 5 values"
instance ToITupleListC 6 a where
type ToITupleListP 6 a = (a,(a,(a,(a,(a,(a,()))))))
toITupleListC :: [a] -> Either String (ToITupleListP 6 a)
toITupleListC [a
a,a
b,a
c,a
d,a
e,a
f] = (a, (a, (a, (a, (a, (a, ()))))))
-> Either String (a, (a, (a, (a, (a, (a, ()))))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,(a
e,(a
f,()))))))
toITupleListC [a]
_ = String -> Either String (a, (a, (a, (a, (a, (a, ()))))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 6 values"
instance ToITupleListC 7 a where
type ToITupleListP 7 a = (a,(a,(a,(a,(a,(a,(a,())))))))
toITupleListC :: [a] -> Either String (ToITupleListP 7 a)
toITupleListC [a
a,a
b,a
c,a
d,a
e,a
f,a
g] = (a, (a, (a, (a, (a, (a, (a, ())))))))
-> Either String (a, (a, (a, (a, (a, (a, (a, ())))))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,(a
e,(a
f,(a
g,())))))))
toITupleListC [a]
_ = String -> Either String (a, (a, (a, (a, (a, (a, (a, ())))))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 7 values"
instance ToITupleListC 8 a where
type ToITupleListP 8 a = (a,(a,(a,(a,(a,(a,(a,(a,()))))))))
toITupleListC :: [a] -> Either String (ToITupleListP 8 a)
toITupleListC [a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h] = (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))
-> Either String (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,(a
e,(a
f,(a
g,(a
h,()))))))))
toITupleListC [a]
_ = String -> Either String (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 8 values"
instance ToITupleListC 9 a where
type ToITupleListP 9 a = (a,(a,(a,(a,(a,(a,(a,(a,(a,())))))))))
toITupleListC :: [a] -> Either String (ToITupleListP 9 a)
toITupleListC [a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i] = (a, (a, (a, (a, (a, (a, (a, (a, (a, ())))))))))
-> Either String (a, (a, (a, (a, (a, (a, (a, (a, (a, ())))))))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,(a
e,(a
f,(a
g,(a
h,(a
i,())))))))))
toITupleListC [a]
_ = String
-> Either String (a, (a, (a, (a, (a, (a, (a, (a, (a, ())))))))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 9 values"
instance ToITupleListC 10 a where
type ToITupleListP 10 a = (a,(a,(a,(a,(a,(a,(a,(a,(a,(a,()))))))))))
toITupleListC :: [a] -> Either String (ToITupleListP 10 a)
toITupleListC [a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i,a
j] = (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))))
-> Either
String (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,(a
e,(a
f,(a
g,(a
h,(a
i,(a
j,()))))))))))
toITupleListC [a]
_ = String
-> Either
String (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 10 values"
instance ToITupleListC 11 a where
type ToITupleListP 11 a = (a,(a,(a,(a,(a,(a,(a,(a,(a,(a,(a,())))))))))))
toITupleListC :: [a] -> Either String (ToITupleListP 11 a)
toITupleListC [a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i,a
j,a
k] = (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ())))))))))))
-> Either
String (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ())))))))))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,(a
e,(a
f,(a
g,(a
h,(a
i,(a
j,(a
k,())))))))))))
toITupleListC [a]
_ = String
-> Either
String (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ())))))))))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 11 values"
instance ToITupleListC 12 a where
type ToITupleListP 12 a = (a,(a,(a,(a,(a,(a,(a,(a,(a,(a,(a,(a,()))))))))))))
toITupleListC :: [a] -> Either String (ToITupleListP 12 a)
toITupleListC [a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i,a
j,a
k,a
l] = (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))))))
-> Either
String
(a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))))))
forall a b. b -> Either a b
Right (a
a,(a
b,(a
c,(a
d,(a
e,(a
f,(a
g,(a
h,(a
i,(a
j,(a
k,(a
l,()))))))))))))
toITupleListC [a]
_ = String
-> Either
String
(a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, (a, ()))))))))))))
forall a b. a -> Either a b
Left String
"toITupleListC: expected exactly 12 values"
class ReverseITupleC (x :: Type) (xs :: Type) (ys :: Type) where
type ReverseITupleT x xs ys
reverseITupleC :: x -> xs -> ys -> ReverseITupleT x xs ys
instance ReverseITupleC x () ys where
type ReverseITupleT x () ys = (x,ys)
reverseITupleC :: x -> () -> ys -> ReverseITupleT x () ys
reverseITupleC x
x () ys
ys = (x
x,ys
ys)
instance ReverseITupleC w ws (x, ys) => ReverseITupleC x (w,ws) ys where
type ReverseITupleT x (w,ws) ys = (ReverseITupleT w ws (x,ys))
reverseITupleC :: x -> (w, ws) -> ys -> ReverseITupleT x (w, ws) ys
reverseITupleC x
x (w
w,ws
ws) ys
ys = w -> ws -> (x, ys) -> ReverseITupleT w ws (x, ys)
forall x xs ys.
ReverseITupleC x xs ys =>
x -> xs -> ys -> ReverseITupleT x xs ys
reverseITupleC w
w ws
ws (x
x,ys
ys)
type family (p :: k -> k1) %% (q :: k) :: k1 where
p %% q = p q
infixl 9 %%
type family (p :: k) %& (q :: k -> k1) :: k1 where
p %& q = q p
infixr 9 %&
type family FlipT (d :: k1 -> k -> k2) (p :: k) (q :: k1) :: k2 where
FlipT d p q = d q p
type family IfT (b :: Bool) (t :: k) (f :: k) :: k where
IfT 'True t _f = t
IfT 'False _t f = f
type family SumT (ns :: [Nat]) :: Nat where
SumT '[] = 0
SumT (n ': ns) = n GL.+ SumT ns
type family MapT (f :: k -> k1) (xs :: [k]) :: [k1] where
MapT _f '[] = '[]
MapT f (x ': xs) = f x ': MapT f xs
type family ConsT s where
ConsT [a] = a
ConsT (ZipList a) = a
ConsT T.Text = Char
ConsT ByteString = Word8
ConsT (Seq a) = a
ConsT s = GL.TypeError (
'GL.Text "invalid ConsT instance"
':$$: 'GL.Text "s = "
':<>: 'GL.ShowType s)
type family T4_1 x where
T4_1 '(opts,_,_,_) = opts
type family T4_2 x where
T4_2 '(_,ip,_,_) = ip
type family T4_3 x where
T4_3 '(_,_,op,_) = op
type family T4_4 x where
T4_4 '(_,_,_,i) = i
type family T5_1 x where
T5_1 '(opts,_,_,_,_) = opts
type family T5_2 x where
T5_2 '(_,ip,_,_,_) = ip
type family T5_3 x where
T5_3 '(_,_,op,_,_) = op
type family T5_4 x where
T5_4 '(_,_,_,fmt,_) = fmt
type family T5_5 x where
T5_5 '(_,_,_,_,i) = i
type family (ta :: Type) :: Type where
(_t a) = a
z = GL.TypeError (
'GL.Text "ExtractAFromTA: expected (t a) but found something else"
':$$: 'GL.Text "t a = "
':<>: 'GL.ShowType z)
type family (ta :: Type) :: (Type -> Type) where
(t _a) = t
z = GL.TypeError (
'GL.Text "ExtractTFromTA: expected (t a) but found something else"
':$$: 'GL.Text "t a = "
':<>: 'GL.ShowType z)
type family (as :: Type) :: Type where
[a] = a
z = GL.TypeError (
'GL.Text "ExtractAFromList: expected [a] but found something else"
':$$: 'GL.Text "as = "
':<>: 'GL.ShowType z)
type family MaybeT mb where
MaybeT (Maybe a) = a
MaybeT o = GL.TypeError (
'GL.Text "MaybeT: expected 'Maybe a' "
':$$: 'GL.Text "o = "
':<>: 'GL.ShowType o)
type family LeftT lr where
LeftT (Either a _) = a
LeftT o = GL.TypeError (
'GL.Text "LeftT: expected 'Either a b' "
':$$: 'GL.Text "o = "
':<>: 'GL.ShowType o)
type family RightT lr where
RightT (Either _a b) = b
RightT o = GL.TypeError (
'GL.Text "RightT: expected 'Either a b' "
':$$: 'GL.Text "o = "
':<>: 'GL.ShowType o)
type family ThisT lr where
ThisT (These a _b) = a
ThisT o = GL.TypeError (
'GL.Text "ThisT: expected 'These a b' "
':$$: 'GL.Text "o = "
':<>: 'GL.ShowType o)
type family ThatT lr where
ThatT (These _a b) = b
ThatT o = GL.TypeError (
'GL.Text "ThatT: expected 'These a b' "
':$$: 'GL.Text "o = "
':<>: 'GL.ShowType o)
type family TheseT lr where
TheseT (These a b) = (a,b)
TheseT o = GL.TypeError (
'GL.Text "TheseT: expected 'These a b' "
':$$: 'GL.Text "o = "
':<>: 'GL.ShowType o)
type family FnT ab :: Type where
FnT (_a -> b) = b
FnT ab = GL.TypeError (
'GL.Text "FnT: expected Type -> Type but found a simple Type?"
':$$: 'GL.Text "ab = "
':<>: 'GL.ShowType ab)
type family JoinT x y where
JoinT (t a) (t b) = t (a, b)
JoinT ta tb = GL.TypeError (
'GL.Text "JoinT: expected (t a) (t b) but found something else"
':$$: 'GL.Text "t a = "
':<>: 'GL.ShowType ta
':$$: 'GL.Text "t b = "
':<>: 'GL.ShowType tb)
type family ApplyConstT (ta :: Type) (b :: Type) :: Type where
ApplyConstT (t _) b = t b
ApplyConstT ta b = GL.TypeError (
'GL.Text "ApplyConstT: (t a) b but found something else"
':$$: 'GL.Text "t a = "
':<>: 'GL.ShowType ta
':$$: 'GL.Text "b = "
':<>: 'GL.ShowType b)
errorInProgram :: HasCallStack => String -> x
errorInProgram :: String -> x
errorInProgram String
s = String -> x
forall a. HasCallStack => String -> a
error (String -> x) -> String -> x
forall a b. (a -> b) -> a -> b
$ String
"programmer error:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
(~>) :: Bool -> Bool -> Bool
Bool
p ~> :: Bool -> Bool -> Bool
~> Bool
q = Bool -> Bool
not Bool
p Bool -> Bool -> Bool
|| Bool
q
infixr 1 ~>
class (tp :: Type) where
type tp
:: tp -> ExtractL1T tp
instance ExtractL1C (a,b) where
type (a,b) = a
extractL1C :: (a, b) -> ExtractL1T (a, b)
extractL1C (a
a,b
_) = a
ExtractL1T (a, b)
a
instance ExtractL1C (a,b,c) where
type (a,b,c) = a
extractL1C :: (a, b, c) -> ExtractL1T (a, b, c)
extractL1C (a
a,b
_,c
_) = a
ExtractL1T (a, b, c)
a
instance ExtractL1C (a,b,c,d) where
type (a,b,c,d) = a
extractL1C :: (a, b, c, d) -> ExtractL1T (a, b, c, d)
extractL1C (a
a,b
_,c
_,d
_) = a
ExtractL1T (a, b, c, d)
a
instance ExtractL1C (a,b,c,d,e) where
type (a,b,c,d,e) = a
extractL1C :: (a, b, c, d, e) -> ExtractL1T (a, b, c, d, e)
extractL1C (a
a,b
_,c
_,d
_,e
_) = a
ExtractL1T (a, b, c, d, e)
a
instance ExtractL1C (a,b,c,d,e,f) where
type (a,b,c,d,e,f) = a
extractL1C :: (a, b, c, d, e, f) -> ExtractL1T (a, b, c, d, e, f)
extractL1C (a
a,b
_,c
_,d
_,e
_,f
_) = a
ExtractL1T (a, b, c, d, e, f)
a
instance ExtractL1C (a,b,c,d,e,f,g) where
type (a,b,c,d,e,f,g) = a
extractL1C :: (a, b, c, d, e, f, g) -> ExtractL1T (a, b, c, d, e, f, g)
extractL1C (a
a,b
_,c
_,d
_,e
_,f
_,g
_) = a
ExtractL1T (a, b, c, d, e, f, g)
a
instance ExtractL1C (a,b,c,d,e,f,g,h) where
type (a,b,c,d,e,f,g,h) = a
extractL1C :: (a, b, c, d, e, f, g, h) -> ExtractL1T (a, b, c, d, e, f, g, h)
extractL1C (a
a,b
_,c
_,d
_,e
_,f
_,g
_,h
_) = a
ExtractL1T (a, b, c, d, e, f, g, h)
a
class (tp :: Type) where
type tp
:: tp -> ExtractL2T tp
instance ExtractL2C (a,b) where
type (a,b) = b
extractL2C :: (a, b) -> ExtractL2T (a, b)
extractL2C (a
_,b
b) = b
ExtractL2T (a, b)
b
instance ExtractL2C (a,b,c) where
type (a,b,c) = b
extractL2C :: (a, b, c) -> ExtractL2T (a, b, c)
extractL2C (a
_,b
b,c
_) = b
ExtractL2T (a, b, c)
b
instance ExtractL2C (a,b,c,d) where
type (a,b,c,d) = b
extractL2C :: (a, b, c, d) -> ExtractL2T (a, b, c, d)
extractL2C (a
_,b
b,c
_,d
_) = b
ExtractL2T (a, b, c, d)
b
instance ExtractL2C (a,b,c,d,e) where
type (a,b,c,d,e) = b
extractL2C :: (a, b, c, d, e) -> ExtractL2T (a, b, c, d, e)
extractL2C (a
_,b
b,c
_,d
_,e
_) = b
ExtractL2T (a, b, c, d, e)
b
instance ExtractL2C (a,b,c,d,e,f) where
type (a,b,c,d,e,f) = b
extractL2C :: (a, b, c, d, e, f) -> ExtractL2T (a, b, c, d, e, f)
extractL2C (a
_,b
b,c
_,d
_,e
_,f
_) = b
ExtractL2T (a, b, c, d, e, f)
b
instance ExtractL2C (a,b,c,d,e,f,g) where
type (a,b,c,d,e,f,g) = b
extractL2C :: (a, b, c, d, e, f, g) -> ExtractL2T (a, b, c, d, e, f, g)
extractL2C (a
_,b
b,c
_,d
_,e
_,f
_,g
_) = b
ExtractL2T (a, b, c, d, e, f, g)
b
instance ExtractL2C (a,b,c,d,e,f,g,h) where
type (a,b,c,d,e,f,g,h) = b
extractL2C :: (a, b, c, d, e, f, g, h) -> ExtractL2T (a, b, c, d, e, f, g, h)
extractL2C (a
_,b
b,c
_,d
_,e
_,f
_,g
_,h
_) = b
ExtractL2T (a, b, c, d, e, f, g, h)
b
class (tp :: Type) where
type tp
:: tp -> ExtractL3T tp
instance ExtractL3C (a,b) where
type (a,b) = GL.TypeError ('GL.Text "L3 invalid for 2-tuples")
extractL3C :: (a, b) -> ExtractL3T (a, b)
extractL3C (a, b)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L3 invalid for 2-tuples"
instance ExtractL3C (a,b,c) where
type (a,b,c) = c
extractL3C :: (a, b, c) -> ExtractL3T (a, b, c)
extractL3C (a
_,b
_,c
c) = c
ExtractL3T (a, b, c)
c
instance ExtractL3C (a,b,c,d) where
type (a,b,c,d) = c
extractL3C :: (a, b, c, d) -> ExtractL3T (a, b, c, d)
extractL3C (a
_,b
_,c
c,d
_) = c
ExtractL3T (a, b, c, d)
c
instance ExtractL3C (a,b,c,d,e) where
type (a,b,c,d,e) = c
extractL3C :: (a, b, c, d, e) -> ExtractL3T (a, b, c, d, e)
extractL3C (a
_,b
_,c
c,d
_,e
_) = c
ExtractL3T (a, b, c, d, e)
c
instance ExtractL3C (a,b,c,d,e,f) where
type (a,b,c,d,e,f) = c
extractL3C :: (a, b, c, d, e, f) -> ExtractL3T (a, b, c, d, e, f)
extractL3C (a
_,b
_,c
c,d
_,e
_,f
_) = c
ExtractL3T (a, b, c, d, e, f)
c
instance ExtractL3C (a,b,c,d,e,f,g) where
type (a,b,c,d,e,f,g) = c
extractL3C :: (a, b, c, d, e, f, g) -> ExtractL3T (a, b, c, d, e, f, g)
extractL3C (a
_,b
_,c
c,d
_,e
_,f
_,g
_) = c
ExtractL3T (a, b, c, d, e, f, g)
c
instance ExtractL3C (a,b,c,d,e,f,g,h) where
type (a,b,c,d,e,f,g,h) = c
extractL3C :: (a, b, c, d, e, f, g, h) -> ExtractL3T (a, b, c, d, e, f, g, h)
extractL3C (a
_,b
_,c
c,d
_,e
_,f
_,g
_,h
_) = c
ExtractL3T (a, b, c, d, e, f, g, h)
c
class (tp :: Type) where
type tp
:: tp -> ExtractL4T tp
instance ExtractL4C (a,b) where
type (a,b) = GL.TypeError ('GL.Text "L4 invalid for 2-tuples")
extractL4C :: (a, b) -> ExtractL4T (a, b)
extractL4C (a, b)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L4 invalid for 2-tuples"
instance ExtractL4C (a,b,c) where
type (a,b,c) = GL.TypeError ('GL.Text "L4 invalid for 3-tuples")
extractL4C :: (a, b, c) -> ExtractL4T (a, b, c)
extractL4C (a, b, c)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L4 invalid for 3-tuples"
instance ExtractL4C (a,b,c,d) where
type (a,b,c,d) = d
extractL4C :: (a, b, c, d) -> ExtractL4T (a, b, c, d)
extractL4C (a
_,b
_,c
_,d
d) = d
ExtractL4T (a, b, c, d)
d
instance ExtractL4C (a,b,c,d,e) where
type (a,b,c,d,e) = d
extractL4C :: (a, b, c, d, e) -> ExtractL4T (a, b, c, d, e)
extractL4C (a
_,b
_,c
_,d
d,e
_) = d
ExtractL4T (a, b, c, d, e)
d
instance ExtractL4C (a,b,c,d,e,f) where
type (a,b,c,d,e,f) = d
extractL4C :: (a, b, c, d, e, f) -> ExtractL4T (a, b, c, d, e, f)
extractL4C (a
_,b
_,c
_,d
d,e
_,f
_) = d
ExtractL4T (a, b, c, d, e, f)
d
instance ExtractL4C (a,b,c,d,e,f,g) where
type (a,b,c,d,e,f,g) = d
extractL4C :: (a, b, c, d, e, f, g) -> ExtractL4T (a, b, c, d, e, f, g)
extractL4C (a
_,b
_,c
_,d
d,e
_,f
_,g
_) = d
ExtractL4T (a, b, c, d, e, f, g)
d
instance ExtractL4C (a,b,c,d,e,f,g,h) where
type (a,b,c,d,e,f,g,h) = d
extractL4C :: (a, b, c, d, e, f, g, h) -> ExtractL4T (a, b, c, d, e, f, g, h)
extractL4C (a
_,b
_,c
_,d
d,e
_,f
_,g
_,h
_) = d
ExtractL4T (a, b, c, d, e, f, g, h)
d
class (tp :: Type) where
type tp
:: tp -> ExtractL5T tp
instance ExtractL5C (a,b) where
type (a,b) = GL.TypeError ('GL.Text "L5 invalid for 2-tuples")
extractL5C :: (a, b) -> ExtractL5T (a, b)
extractL5C (a, b)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L5 invalid for 2-tuples"
instance ExtractL5C (a,b,c) where
type (a,b,c) = GL.TypeError ('GL.Text "L5 invalid for 3-tuples")
extractL5C :: (a, b, c) -> ExtractL5T (a, b, c)
extractL5C (a, b, c)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L5 invalid for 3-tuples"
instance ExtractL5C (a,b,c,d) where
type (a,b,c,d) = GL.TypeError ('GL.Text "L5 invalid for 4-tuples")
extractL5C :: (a, b, c, d) -> ExtractL5T (a, b, c, d)
extractL5C (a, b, c, d)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L5 invalid for 4-tuples"
instance ExtractL5C (a,b,c,d,e) where
type (a,b,c,d,e) = e
extractL5C :: (a, b, c, d, e) -> ExtractL5T (a, b, c, d, e)
extractL5C (a
_,b
_,c
_,d
_,e
e) = e
ExtractL5T (a, b, c, d, e)
e
instance ExtractL5C (a,b,c,d,e,f) where
type (a,b,c,d,e,f) = e
extractL5C :: (a, b, c, d, e, f) -> ExtractL5T (a, b, c, d, e, f)
extractL5C (a
_,b
_,c
_,d
_,e
e,f
_) = e
ExtractL5T (a, b, c, d, e, f)
e
instance ExtractL5C (a,b,c,d,e,f,g) where
type (a,b,c,d,e,f,g) = e
extractL5C :: (a, b, c, d, e, f, g) -> ExtractL5T (a, b, c, d, e, f, g)
extractL5C (a
_,b
_,c
_,d
_,e
e,f
_,g
_) = e
ExtractL5T (a, b, c, d, e, f, g)
e
instance ExtractL5C (a,b,c,d,e,f,g,h) where
type (a,b,c,d,e,f,g,h) = e
extractL5C :: (a, b, c, d, e, f, g, h) -> ExtractL5T (a, b, c, d, e, f, g, h)
extractL5C (a
_,b
_,c
_,d
_,e
e,f
_,g
_,h
_) = e
ExtractL5T (a, b, c, d, e, f, g, h)
e
class (tp :: Type) where
type tp
:: tp -> ExtractL6T tp
instance ExtractL6C (a,b) where
type (a,b) = GL.TypeError ('GL.Text "L6 invalid for 2-tuples")
extractL6C :: (a, b) -> ExtractL6T (a, b)
extractL6C (a, b)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L6 invalid for 2-tuples"
instance ExtractL6C (a,b,c) where
type (a,b,c) = GL.TypeError ('GL.Text "L6 invalid for 3-tuples")
extractL6C :: (a, b, c) -> ExtractL6T (a, b, c)
extractL6C (a, b, c)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L6 invalid for 3-tuples"
instance ExtractL6C (a,b,c,d) where
type (a,b,c,d) = GL.TypeError ('GL.Text "L6 invalid for 4-tuples")
extractL6C :: (a, b, c, d) -> ExtractL6T (a, b, c, d)
extractL6C (a, b, c, d)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L6 invalid for 4-tuples"
instance ExtractL6C (a,b,c,d,e) where
type (a,b,c,d,e) = GL.TypeError ('GL.Text "L6 invalid for 5-tuples")
extractL6C :: (a, b, c, d, e) -> ExtractL6T (a, b, c, d, e)
extractL6C (a, b, c, d, e)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L6 invalid for 5-tuples"
instance ExtractL6C (a,b,c,d,e,f) where
type (a,b,c,d,e,f) = f
extractL6C :: (a, b, c, d, e, f) -> ExtractL6T (a, b, c, d, e, f)
extractL6C (a
_,b
_,c
_,d
_,e
_,f
f) = f
ExtractL6T (a, b, c, d, e, f)
f
instance ExtractL6C (a,b,c,d,e,f,g) where
type (a,b,c,d,e,f,g) = f
extractL6C :: (a, b, c, d, e, f, g) -> ExtractL6T (a, b, c, d, e, f, g)
extractL6C (a
_,b
_,c
_,d
_,e
_,f
f,g
_) = f
ExtractL6T (a, b, c, d, e, f, g)
f
instance ExtractL6C (a,b,c,d,e,f,g,h) where
type (a,b,c,d,e,f,g,h) = f
extractL6C :: (a, b, c, d, e, f, g, h) -> ExtractL6T (a, b, c, d, e, f, g, h)
extractL6C (a
_,b
_,c
_,d
_,e
_,f
f,g
_,h
_) = f
ExtractL6T (a, b, c, d, e, f, g, h)
f
class (tp :: Type) where
type tp
:: tp -> ExtractL7T tp
instance ExtractL7C (a,b) where
type (a,b) = GL.TypeError ('GL.Text "L7 invalid for 2-tuples")
extractL7C :: (a, b) -> ExtractL7T (a, b)
extractL7C (a, b)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L7 invalid for 2-tuples"
instance ExtractL7C (a,b,c) where
type (a,b,c) = GL.TypeError ('GL.Text "L7 invalid for 3-tuples")
extractL7C :: (a, b, c) -> ExtractL7T (a, b, c)
extractL7C (a, b, c)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L7 invalid for 3-tuples"
instance ExtractL7C (a,b,c,d) where
type (a,b,c,d) = GL.TypeError ('GL.Text "L7 invalid for 4-tuples")
extractL7C :: (a, b, c, d) -> ExtractL7T (a, b, c, d)
extractL7C (a, b, c, d)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L7 invalid for 4-tuples"
instance ExtractL7C (a,b,c,d,e) where
type (a,b,c,d,e) = GL.TypeError ('GL.Text "L7 invalid for 5-tuples")
extractL7C :: (a, b, c, d, e) -> ExtractL7T (a, b, c, d, e)
extractL7C (a, b, c, d, e)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L7 invalid for 5-tuples"
instance ExtractL7C (a,b,c,d,e,f) where
type (a,b,c,d,e,f) = GL.TypeError ('GL.Text "L7 invalid for 6-tuples")
extractL7C :: (a, b, c, d, e, f) -> ExtractL7T (a, b, c, d, e, f)
extractL7C (a, b, c, d, e, f)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L7 invalid for 6-tuples"
instance ExtractL7C (a,b,c,d,e,f,g) where
type (a,b,c,d,e,f,g) = g
extractL7C :: (a, b, c, d, e, f, g) -> ExtractL7T (a, b, c, d, e, f, g)
extractL7C (a
_,b
_,c
_,d
_,e
_,f
_,g
g) = g
ExtractL7T (a, b, c, d, e, f, g)
g
instance ExtractL7C (a,b,c,d,e,f,g,h) where
type (a,b,c,d,e,f,g,h) = g
extractL7C :: (a, b, c, d, e, f, g, h) -> ExtractL7T (a, b, c, d, e, f, g, h)
extractL7C (a
_,b
_,c
_,d
_,e
_,f
_,g
g,h
_) = g
ExtractL7T (a, b, c, d, e, f, g, h)
g
class (tp :: Type) where
type tp
:: tp -> ExtractL8T tp
instance ExtractL8C (a,b) where
type (a,b) = GL.TypeError ('GL.Text "L8 invalid for 2-tuples")
extractL8C :: (a, b) -> ExtractL8T (a, b)
extractL8C (a, b)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L8 invalid for 2-tuples"
instance ExtractL8C (a,b,c) where
type (a,b,c) = GL.TypeError ('GL.Text "L8 invalid for 3-tuples")
extractL8C :: (a, b, c) -> ExtractL8T (a, b, c)
extractL8C (a, b, c)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L8 invalid for 3-tuples"
instance ExtractL8C (a,b,c,d) where
type (a,b,c,d) = GL.TypeError ('GL.Text "L8 invalid for 4-tuples")
extractL8C :: (a, b, c, d) -> ExtractL8T (a, b, c, d)
extractL8C (a, b, c, d)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L8 invalid for 4-tuples"
instance ExtractL8C (a,b,c,d,e) where
type (a,b,c,d,e) = GL.TypeError ('GL.Text "L8 invalid for 5-tuples")
extractL8C :: (a, b, c, d, e) -> ExtractL8T (a, b, c, d, e)
extractL8C (a, b, c, d, e)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L8 invalid for 5-tuples"
instance ExtractL8C (a,b,c,d,e,f) where
type (a,b,c,d,e,f) = GL.TypeError ('GL.Text "L8 invalid for 6-tuples")
extractL8C :: (a, b, c, d, e, f) -> ExtractL8T (a, b, c, d, e, f)
extractL8C (a, b, c, d, e, f)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L8 invalid for 6-tuples"
instance ExtractL8C (a,b,c,d,e,f,g) where
type (a,b,c,d,e,f,g) = GL.TypeError ('GL.Text "L8 invalid for 7-tuples")
extractL8C :: (a, b, c, d, e, f, g) -> ExtractL8T (a, b, c, d, e, f, g)
extractL8C (a, b, c, d, e, f, g)
_ = String -> (TypeError ...)
forall x. HasCallStack => String -> x
errorInProgram String
"L8 invalid for 7-tuples"
instance ExtractL8C (a,b,c,d,e,f,g,h) where
type (a,b,c,d,e,f,g,h) = h
extractL8C :: (a, b, c, d, e, f, g, h) -> ExtractL8T (a, b, c, d, e, f, g, h)
extractL8C (a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
h) = h
ExtractL8T (a, b, c, d, e, f, g, h)
h
class TupleC (n :: Nat) (a :: Type) where
type TupleT n a
getTupleC :: [a] -> Maybe (TupleT n a)
instance TupleC 2 a where
type TupleT 2 a = (a,a)
getTupleC :: [a] -> Maybe (TupleT 2 a)
getTupleC = \case
a
a:a
b:[a]
_ -> (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
a,a
b)
[a]
_ -> Maybe (TupleT 2 a)
forall a. Maybe a
Nothing
instance TupleC 3 a where
type TupleT 3 a = (a,a,a)
getTupleC :: [a] -> Maybe (TupleT 3 a)
getTupleC = \case
a
a:a
b:a
c:[a]
_ -> (a, a, a) -> Maybe (a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c)
[a]
_ -> Maybe (TupleT 3 a)
forall a. Maybe a
Nothing
instance TupleC 4 a where
type TupleT 4 a = (a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 4 a)
getTupleC = \case
a
a:a
b:a
c:a
d:[a]
_ -> (a, a, a, a) -> Maybe (a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d)
[a]
_ -> Maybe (TupleT 4 a)
forall a. Maybe a
Nothing
instance TupleC 5 a where
type TupleT 5 a = (a,a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 5 a)
getTupleC = \case
a
a:a
b:a
c:a
d:a
e:[a]
_ -> (a, a, a, a, a) -> Maybe (a, a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d,a
e)
[a]
_ -> Maybe (TupleT 5 a)
forall a. Maybe a
Nothing
instance TupleC 6 a where
type TupleT 6 a = (a,a,a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 6 a)
getTupleC = \case
a
a:a
b:a
c:a
d:a
e:a
f:[a]
_ -> (a, a, a, a, a, a) -> Maybe (a, a, a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d,a
e,a
f)
[a]
_ -> Maybe (TupleT 6 a)
forall a. Maybe a
Nothing
instance TupleC 7 a where
type TupleT 7 a = (a,a,a,a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 7 a)
getTupleC = \case
a
a:a
b:a
c:a
d:a
e:a
f:a
g:[a]
_ -> (a, a, a, a, a, a, a) -> Maybe (a, a, a, a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d,a
e,a
f,a
g)
[a]
_ -> Maybe (TupleT 7 a)
forall a. Maybe a
Nothing
instance TupleC 8 a where
type TupleT 8 a = (a,a,a,a,a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 8 a)
getTupleC = \case
a
a:a
b:a
c:a
d:a
e:a
f:a
g:a
h:[a]
_ -> (a, a, a, a, a, a, a, a) -> Maybe (a, a, a, a, a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h)
[a]
_ -> Maybe (TupleT 8 a)
forall a. Maybe a
Nothing
instance TupleC 9 a where
type TupleT 9 a = (a,a,a,a,a,a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 9 a)
getTupleC = \case
a
a:a
b:a
c:a
d:a
e:a
f:a
g:a
h:a
i:[a]
_ -> (a, a, a, a, a, a, a, a, a) -> Maybe (a, a, a, a, a, a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i)
[a]
_ -> Maybe (TupleT 9 a)
forall a. Maybe a
Nothing
instance TupleC 10 a where
type TupleT 10 a = (a,a,a,a,a,a,a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 10 a)
getTupleC = \case
a
a:a
b:a
c:a
d:a
e:a
f:a
g:a
h:a
i:a
j:[a]
_ -> (a, a, a, a, a, a, a, a, a, a)
-> Maybe (a, a, a, a, a, a, a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i,a
j)
[a]
_ -> Maybe (TupleT 10 a)
forall a. Maybe a
Nothing
instance TupleC 11 a where
type TupleT 11 a = (a,a,a,a,a,a,a,a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 11 a)
getTupleC = \case
a
a:a
b:a
c:a
d:a
e:a
f:a
g:a
h:a
i:a
j:a
k:[a]
_ -> (a, a, a, a, a, a, a, a, a, a, a)
-> Maybe (a, a, a, a, a, a, a, a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i,a
j,a
k)
[a]
_ -> Maybe (TupleT 11 a)
forall a. Maybe a
Nothing
instance TupleC 12 a where
type TupleT 12 a = (a,a,a,a,a,a,a,a,a,a,a,a)
getTupleC :: [a] -> Maybe (TupleT 12 a)
getTupleC = \case
a
a:a
b:a
c:a
d:a
e:a
f:a
g:a
h:a
i:a
j:a
k:a
l:[a]
_ -> (a, a, a, a, a, a, a, a, a, a, a, a)
-> Maybe (a, a, a, a, a, a, a, a, a, a, a, a)
forall a. a -> Maybe a
Just (a
a,a
b,a
c,a
d,a
e,a
f,a
g,a
h,a
i,a
j,a
k,a
l)
[a]
_ -> Maybe (TupleT 12 a)
forall a. Maybe a
Nothing
isPrime :: Int -> Bool
isPrime :: Int -> Bool
isPrime Int
n = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n) (Int
2Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int
3,Int
5 .. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Int -> Double) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Floating Double => Double -> Double
forall a. Floating a => a -> a
sqrt @Double (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1])
primeFactors :: Integer -> [Integer]
primeFactors :: Integer -> [Integer]
primeFactors Integer
n =
case [Integer]
factors of
[] -> [Integer
n]
[Integer]
_ -> [Integer]
factors [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ Integer -> [Integer]
primeFactors (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` String -> [Integer] -> Integer
forall a. HasCallStack => String -> [a] -> a
Safe.headNote String
"primeFactors" [Integer]
factors)
where factors :: [Integer]
factors = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take Int
1 ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Integer
x -> (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
x) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) [Integer
2 .. Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1]
primeStream :: [Integer]
primeStream :: [Integer]
primeStream = Integer
2 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
3 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer
5 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
primes'
where
isPrime' :: [t] -> t -> Bool
isPrime' [] t
_ = String -> Bool
forall x. HasCallStack => String -> x
errorInProgram String
"primes is empty"
isPrime' (t
p:[t]
ps) t
n = t
pt -> t -> t
forall a. Num a => a -> a -> a
*t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
n Bool -> Bool -> Bool
|| t
n t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
p t -> t -> Bool
forall a. Eq a => a -> a -> Bool
/= t
0 Bool -> Bool -> Bool
&& [t] -> t -> Bool
isPrime' [t]
ps t
n
primes' :: [Integer]
primes' = Integer
7 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Integer] -> Integer -> Bool
forall t. Integral t => [t] -> t -> Bool
isPrime' [Integer]
primes') ((Integer -> Integer -> Integer)
-> Integer -> [Integer] -> [Integer]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) Integer
11 ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer]
forall a. [a] -> [a]
cycle' [Integer
2,Integer
4,Integer
2,Integer
4,Integer
6,Integer
2,Integer
6,Integer
4])
cycle' :: [a] -> [a]
cycle' :: [a] -> [a]
cycle' [] = []
cycle' [a]
xs = [a]
xs' where xs' :: [a]
xs' = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs'
prettyOrd :: Ordering -> String
prettyOrd :: Ordering -> String
prettyOrd = \case
Ordering
LT -> String
"<"
Ordering
EQ -> String
"="
Ordering
GT -> String
">"
showTK :: forall r . Typeable r => String
showTK :: String
showTK = TypeRep -> String
forall a. Show a => a -> String
show (Proxy r -> TypeRep
forall k (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy r
forall k (t :: k). Proxy t
Proxy @r))
nat :: forall n a
. ( KnownNat n
, Num a
) => a
nat :: a
nat = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
GL.natVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n))
symb :: forall s . KnownSymbol s => String
symb :: String
symb = Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
GL.symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
class GetNats (as :: [Nat]) where
getNats :: [Int]
instance GetNats '[] where
getNats :: [Int]
getNats = []
instance ( KnownNat n
, GetNats ns
) => GetNats (n ': ns) where
getNats :: [Int]
getNats = forall a. (KnownNat n, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: GetNats ns => [Int]
forall (as :: [Nat]). GetNats as => [Int]
getNats @ns
class GetSymbs (ns :: [Symbol]) where
getSymbs :: [String]
instance GetSymbs '[] where
getSymbs :: [String]
getSymbs = []
instance ( KnownSymbol s
, GetSymbs ss
) => GetSymbs (s ': ss) where
getSymbs :: [String]
getSymbs = KnownSymbol s => String
forall (s :: Symbol). KnownSymbol s => String
symb @s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: GetSymbs ss => [String]
forall (ns :: [Symbol]). GetSymbs ns => [String]
getSymbs @ss
class GetBool (a :: Bool) where
getBool :: Bool
instance GetBool 'True where
getBool :: Bool
getBool = Bool
True
instance GetBool 'False where
getBool :: Bool
getBool = Bool
False
compileRegex :: forall rs . GetROpts rs
=> String
-> String
-> Either (String, String) RH.Regex
compileRegex :: String -> String -> Either (String, String) Regex
compileRegex String
nm String
s
| String -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null String
s = (String, String) -> Either (String, String) Regex
forall a b. a -> Either a b
Left (String
"Regex cannot be empty",String
nm)
| Bool
otherwise =
let rs :: ([String], [PCREOption])
rs = GetROpts rs => ([String], [PCREOption])
forall (os :: [ROpt]). GetROpts os => ([String], [PCREOption])
getROpts @rs
mm :: String
mm = String
nm String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([String], [PCREOption]) -> String
forall a. Show a => a -> String
show ([String], [PCREOption])
rs
f :: String -> (String, String)
f String
e = (String
"Regex failed to compile", String
mm String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)
in (String -> (String, String))
-> Either String Regex -> Either (String, String) Regex
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> (String, String)
f (ByteString -> [PCREOption] -> Either String Regex
RH.compileM (Text -> ByteString
TE.encodeUtf8 (String -> Text
T.pack String
s)) (([String], [PCREOption]) -> [PCREOption]
forall a b. (a, b) -> b
snd ([String], [PCREOption])
rs))
data ROpt =
Anchored
| AutoCallout
| Caseless
| DollarEndonly
| Dotall
| Dupnames
| Extended
|
| Firstline
| Multiline
| NewlineCr
| NewlineCrlf
| NewlineLf
| NoAutoCapture
| Ungreedy
| Utf8
| NoUtf8Check
deriving stock (ReadPrec [ROpt]
ReadPrec ROpt
Int -> ReadS ROpt
ReadS [ROpt]
(Int -> ReadS ROpt)
-> ReadS [ROpt] -> ReadPrec ROpt -> ReadPrec [ROpt] -> Read ROpt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ROpt]
$creadListPrec :: ReadPrec [ROpt]
readPrec :: ReadPrec ROpt
$creadPrec :: ReadPrec ROpt
readList :: ReadS [ROpt]
$creadList :: ReadS [ROpt]
readsPrec :: Int -> ReadS ROpt
$creadsPrec :: Int -> ReadS ROpt
Read, Int -> ROpt -> ShowS
[ROpt] -> ShowS
ROpt -> String
(Int -> ROpt -> ShowS)
-> (ROpt -> String) -> ([ROpt] -> ShowS) -> Show ROpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ROpt] -> ShowS
$cshowList :: [ROpt] -> ShowS
show :: ROpt -> String
$cshow :: ROpt -> String
showsPrec :: Int -> ROpt -> ShowS
$cshowsPrec :: Int -> ROpt -> ShowS
Show, ROpt -> ROpt -> Bool
(ROpt -> ROpt -> Bool) -> (ROpt -> ROpt -> Bool) -> Eq ROpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ROpt -> ROpt -> Bool
$c/= :: ROpt -> ROpt -> Bool
== :: ROpt -> ROpt -> Bool
$c== :: ROpt -> ROpt -> Bool
Eq, Eq ROpt
Eq ROpt
-> (ROpt -> ROpt -> Ordering)
-> (ROpt -> ROpt -> Bool)
-> (ROpt -> ROpt -> Bool)
-> (ROpt -> ROpt -> Bool)
-> (ROpt -> ROpt -> Bool)
-> (ROpt -> ROpt -> ROpt)
-> (ROpt -> ROpt -> ROpt)
-> Ord ROpt
ROpt -> ROpt -> Bool
ROpt -> ROpt -> Ordering
ROpt -> ROpt -> ROpt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ROpt -> ROpt -> ROpt
$cmin :: ROpt -> ROpt -> ROpt
max :: ROpt -> ROpt -> ROpt
$cmax :: ROpt -> ROpt -> ROpt
>= :: ROpt -> ROpt -> Bool
$c>= :: ROpt -> ROpt -> Bool
> :: ROpt -> ROpt -> Bool
$c> :: ROpt -> ROpt -> Bool
<= :: ROpt -> ROpt -> Bool
$c<= :: ROpt -> ROpt -> Bool
< :: ROpt -> ROpt -> Bool
$c< :: ROpt -> ROpt -> Bool
compare :: ROpt -> ROpt -> Ordering
$ccompare :: ROpt -> ROpt -> Ordering
$cp1Ord :: Eq ROpt
Ord, Int -> ROpt
ROpt -> Int
ROpt -> [ROpt]
ROpt -> ROpt
ROpt -> ROpt -> [ROpt]
ROpt -> ROpt -> ROpt -> [ROpt]
(ROpt -> ROpt)
-> (ROpt -> ROpt)
-> (Int -> ROpt)
-> (ROpt -> Int)
-> (ROpt -> [ROpt])
-> (ROpt -> ROpt -> [ROpt])
-> (ROpt -> ROpt -> [ROpt])
-> (ROpt -> ROpt -> ROpt -> [ROpt])
-> Enum ROpt
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ROpt -> ROpt -> ROpt -> [ROpt]
$cenumFromThenTo :: ROpt -> ROpt -> ROpt -> [ROpt]
enumFromTo :: ROpt -> ROpt -> [ROpt]
$cenumFromTo :: ROpt -> ROpt -> [ROpt]
enumFromThen :: ROpt -> ROpt -> [ROpt]
$cenumFromThen :: ROpt -> ROpt -> [ROpt]
enumFrom :: ROpt -> [ROpt]
$cenumFrom :: ROpt -> [ROpt]
fromEnum :: ROpt -> Int
$cfromEnum :: ROpt -> Int
toEnum :: Int -> ROpt
$ctoEnum :: Int -> ROpt
pred :: ROpt -> ROpt
$cpred :: ROpt -> ROpt
succ :: ROpt -> ROpt
$csucc :: ROpt -> ROpt
Enum, ROpt
ROpt -> ROpt -> Bounded ROpt
forall a. a -> a -> Bounded a
maxBound :: ROpt
$cmaxBound :: ROpt
minBound :: ROpt
$cminBound :: ROpt
Bounded)
class GetROpts (os :: [ROpt]) where
getROpts :: ([String], [RL.PCREOption])
instance GetROpts '[] where
getROpts :: ([String], [PCREOption])
getROpts = ([], [])
instance ( Typeable r
, GetROpt r
, GetROpts rs
) => GetROpts (r ': rs) where
getROpts :: ([String], [PCREOption])
getROpts = ((Typeable r => String
forall k (r :: k). Typeable r => String
showTK @r String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([PCREOption] -> [PCREOption])
-> ([String], [PCREOption])
-> ([String], [PCREOption])
forall (a :: Type -> Type -> Type) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (GetROpt r => PCREOption
forall (o :: ROpt). GetROpt o => PCREOption
getROpt @r PCREOption -> [PCREOption] -> [PCREOption]
forall a. a -> [a] -> [a]
:)) (GetROpts rs => ([String], [PCREOption])
forall (os :: [ROpt]). GetROpts os => ([String], [PCREOption])
getROpts @rs)
displayROpts :: [String] -> String
displayROpts :: [String] -> String
displayROpts [String]
xs = String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
xs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
class GetROpt (o :: ROpt) where
getROpt :: RL.PCREOption
instance GetROpt 'Anchored where getROpt :: PCREOption
getROpt = PCREOption
RL.anchored
instance GetROpt 'AutoCallout where getROpt :: PCREOption
getROpt = PCREOption
RL.auto_callout
instance GetROpt 'Caseless where getROpt :: PCREOption
getROpt = PCREOption
RL.caseless
instance GetROpt 'DollarEndonly where getROpt :: PCREOption
getROpt = PCREOption
RL.dollar_endonly
instance GetROpt 'Dotall where getROpt :: PCREOption
getROpt = PCREOption
RL.dotall
instance GetROpt 'Dupnames where getROpt :: PCREOption
getROpt = PCREOption
RL.dupnames
instance GetROpt 'Extended where getROpt :: PCREOption
getROpt = PCREOption
RL.extended
instance GetROpt 'Extra where getROpt :: PCREOption
getROpt = PCREOption
RL.extra
instance GetROpt 'Firstline where getROpt :: PCREOption
getROpt = PCREOption
RL.firstline
instance GetROpt 'Multiline where getROpt :: PCREOption
getROpt = PCREOption
RL.multiline
instance GetROpt 'NewlineCr where getROpt :: PCREOption
getROpt = PCREOption
RL.newline_cr
instance GetROpt 'NewlineCrlf where getROpt :: PCREOption
getROpt = PCREOption
RL.newline_crlf
instance GetROpt 'NewlineLf where getROpt :: PCREOption
getROpt = PCREOption
RL.newline_lf
instance GetROpt 'NoAutoCapture where getROpt :: PCREOption
getROpt = PCREOption
RL.no_auto_capture
instance GetROpt 'Ungreedy where getROpt :: PCREOption
getROpt = PCREOption
RL.ungreedy
instance GetROpt 'Utf8 where getROpt :: PCREOption
getROpt = PCREOption
RL.utf8
instance GetROpt 'NoUtf8Check where getROpt :: PCREOption
getROpt = PCREOption
RL.no_utf8_check
data ReplaceFnSub =
RPrepend
| ROverWrite
| RAppend
deriving stock (ReadPrec [ReplaceFnSub]
ReadPrec ReplaceFnSub
Int -> ReadS ReplaceFnSub
ReadS [ReplaceFnSub]
(Int -> ReadS ReplaceFnSub)
-> ReadS [ReplaceFnSub]
-> ReadPrec ReplaceFnSub
-> ReadPrec [ReplaceFnSub]
-> Read ReplaceFnSub
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReplaceFnSub]
$creadListPrec :: ReadPrec [ReplaceFnSub]
readPrec :: ReadPrec ReplaceFnSub
$creadPrec :: ReadPrec ReplaceFnSub
readList :: ReadS [ReplaceFnSub]
$creadList :: ReadS [ReplaceFnSub]
readsPrec :: Int -> ReadS ReplaceFnSub
$creadsPrec :: Int -> ReadS ReplaceFnSub
Read, Int -> ReplaceFnSub -> ShowS
[ReplaceFnSub] -> ShowS
ReplaceFnSub -> String
(Int -> ReplaceFnSub -> ShowS)
-> (ReplaceFnSub -> String)
-> ([ReplaceFnSub] -> ShowS)
-> Show ReplaceFnSub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplaceFnSub] -> ShowS
$cshowList :: [ReplaceFnSub] -> ShowS
show :: ReplaceFnSub -> String
$cshow :: ReplaceFnSub -> String
showsPrec :: Int -> ReplaceFnSub -> ShowS
$cshowsPrec :: Int -> ReplaceFnSub -> ShowS
Show, ReplaceFnSub -> ReplaceFnSub -> Bool
(ReplaceFnSub -> ReplaceFnSub -> Bool)
-> (ReplaceFnSub -> ReplaceFnSub -> Bool) -> Eq ReplaceFnSub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplaceFnSub -> ReplaceFnSub -> Bool
$c/= :: ReplaceFnSub -> ReplaceFnSub -> Bool
== :: ReplaceFnSub -> ReplaceFnSub -> Bool
$c== :: ReplaceFnSub -> ReplaceFnSub -> Bool
Eq, ReplaceFnSub
ReplaceFnSub -> ReplaceFnSub -> Bounded ReplaceFnSub
forall a. a -> a -> Bounded a
maxBound :: ReplaceFnSub
$cmaxBound :: ReplaceFnSub
minBound :: ReplaceFnSub
$cminBound :: ReplaceFnSub
Bounded, Int -> ReplaceFnSub
ReplaceFnSub -> Int
ReplaceFnSub -> [ReplaceFnSub]
ReplaceFnSub -> ReplaceFnSub
ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub]
ReplaceFnSub -> ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub]
(ReplaceFnSub -> ReplaceFnSub)
-> (ReplaceFnSub -> ReplaceFnSub)
-> (Int -> ReplaceFnSub)
-> (ReplaceFnSub -> Int)
-> (ReplaceFnSub -> [ReplaceFnSub])
-> (ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub])
-> (ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub])
-> (ReplaceFnSub -> ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub])
-> Enum ReplaceFnSub
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ReplaceFnSub -> ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub]
$cenumFromThenTo :: ReplaceFnSub -> ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub]
enumFromTo :: ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub]
$cenumFromTo :: ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub]
enumFromThen :: ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub]
$cenumFromThen :: ReplaceFnSub -> ReplaceFnSub -> [ReplaceFnSub]
enumFrom :: ReplaceFnSub -> [ReplaceFnSub]
$cenumFrom :: ReplaceFnSub -> [ReplaceFnSub]
fromEnum :: ReplaceFnSub -> Int
$cfromEnum :: ReplaceFnSub -> Int
toEnum :: Int -> ReplaceFnSub
$ctoEnum :: Int -> ReplaceFnSub
pred :: ReplaceFnSub -> ReplaceFnSub
$cpred :: ReplaceFnSub -> ReplaceFnSub
succ :: ReplaceFnSub -> ReplaceFnSub
$csucc :: ReplaceFnSub -> ReplaceFnSub
Enum)
class GetReplaceFnSub (k :: ReplaceFnSub) where
getReplaceFnSub :: ReplaceFnSub
instance GetReplaceFnSub 'RPrepend where getReplaceFnSub :: ReplaceFnSub
getReplaceFnSub = ReplaceFnSub
RPrepend
instance GetReplaceFnSub 'ROverWrite where getReplaceFnSub :: ReplaceFnSub
getReplaceFnSub = ReplaceFnSub
ROverWrite
instance GetReplaceFnSub 'RAppend where getReplaceFnSub :: ReplaceFnSub
getReplaceFnSub = ReplaceFnSub
RAppend
data RReplace =
RReplace !ReplaceFnSub !String
| RReplace1 !(String -> [String] -> String)
| RReplace2 !(String -> String)
| RReplace3 !([String] -> String)
instance Show RReplace where
show :: RReplace -> String
show = \case
RReplace ReplaceFnSub
o String
s -> String
"RReplace " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ReplaceFnSub -> String
forall a. Show a => a -> String
show ReplaceFnSub
o String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
RReplace1 {} -> String
"RReplace1 <fn>"
RReplace2 {} -> String
"RReplace2 <fn>"
RReplace3 {} -> String
"RReplace3 <fn>"
newtype SColor = SColor Color
deriving newtype Int -> SColor
SColor -> Int
SColor -> [SColor]
SColor -> SColor
SColor -> SColor -> [SColor]
SColor -> SColor -> SColor -> [SColor]
(SColor -> SColor)
-> (SColor -> SColor)
-> (Int -> SColor)
-> (SColor -> Int)
-> (SColor -> [SColor])
-> (SColor -> SColor -> [SColor])
-> (SColor -> SColor -> [SColor])
-> (SColor -> SColor -> SColor -> [SColor])
-> Enum SColor
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SColor -> SColor -> SColor -> [SColor]
$cenumFromThenTo :: SColor -> SColor -> SColor -> [SColor]
enumFromTo :: SColor -> SColor -> [SColor]
$cenumFromTo :: SColor -> SColor -> [SColor]
enumFromThen :: SColor -> SColor -> [SColor]
$cenumFromThen :: SColor -> SColor -> [SColor]
enumFrom :: SColor -> [SColor]
$cenumFrom :: SColor -> [SColor]
fromEnum :: SColor -> Int
$cfromEnum :: SColor -> Int
toEnum :: Int -> SColor
$ctoEnum :: Int -> SColor
pred :: SColor -> SColor
$cpred :: SColor -> SColor
succ :: SColor -> SColor
$csucc :: SColor -> SColor
Enum
instance Bounded SColor where
minBound :: SColor
minBound = Color -> SColor
SColor Color
Black
maxBound :: SColor
maxBound = Color -> SColor
SColor Color
Default
instance Show SColor where
show :: SColor -> String
show (SColor Color
c) =
case Color
c of
Color
Black -> String
"Black"
Color
Red -> String
"Red"
Color
Green -> String
"Green"
Color
Yellow -> String
"Yellow"
Color
Blue -> String
"Blue"
Color
Magenta -> String
"Magenta"
Color
Cyan -> String
"Cyan"
Color
White -> String
"White"
Color
Default -> String
"Default"
class GetColor (a :: Color) where
getColor :: Color
instance GetColor 'Black where
getColor :: Color
getColor = Color
Black
instance GetColor 'Red where
getColor :: Color
getColor = Color
Red
instance GetColor 'Green where
getColor :: Color
getColor = Color
Green
instance GetColor 'Yellow where
getColor :: Color
getColor = Color
Yellow
instance GetColor 'Blue where
getColor :: Color
getColor = Color
Blue
instance GetColor 'Magenta where
getColor :: Color
getColor = Color
Magenta
instance GetColor 'Cyan where
getColor :: Color
getColor = Color
Cyan
instance GetColor 'White where
getColor :: Color
getColor = Color
White
instance GetColor 'Default where
getColor :: Color
getColor = Color
Default
newtype SStyle = SStyle Style
deriving newtype Int -> SStyle
SStyle -> Int
SStyle -> [SStyle]
SStyle -> SStyle
SStyle -> SStyle -> [SStyle]
SStyle -> SStyle -> SStyle -> [SStyle]
(SStyle -> SStyle)
-> (SStyle -> SStyle)
-> (Int -> SStyle)
-> (SStyle -> Int)
-> (SStyle -> [SStyle])
-> (SStyle -> SStyle -> [SStyle])
-> (SStyle -> SStyle -> [SStyle])
-> (SStyle -> SStyle -> SStyle -> [SStyle])
-> Enum SStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SStyle -> SStyle -> SStyle -> [SStyle]
$cenumFromThenTo :: SStyle -> SStyle -> SStyle -> [SStyle]
enumFromTo :: SStyle -> SStyle -> [SStyle]
$cenumFromTo :: SStyle -> SStyle -> [SStyle]
enumFromThen :: SStyle -> SStyle -> [SStyle]
$cenumFromThen :: SStyle -> SStyle -> [SStyle]
enumFrom :: SStyle -> [SStyle]
$cenumFrom :: SStyle -> [SStyle]
fromEnum :: SStyle -> Int
$cfromEnum :: SStyle -> Int
toEnum :: Int -> SStyle
$ctoEnum :: Int -> SStyle
pred :: SStyle -> SStyle
$cpred :: SStyle -> SStyle
succ :: SStyle -> SStyle
$csucc :: SStyle -> SStyle
Enum
instance Bounded SStyle where
minBound :: SStyle
minBound = Style -> SStyle
SStyle Style
Normal
maxBound :: SStyle
maxBound = Style -> SStyle
SStyle Style
Reverse
instance Show SStyle where
show :: SStyle -> String
show (SStyle Style
c) =
case Style
c of
Style
Normal -> String
"Normal"
Style
Bold -> String
"Bold"
Style
Faint -> String
"Faint"
Style
Italic -> String
"Italic"
Style
Underline -> String
"Underline"
Style
SlowBlink -> String
"SlowBlink"
Style
ColoredNormal -> String
"ColoredNormal"
Style
Reverse -> String
"Reverse"
class GetStyle (a :: Style) where
getStyle :: Style
instance GetStyle 'Normal where
getStyle :: Style
getStyle = Style
Normal
instance GetStyle 'Bold where
getStyle :: Style
getStyle = Style
Bold
instance GetStyle 'Faint where
getStyle :: Style
getStyle = Style
Faint
instance GetStyle 'Italic where
getStyle :: Style
getStyle = Style
Italic
instance GetStyle 'Underline where
getStyle :: Style
getStyle = Style
Underline
instance GetStyle 'SlowBlink where
getStyle :: Style
getStyle = Style
SlowBlink
instance GetStyle 'ColoredNormal where
getStyle :: Style
getStyle = Style
ColoredNormal
instance GetStyle 'Reverse where
getStyle :: Style
getStyle = Style
Reverse
unlessNull :: (AsEmpty t, Monoid m) => t -> m -> m
unlessNull :: t -> m -> m
unlessNull t
t m
m | Getting Any t () -> t -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any t ()
forall a. AsEmpty a => Prism' a ()
_Empty t
t = m
forall a. Monoid a => a
mempty
| Bool
otherwise = m
m
unlessNullM :: (AsEmpty t, Applicative m) => t -> (t -> m ()) -> m ()
unlessNullM :: t -> (t -> m ()) -> m ()
unlessNullM t
t t -> m ()
f
| Getting Any t () -> t -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any t ()
forall a. AsEmpty a => Prism' a ()
_Empty t
t = () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = t -> m ()
f t
t
nullSpace :: String -> String
nullSpace :: ShowS
nullSpace = String -> ShowS
nullIf String
" "
nullIf :: String -> String -> String
nullIf :: String -> ShowS
nullIf String
s String
t
| (Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
t = String
""
| Bool
otherwise = String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
pureTryTest :: a -> IO (Either () a)
pureTryTest :: a -> IO (Either () a)
pureTryTest = (Either SomeException a -> Either () a)
-> IO (Either SomeException a) -> IO (Either () a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeException -> ()) -> Either SomeException a -> Either () a
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (() -> SomeException -> ()
forall a b. a -> b -> a
const ())) (IO (Either SomeException a) -> IO (Either () a))
-> (a -> IO (Either SomeException a)) -> a -> IO (Either () a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Exception SomeException =>
IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException (IO a -> IO (Either SomeException a))
-> (a -> IO a) -> a -> IO (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall a. a -> IO a
E.evaluate
pureTryTestPred :: (String -> Bool)
-> a
-> IO (Either String (Either () a))
pureTryTestPred :: (String -> Bool) -> a -> IO (Either String (Either () a))
pureTryTestPred String -> Bool
p a
a = do
Either String a
lr <- (SomeException -> String)
-> Either SomeException a -> Either String a
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left SomeException -> String
forall e. Exception e => e -> String
E.displayException (Either SomeException a -> Either String a)
-> IO (Either SomeException a) -> IO (Either String a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException (a -> IO a
forall a. a -> IO a
E.evaluate a
a)
Either String (Either () a) -> IO (Either String (Either () a))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either String (Either () a) -> IO (Either String (Either () a)))
-> Either String (Either () a) -> IO (Either String (Either () a))
forall a b. (a -> b) -> a -> b
$ case Either String a
lr of
Left String
e | String -> Bool
p String
e -> Either () a -> Either String (Either () a)
forall a b. b -> Either a b
Right (() -> Either () a
forall a b. a -> Either a b
Left ())
| Bool
otherwise -> String -> Either String (Either () a)
forall a b. a -> Either a b
Left (String
"no match found: e=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)
Right a
r -> Either () a -> Either String (Either () a)
forall a b. b -> Either a b
Right (a -> Either () a
forall a b. b -> Either a b
Right a
r)
drawTreeU :: Tree String -> String
drawTreeU :: Tree String -> String
drawTreeU = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String)
-> (Tree String -> [String]) -> Tree String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree String -> [String]
drawU
drawU :: Tree String -> [String]
drawU :: Tree String -> [String]
drawU (Node String
x Forest String
ts0) = String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Forest String -> [String]
drawSubTrees Forest String
ts0
where
drawSubTrees :: Forest String -> [String]
drawSubTrees [] = []
drawSubTrees [Tree String
t] =
String -> String -> [String] -> [String]
forall a. [a] -> [a] -> [[a]] -> [[a]]
shift String
"\x2514\x2500" String
" " (Tree String -> [String]
drawU Tree String
t)
drawSubTrees (Tree String
t:Forest String
ts) =
String -> String -> [String] -> [String]
forall a. [a] -> [a] -> [[a]] -> [[a]]
shift String
"\x251c\x2500" String
"\x2502 " (Tree String -> [String]
drawU Tree String
t) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Forest String -> [String]
drawSubTrees Forest String
ts
shift :: [a] -> [a] -> [[a]] -> [[a]]
shift [a]
one [a]
other = ([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a]
one [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. a -> [a]
repeat [a]
other)
removeAnsi :: Show a => Either String a -> IO ()
removeAnsi :: Either String a -> IO ()
removeAnsi = String -> IO ()
putStrLn (String -> IO ())
-> (Either String a -> String) -> Either String a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String a -> String
forall a. Show a => Either String a -> String
removeAnsiImpl
removeAnsiImpl :: Show a => Either String a -> String
removeAnsiImpl :: Either String a -> String
removeAnsiImpl =
\case
Left String
e -> let esc :: Char
esc = Char
'\x1b'
f :: String -> Maybe (String, String)
f :: String -> Maybe (String, String)
f = \case
[] -> Maybe (String, String)
forall a. Maybe a
Nothing
Char
c:String
cs | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
esc -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'm') String
cs of
(String
_,Char
'm':String
s) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
"",String
s)
(String, String)
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
| Bool
otherwise -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((String, String) -> Maybe (String, String))
-> (String, String) -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
esc) (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)
in [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (String, String)) -> String -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr String -> Maybe (String, String)
f String
e
Right a
a -> a -> String
forall a. Show a => a -> String
show a
a
_Id :: Lens (Identity a) (Identity b) a b
_Id :: (a -> f b) -> Identity a -> f (Identity b)
_Id a -> f b
afb (Identity a
a) = b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> f b -> f (Identity b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb a
a
class Bifunctor p => SwapC p where
swapC :: p a b -> p b a
instance SwapC Either where
swapC :: Either a b -> Either b a
swapC (Left a
a) = a -> Either b a
forall a b. b -> Either a b
Right a
a
swapC (Right b
a) = b -> Either b a
forall a b. a -> Either a b
Left b
a
instance SwapC These where
swapC :: These a b -> These b a
swapC (This a
a) = a -> These b a
forall a b. b -> These a b
That a
a
swapC (That b
b) = b -> These b a
forall a b. a -> These a b
This b
b
swapC (These a
a b
b) = b -> a -> These b a
forall a b. a -> b -> These a b
These b
b a
a
instance SwapC SG.Arg where
swapC :: Arg a b -> Arg b a
swapC (SG.Arg a
a b
b) = b -> a -> Arg b a
forall a b. a -> b -> Arg a b
SG.Arg b
b a
a
instance SwapC (,) where
swapC :: (a, b) -> (b, a)
swapC (a
a,b
b) = (b
b,a
a)
instance SwapC ((,,) a) where
swapC :: (a, a, b) -> (a, b, a)
swapC (a
a,a
b,b
c) = (a
a,b
c,a
b)
instance SwapC ((,,,) a b) where
swapC :: (a, b, a, b) -> (a, b, b, a)
swapC (a
a,b
b,a
c,b
d) = (a
a,b
b,b
d,a
c)
instance SwapC ((,,,,) a b c) where
swapC :: (a, b, c, a, b) -> (a, b, c, b, a)
swapC (a
a,b
b,c
c,a
d,b
e) = (a
a,b
b,c
c,b
e,a
d)
instance SwapC ((,,,,,) a b c d) where
swapC :: (a, b, c, d, a, b) -> (a, b, c, d, b, a)
swapC (a
a,b
b,c
c,d
d,a
e,b
f) = (a
a,b
b,c
c,d
d,b
f,a
e)
instance SwapC ((,,,,,,) a b c d e) where
swapC :: (a, b, c, d, e, a, b) -> (a, b, c, d, e, b, a)
swapC (a
a,b
b,c
c,d
d,e
e,a
f,b
g) = (a
a,b
b,c
c,d
d,e
e,b
g,a
f)
sum' :: (Foldable t, Num a) => t a -> a
sum' :: t a -> a
sum' = (a -> a -> a) -> a -> t a -> a
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
product' :: (Foldable t, Num a) => t a -> a
product' :: t a -> a
product' = (a -> a -> a) -> a -> t a -> a
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1
foldMapStrict :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
foldMapStrict :: (a -> m) -> t a -> m
foldMapStrict a -> m
f = (m -> a -> m) -> m -> t a -> m
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\m
z a
a -> m
z m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
a) m
forall a. Monoid a => a
mempty
cmpOf :: Eq a => Ordering -> ([a] -> [a] -> Bool, String)
cmpOf :: Ordering -> ([a] -> [a] -> Bool, String)
cmpOf = \case
Ordering
LT -> ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf, String
"IsPrefix")
Ordering
EQ -> ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf, String
"IsInfix")
Ordering
GT -> (Getting Any [a] [a] -> [a] -> Bool
forall s a. Getting Any s a -> s -> Bool
has (Getting Any [a] [a] -> [a] -> Bool)
-> ([a] -> Getting Any [a] [a]) -> [a] -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Getting Any [a] [a]
forall a. Eq a => [a] -> Prism' [a] [a]
suffixed, String
"IsSuffix")
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: m Bool -> m a -> m a -> m a
ifM m Bool
mb m a
mt m a
mf = do
Bool
b <- m Bool
mb
if Bool
b then m a
mt else m a
mf
class AssocC p where
assoc :: p (p a b) c -> p a (p b c)
unassoc :: p a (p b c) -> p (p a b) c
instance AssocC Either where
assoc :: Either (Either a b) c -> Either a (Either b c)
assoc (Left (Left a
a)) = a -> Either a (Either b c)
forall a b. a -> Either a b
Left a
a
assoc (Left (Right b
b)) = Either b c -> Either a (Either b c)
forall a b. b -> Either a b
Right (b -> Either b c
forall a b. a -> Either a b
Left b
b)
assoc (Right c
b) = Either b c -> Either a (Either b c)
forall a b. b -> Either a b
Right (c -> Either b c
forall a b. b -> Either a b
Right c
b)
unassoc :: Either a (Either b c) -> Either (Either a b) c
unassoc (Left a
a) = Either a b -> Either (Either a b) c
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
a)
unassoc (Right (Left b
b)) = Either a b -> Either (Either a b) c
forall a b. a -> Either a b
Left (b -> Either a b
forall a b. b -> Either a b
Right b
b)
unassoc (Right (Right c
b)) = c -> Either (Either a b) c
forall a b. b -> Either a b
Right c
b
instance AssocC These where
assoc :: These (These a b) c -> These a (These b c)
assoc (This (This a
a)) = a -> These a (These b c)
forall a b. a -> These a b
This a
a
assoc (This (That b
b)) = These b c -> These a (These b c)
forall a b. b -> These a b
That (b -> These b c
forall a b. a -> These a b
This b
b)
assoc (This (These a
a b
b)) = a -> These b c -> These a (These b c)
forall a b. a -> b -> These a b
These a
a (b -> These b c
forall a b. a -> These a b
This b
b)
assoc (That c
c) = These b c -> These a (These b c)
forall a b. b -> These a b
That (c -> These b c
forall a b. b -> These a b
That c
c)
assoc (These (This a
a) c
c) = a -> These b c -> These a (These b c)
forall a b. a -> b -> These a b
These a
a (c -> These b c
forall a b. b -> These a b
That c
c)
assoc (These (That b
b) c
c) = These b c -> These a (These b c)
forall a b. b -> These a b
That (b -> c -> These b c
forall a b. a -> b -> These a b
These b
b c
c)
assoc (These (These a
a b
b) c
c) = a -> These b c -> These a (These b c)
forall a b. a -> b -> These a b
These a
a (b -> c -> These b c
forall a b. a -> b -> These a b
These b
b c
c)
unassoc :: These a (These b c) -> These (These a b) c
unassoc (This a
a) = These a b -> These (These a b) c
forall a b. a -> These a b
This (a -> These a b
forall a b. a -> These a b
This a
a)
unassoc (That (This b
b)) = These a b -> These (These a b) c
forall a b. a -> These a b
This (b -> These a b
forall a b. b -> These a b
That b
b)
unassoc (That (That c
c)) = c -> These (These a b) c
forall a b. b -> These a b
That c
c
unassoc (That (These b
b c
c)) = These a b -> c -> These (These a b) c
forall a b. a -> b -> These a b
These (b -> These a b
forall a b. b -> These a b
That b
b) c
c
unassoc (These a
a (This b
b)) = These a b -> These (These a b) c
forall a b. a -> These a b
This (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b)
unassoc (These a
a (That c
c)) = These a b -> c -> These (These a b) c
forall a b. a -> b -> These a b
These (a -> These a b
forall a b. a -> These a b
This a
a) c
c
unassoc (These a
a (These b
b c
c)) = These a b -> c -> These (These a b) c
forall a b. a -> b -> These a b
These (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b) c
c
instance AssocC (,) where
assoc :: ((a, b), c) -> (a, (b, c))
assoc ((a
a,b
b),c
c) = (a
a,(b
b,c
c))
unassoc :: (a, (b, c)) -> ((a, b), c)
unassoc (a
a,(b
b,c
c)) = ((a
a,b
b),c
c)
simpleAlign :: [a] -> [b] -> [These a b]
simpleAlign :: [a] -> [b] -> [These a b]
simpleAlign [a]
as [] = (a -> These a b) -> [a] -> [These a b]
forall a b. (a -> b) -> [a] -> [b]
map a -> These a b
forall a b. a -> These a b
This [a]
as
simpleAlign [] [b]
bs = (b -> These a b) -> [b] -> [These a b]
forall a b. (a -> b) -> [a] -> [b]
map b -> These a b
forall a b. b -> These a b
That [b]
bs
simpleAlign (a
a:[a]
as) (b
b:[b]
bs) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b These a b -> [These a b] -> [These a b]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [These a b]
forall a b. [a] -> [b] -> [These a b]
simpleAlign [a]
as [b]
bs