module Generics.SOP.Skeleton (
Skeleton(..)
) where
import Control.Exception
import Data.Text (Text)
import Generics.SOP
class Skeleton a where
default skeleton :: (Generic a, HasDatatypeInfo a, Code a ~ '[xs], All Skeleton xs) => a
skeleton :: a
skeleton = forall a (xs :: [*]).
(Generic a, HasDatatypeInfo a, Code a ~ '[xs], All Skeleton xs) =>
a
gskeleton
instance Skeleton [a] where skeleton :: [a]
skeleton = forall a. HasCallStack => a
undefined
instance Skeleton (Maybe a) where skeleton :: Maybe a
skeleton = forall a. HasCallStack => a
undefined
instance Skeleton Int where skeleton :: Int
skeleton = forall a. HasCallStack => a
undefined
instance Skeleton Double where skeleton :: Double
skeleton = forall a. HasCallStack => a
undefined
instance Skeleton Rational where skeleton :: Rational
skeleton = forall a. HasCallStack => a
undefined
instance Skeleton Bool where skeleton :: Bool
skeleton = forall a. HasCallStack => a
undefined
instance Skeleton Text where skeleton :: Text
skeleton = forall a. HasCallStack => a
undefined
gskeleton :: forall a xs. (Generic a, HasDatatypeInfo a, Code a ~ '[xs], All Skeleton xs) => a
gskeleton :: forall a (xs :: [*]).
(Generic a, HasDatatypeInfo a, Code a ~ '[xs], All Skeleton xs) =>
a
gskeleton = forall a. Generic a => Rep a -> a
to forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]).
All Skeleton xs =>
DatatypeInfo '[xs] -> SOP I '[xs]
gskeleton' (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
gskeleton' :: All Skeleton xs => DatatypeInfo '[xs] -> SOP I '[xs]
gskeleton' :: forall (xs :: [*]).
All Skeleton xs =>
DatatypeInfo '[xs] -> SOP I '[xs]
gskeleton' DatatypeInfo '[xs]
d = forall (xs :: [*]).
All Skeleton xs =>
ConstructorInfo xs -> SOP I '[xs]
gskeletonFor (forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd (forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo DatatypeInfo '[xs]
d))
gskeletonFor :: All Skeleton xs => ConstructorInfo xs -> SOP I '[xs]
gskeletonFor :: forall (xs :: [*]).
All Skeleton xs =>
ConstructorInfo xs -> SOP I '[xs]
gskeletonFor (Constructor ConstructorName
_) = forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]).
(All Skeleton xs, SListI xs) =>
NP (K ConstructorName) xs -> NP I xs
spineWithNames (forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure (forall k a (b :: k). a -> K a b
K ConstructorName
""))
gskeletonFor (Infix ConstructorName
_ Associativity
_ Int
_) = forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]).
(All Skeleton xs, SListI xs) =>
NP (K ConstructorName) xs -> NP I xs
spineWithNames (forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure (forall k a (b :: k). a -> K a b
K ConstructorName
""))
gskeletonFor (Record ConstructorName
_ NP FieldInfo xs
fs) = forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]).
(All Skeleton xs, SListI xs) =>
NP (K ConstructorName) xs -> NP I xs
spineWithNames (forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
(f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hliftA forall a. FieldInfo a -> K ConstructorName a
sfieldName NP FieldInfo xs
fs)
where
sfieldName :: FieldInfo a -> K String a
sfieldName :: forall a. FieldInfo a -> K ConstructorName a
sfieldName (FieldInfo ConstructorName
n) = forall k a (b :: k). a -> K a b
K ConstructorName
n
spineWithNames :: (All Skeleton xs, SListI xs) => NP (K String) xs -> NP I xs
spineWithNames :: forall (xs :: [*]).
(All Skeleton xs, SListI xs) =>
NP (K ConstructorName) xs -> NP I xs
spineWithNames = forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcliftA Proxy Skeleton
ps forall a. Skeleton a => K ConstructorName a -> I a
aux
where
aux :: Skeleton a => K String a -> I a
aux :: forall a. Skeleton a => K ConstructorName a -> I a
aux (K ConstructorName
"") = forall a. a -> I a
I forall a b. (a -> b) -> a -> b
$ forall a. Skeleton a => a
skeleton
aux (K ConstructorName
n) = forall a. a -> I a
I forall a b. (a -> b) -> a -> b
$ forall e1 e2 a.
(Exception e1, Exception e2) =>
(e1 -> e2) -> a -> a
mapException (ConstructorName -> ErrorCall -> ErrorCall
addFieldName ConstructorName
n) forall a. Skeleton a => a
skeleton
addFieldName :: FieldName -> ErrorCall -> ErrorCall
#if MIN_VERSION_base(4,9,0)
addFieldName :: ConstructorName -> ErrorCall -> ErrorCall
addFieldName ConstructorName
n (ErrorCallWithLocation ConstructorName
str ConstructorName
loc) =
ConstructorName -> ConstructorName -> ErrorCall
ErrorCallWithLocation (ConstructorName
n forall a. [a] -> [a] -> [a]
++ ConstructorName
": " forall a. [a] -> [a] -> [a]
++ ConstructorName
str) ConstructorName
loc
#else
addFieldName n (ErrorCall str) = ErrorCall (n ++ ": " ++ str)
#endif
ps :: Proxy Skeleton
ps :: Proxy Skeleton
ps = forall {k} (t :: k). Proxy t
Proxy