{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Trustworthy #-}
module Generic.Data.Internal.Read where
import Data.Coerce
import Data.Functor.Classes (Read1(..))
import Data.Functor.Identity
import Data.Proxy
import Generic.Data.Internal.Utils (isSymDataCon, isSymVar)
import GHC.Generics hiding (prec)
import GHC.Read (expectP, list)
import GHC.Show (appPrec, appPrec1)
import Text.ParserCombinators.ReadPrec
import Text.Read (Read(..), parens)
import Text.Read.Lex (Lexeme(..))
greadPrec :: (Generic a, GRead0 (Rep a)) => ReadPrec a
greadPrec :: ReadPrec a
greadPrec = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> ReadPrec (Rep a Any) -> ReadPrec a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (ReadPrec Any, ReadPrec [Any]) -> ReadPrec (Rep a Any)
forall (p :: * -> *) (f :: * -> *) a.
GRead p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecRead Proxy (ReadPrec Any, ReadPrec [Any])
forall k (t :: k). Proxy t
Proxy
type GRead0 = GRead Proxy
gliftReadPrec
:: (Generic1 f, GRead1 (Rep1 f))
=> ReadPrec a -> ReadPrec [a]
-> ReadPrec (f a)
gliftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
gliftReadPrec readPrec' :: ReadPrec a
readPrec' readList' :: ReadPrec [a]
readList' =
Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 f a -> f a) -> ReadPrec (Rep1 f a) -> ReadPrec (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity (ReadPrec a, ReadPrec [a]) -> ReadPrec (Rep1 f a)
forall (p :: * -> *) (f :: * -> *) a.
GRead p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecRead ((ReadPrec a, ReadPrec [a]) -> Identity (ReadPrec a, ReadPrec [a])
forall a. a -> Identity a
Identity (ReadPrec a
readPrec', ReadPrec [a]
readList'))
type GRead1 = GRead Identity
class GRead p f where
gPrecRead :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
instance (GRead p f, IsNullaryDataType f) => GRead p (M1 D d f) where
gPrecRead :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (M1 D d f a)
gPrecRead p :: p (ReadPrec a, ReadPrec [a])
p = ReadPrec (f a) -> ReadPrec (M1 D d f a)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec (f a) -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec a
parensIfNonNullary (p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
forall (p :: * -> *) (f :: * -> *) a.
GRead p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecRead p (ReadPrec a, ReadPrec [a])
p))
where
x :: f a
x :: f a
x = f a
forall a. HasCallStack => a
undefined
parensIfNonNullary :: ReadPrec a -> ReadPrec a
parensIfNonNullary :: ReadPrec a -> ReadPrec a
parensIfNonNullary = if f Any -> Bool
forall (f :: * -> *) a. IsNullaryDataType f => f a -> Bool
isNullaryDataType f Any
forall a. f a
x
then ReadPrec a -> ReadPrec a
forall a. a -> a
id
else ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
parens
instance (GRead p f, GRead p g) => GRead p (f :+: g) where
gPrecRead :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec ((:+:) f g a)
gPrecRead p :: p (ReadPrec a, ReadPrec [a])
p = (f a -> (:+:) f g a) -> ReadPrec (f a) -> ReadPrec ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
forall (p :: * -> *) (f :: * -> *) a.
GRead p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecRead p (ReadPrec a, ReadPrec [a])
p) ReadPrec ((:+:) f g a)
-> ReadPrec ((:+:) f g a) -> ReadPrec ((:+:) f g a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ (g a -> (:+:) f g a) -> ReadPrec (g a) -> ReadPrec ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (p (ReadPrec a, ReadPrec [a]) -> ReadPrec (g a)
forall (p :: * -> *) (f :: * -> *) a.
GRead p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecRead p (ReadPrec a, ReadPrec [a])
p)
instance (Constructor c, GReadC p c f) => GRead p (M1 C c f) where
gPrecRead :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (M1 C c f a)
gPrecRead p :: p (ReadPrec a, ReadPrec [a])
p = p (ReadPrec a, ReadPrec [a])
-> String -> Fixity -> ReadPrec (M1 C c f a)
forall (p :: * -> *) (c :: Meta) (f :: * -> *) a.
GReadC p c f =>
p (ReadPrec a, ReadPrec [a])
-> String -> Fixity -> ReadPrec (M1 C c f a)
gPrecReadC p (ReadPrec a, ReadPrec [a])
p (M1 C c f Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 C c f Any
forall a. M1 C c f a
x) (M1 C c f Any -> Fixity
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
conFixity M1 C c f Any
forall a. M1 C c f a
x)
where
x :: M1 C c f a
x :: M1 C c f a
x = M1 C c f a
forall a. HasCallStack => a
undefined
instance GRead p V1 where
gPrecRead :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (V1 a)
gPrecRead _ = ReadPrec (V1 a)
forall a. ReadPrec a
pfail
class IsNullaryDataType f where
isNullaryDataType :: f a -> Bool
instance IsNullaryDataType (f :+: g) where
isNullaryDataType :: (:+:) f g a -> Bool
isNullaryDataType _ = Bool
False
instance IsNullaryDataType (C1 c f) where
isNullaryDataType :: C1 c f a -> Bool
isNullaryDataType _ = Bool
False
instance IsNullaryDataType V1 where
isNullaryDataType :: V1 a -> Bool
isNullaryDataType _ = Bool
True
class GReadC p c f where
gPrecReadC :: p (ReadPrec a, ReadPrec [a]) -> String -> Fixity -> ReadPrec (M1 C c f a)
instance GReadFields p f => GReadC p ('MetaCons s y 'False) f where
gPrecReadC :: forall a. p (ReadPrec a, ReadPrec [a]) -> String -> Fixity
-> ReadPrec (M1 C ('MetaCons s y 'False) f a)
gPrecReadC :: p (ReadPrec a, ReadPrec [a])
-> String -> Fixity -> ReadPrec (M1 C ('MetaCons s y 'False) f a)
gPrecReadC p :: p (ReadPrec a, ReadPrec [a])
p name :: String
name fixity :: Fixity
fixity
| Infix _ fy :: Int
fy <- Fixity
fixity, Branch k1 :: ReadPrecTree (f a)
k1 k2 :: ReadPrecTree (g a)
k2 <- ReadPrecTree (f a)
fields
= ReadPrec ((:*:) f g a)
-> ReadPrec (M1 C ('MetaCons s y 'False) f a)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec ((:*:) f g a)
-> ReadPrec (M1 C ('MetaCons s y 'False) f a))
-> ReadPrec ((:*:) f g a)
-> ReadPrec (M1 C ('MetaCons s y 'False) f a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
fy (ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a))
-> ReadPrec ((:*:) f g a) -> ReadPrec ((:*:) f g a)
forall a b. (a -> b) -> a -> b
$ do
f a
k1' <- ReadPrecTree (f a) -> ReadPrec (f a)
forall a. ReadPrecTree a -> ReadPrec a
toReadPrec ReadPrecTree (f a)
k1
if String -> Bool
isSymDataCon String
name
then Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Symbol String
name)
else (Lexeme -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Lexeme -> ReadPrec ()
expectP ([String -> Lexeme
Punc "`"] [Lexeme] -> [Lexeme] -> [Lexeme]
forall a. [a] -> [a] -> [a]
++ String -> [Lexeme]
identHLexemes String
name [Lexeme] -> [Lexeme] -> [Lexeme]
forall a. [a] -> [a] -> [a]
++ [String -> Lexeme
Punc "`"])
g a
k2' <- ReadPrecTree (g a) -> ReadPrec (g a)
forall a. ReadPrecTree a -> ReadPrec a
toReadPrec ReadPrecTree (g a)
k2
(:*:) f g a -> ReadPrec ((:*:) f g a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a
k1' f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
k2')
| Bool
otherwise
= ReadPrec (f a) -> ReadPrec (M1 C ('MetaCons s y 'False) f a)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec (f a) -> ReadPrec (M1 C ('MetaCons s y 'False) f a))
-> ReadPrec (f a) -> ReadPrec (M1 C ('MetaCons s y 'False) f a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (f a) -> ReadPrec (f a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
appPrec (ReadPrec (f a) -> ReadPrec (f a))
-> ReadPrec (f a) -> ReadPrec (f a)
forall a b. (a -> b) -> a -> b
$ do
String -> ReadPrec ()
readPrefixCon String
name
ReadPrecTree (f a) -> ReadPrec (f a)
forall a. ReadPrecTree a -> ReadPrec a
toReadPrec ReadPrecTree (f a)
fields
where
fields :: ReadPrecTree (f a)
fields :: ReadPrecTree (f a)
fields = p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (f a)
forall (p :: * -> *) (f :: * -> *) a.
GReadFields p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (f a)
gPrecReadFields p (ReadPrec a, ReadPrec [a])
p
instance GReadNamed p f => GReadC p ('MetaCons s y 'True) f where
gPrecReadC :: p (ReadPrec a, ReadPrec [a])
-> String -> Fixity -> ReadPrec (M1 C ('MetaCons s y 'True) f a)
gPrecReadC p :: p (ReadPrec a, ReadPrec [a])
p name :: String
name _fixity :: Fixity
_fixity = ReadPrec (f a) -> ReadPrec (M1 C ('MetaCons s y 'True) f a)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec (f a) -> ReadPrec (M1 C ('MetaCons s y 'True) f a))
-> ReadPrec (f a) -> ReadPrec (M1 C ('MetaCons s y 'True) f a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (f a) -> ReadPrec (f a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
appPrec1 (ReadPrec (f a) -> ReadPrec (f a))
-> ReadPrec (f a) -> ReadPrec (f a)
forall a b. (a -> b) -> a -> b
$ do
String -> ReadPrec ()
readPrefixCon String
name
Char -> ReadPrec (f a) -> Char -> ReadPrec (f a)
forall a. Char -> ReadPrec a -> Char -> ReadPrec a
readSurround '{' ReadPrec (f a)
fields '}'
where
fields :: ReadPrec (f a)
fields = p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
forall (p :: * -> *) (f :: * -> *) a.
GReadNamed p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecReadNamed p (ReadPrec a, ReadPrec [a])
p
class GReadFields p f where
gPrecReadFields :: p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (f a)
instance (GReadFields p f, GReadFields p g) => GReadFields p (f :*: g) where
gPrecReadFields :: p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree ((:*:) f g a)
gPrecReadFields p :: p (ReadPrec a, ReadPrec [a])
p = ReadPrecTree (f a)
-> ReadPrecTree (g a) -> ReadPrecTree ((:*:) f g a)
forall (i :: * -> *) c (g :: * -> *).
ReadPrecTree (i c)
-> ReadPrecTree (g c) -> ReadPrecTree ((:*:) i g c)
Branch (p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (f a)
forall (p :: * -> *) (f :: * -> *) a.
GReadFields p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (f a)
gPrecReadFields p (ReadPrec a, ReadPrec [a])
p) (p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (g a)
forall (p :: * -> *) (f :: * -> *) a.
GReadFields p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (f a)
gPrecReadFields p (ReadPrec a, ReadPrec [a])
p)
instance GReadSingle p f => GReadFields p (M1 S c f) where
gPrecReadFields :: p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (M1 S c f a)
gPrecReadFields p :: p (ReadPrec a, ReadPrec [a])
p = ReadPrec (f a) -> ReadPrecTree (M1 S c f a)
forall (f :: * -> *) a i (c :: Meta).
ReadPrec (f a) -> ReadPrecTree (M1 i c f a)
M1Leaf (ReadPrec (f a) -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec a
step (p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
forall (p :: * -> *) (f :: * -> *) a.
GReadSingle p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecReadSingle p (ReadPrec a, ReadPrec [a])
p))
instance GReadFields p U1 where
gPrecReadFields :: p (ReadPrec a, ReadPrec [a]) -> ReadPrecTree (U1 a)
gPrecReadFields _ = ReadPrecTree (U1 a)
forall a. ReadPrecTree (U1 a)
U1Leaf
class GReadNamed p f where
gPrecReadNamed :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
instance (GReadNamed p f, GReadNamed p g) => GReadNamed p (f :*: g) where
gPrecReadNamed :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec ((:*:) f g a)
gPrecReadNamed p :: p (ReadPrec a, ReadPrec [a])
p = do
f a
l <- p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
forall (p :: * -> *) (f :: * -> *) a.
GReadNamed p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecReadNamed p (ReadPrec a, ReadPrec [a])
p
Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Punc ",")
g a
r <- p (ReadPrec a, ReadPrec [a]) -> ReadPrec (g a)
forall (p :: * -> *) (f :: * -> *) a.
GReadNamed p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecReadNamed p (ReadPrec a, ReadPrec [a])
p
(:*:) f g a -> ReadPrec ((:*:) f g a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a
l f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
r)
instance (Selector c, GReadSingle p f) => GReadNamed p (M1 S c f) where
gPrecReadNamed :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (M1 S c f a)
gPrecReadNamed p :: p (ReadPrec a, ReadPrec [a])
p = ReadPrec (f a) -> ReadPrec (M1 S c f a)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 (ReadPrec (f a) -> ReadPrec (M1 S c f a))
-> ReadPrec (f a) -> ReadPrec (M1 S c f a)
forall a b. (a -> b) -> a -> b
$ do
(Lexeme -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Lexeme -> ReadPrec ()
expectP [Lexeme]
snameLexemes
Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Punc "=")
ReadPrec (f a) -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec a
reset (p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
forall (p :: * -> *) (f :: * -> *) a.
GReadSingle p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecReadSingle p (ReadPrec a, ReadPrec [a])
p)
where
x :: M1 S c f a
x :: M1 S c f a
x = M1 S c f a
forall a. HasCallStack => a
undefined
sname :: String
sname :: String
sname = M1 S c f Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S c f Any
forall a. M1 S c f a
x
snameLexemes :: [Lexeme]
snameLexemes :: [Lexeme]
snameLexemes | String -> Bool
isSymVar String
sname
= [String -> Lexeme
Punc "(", String -> Lexeme
Symbol String
sname, String -> Lexeme
Punc ")"]
| Bool
otherwise
= String -> [Lexeme]
identHLexemes String
sname
instance GReadNamed p U1 where
gPrecReadNamed :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (U1 a)
gPrecReadNamed _ = U1 a -> ReadPrec (U1 a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
class GReadSingle p f where
gPrecReadSingle :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
instance Read a => GReadSingle p (K1 i a) where
gPrecReadSingle :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec (K1 i a a)
gPrecReadSingle _ = ReadPrec a -> ReadPrec (K1 i a a)
forall x. ReadPrec a -> ReadPrec (K1 i a x)
coerceK1 ReadPrec a
forall a. Read a => ReadPrec a
readPrec
where
coerceK1 :: ReadPrec a -> ReadPrec (K1 i a x)
coerceK1 :: ReadPrec a -> ReadPrec (K1 i a x)
coerceK1 = ReadPrec a -> ReadPrec (K1 i a x)
forall a b. Coercible a b => a -> b
coerce
instance Read1 f => GReadSingle Identity (Rec1 f) where
gPrecReadSingle :: Identity (ReadPrec a, ReadPrec [a]) -> ReadPrec (Rec1 f a)
gPrecReadSingle (Identity p :: (ReadPrec a, ReadPrec [a])
p) = ReadPrec (f a) -> ReadPrec (Rec1 f a)
forall a. ReadPrec (f a) -> ReadPrec (Rec1 f a)
coerceRec1 ((ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
(ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
liftReadPrecCompat (ReadPrec a, ReadPrec [a])
p)
where
coerceRec1 :: ReadPrec (f a) -> ReadPrec (Rec1 f a)
coerceRec1 :: ReadPrec (f a) -> ReadPrec (Rec1 f a)
coerceRec1 = ReadPrec (f a) -> ReadPrec (Rec1 f a)
forall a b. Coercible a b => a -> b
coerce
instance GReadSingle Identity Par1 where
gPrecReadSingle :: Identity (ReadPrec a, ReadPrec [a]) -> ReadPrec (Par1 a)
gPrecReadSingle (Identity (readPrec' :: ReadPrec a
readPrec', _)) = ReadPrec a -> ReadPrec (Par1 a)
forall p. ReadPrec p -> ReadPrec (Par1 p)
coercePar1 ReadPrec a
readPrec'
where
coercePar1 :: ReadPrec p -> ReadPrec (Par1 p)
coercePar1 :: ReadPrec p -> ReadPrec (Par1 p)
coercePar1 = ReadPrec p -> ReadPrec (Par1 p)
forall a b. Coercible a b => a -> b
coerce
instance (Read1 f, GReadSingle p g) => GReadSingle p (f :.: g) where
gPrecReadSingle :: forall a. p (ReadPrec a, ReadPrec [a]) -> ReadPrec ((f :.: g) a)
gPrecReadSingle :: p (ReadPrec a, ReadPrec [a]) -> ReadPrec ((:.:) f g a)
gPrecReadSingle p :: p (ReadPrec a, ReadPrec [a])
p = ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
coerceComp1 ((ReadPrec (g a), ReadPrec [g a]) -> ReadPrec (f (g a))
forall (f :: * -> *) a.
Read1 f =>
(ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
liftReadPrecCompat (ReadPrec (g a)
readPrec_, ReadPrec [g a]
readList_))
where
readPrec_ :: ReadPrec (g a)
readPrec_ :: ReadPrec (g a)
readPrec_ = p (ReadPrec a, ReadPrec [a]) -> ReadPrec (g a)
forall (p :: * -> *) (f :: * -> *) a.
GReadSingle p f =>
p (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
gPrecReadSingle p (ReadPrec a, ReadPrec [a])
p
readList_ :: ReadPrec [g a]
readList_ :: ReadPrec [g a]
readList_ = ReadPrec (g a) -> ReadPrec [g a]
forall a. ReadPrec a -> ReadPrec [a]
list ReadPrec (g a)
readPrec_
coerceComp1 :: ReadPrec (f (g a)) -> ReadPrec ((f :.: g) a)
coerceComp1 :: ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
coerceComp1 = ReadPrec (f (g a)) -> ReadPrec ((:.:) f g a)
forall a b. Coercible a b => a -> b
coerce
coerceM1 :: ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 :: ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 = ReadPrec (f p) -> ReadPrec (M1 i c f p)
forall a b. Coercible a b => a -> b
coerce
liftReadPrecCompat :: Read1 f => (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
liftReadPrecCompat :: (ReadPrec a, ReadPrec [a]) -> ReadPrec (f a)
liftReadPrecCompat (readPrec' :: ReadPrec a
readPrec', readList' :: ReadPrec [a]
readList') =
#if MIN_VERSION_base(4,10,0)
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
readPrec' ReadPrec [a]
readList'
#else
readS_to_Prec (liftReadsPrec (readPrec_to_S readPrec')
(readPrec_to_S readList' 0))
#endif
data ReadPrecTree a where
U1Leaf :: ReadPrecTree (U1 a)
M1Leaf :: ReadPrec (f a) -> ReadPrecTree (M1 i c f a)
Branch :: ReadPrecTree (f a) -> ReadPrecTree (g a) -> ReadPrecTree ((f :*: g) a)
toReadPrec :: ReadPrecTree a -> ReadPrec a
toReadPrec :: ReadPrecTree a -> ReadPrec a
toReadPrec U1Leaf = U1 a -> ReadPrec (U1 a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
toReadPrec (M1Leaf f :: ReadPrec (f a)
f) = ReadPrec (f a) -> ReadPrec (M1 i c f a)
forall (f :: * -> *) p i (c :: Meta).
ReadPrec (f p) -> ReadPrec (M1 i c f p)
coerceM1 ReadPrec (f a)
f
toReadPrec (Branch f :: ReadPrecTree (f a)
f g :: ReadPrecTree (g a)
g) = f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f a -> g a -> (:*:) f g a)
-> ReadPrec (f a) -> ReadPrec (g a -> (:*:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrecTree (f a) -> ReadPrec (f a)
forall a. ReadPrecTree a -> ReadPrec a
toReadPrec ReadPrecTree (f a)
f ReadPrec (g a -> (:*:) f g a)
-> ReadPrec (g a) -> ReadPrec ((:*:) f g a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrecTree (g a) -> ReadPrec (g a)
forall a. ReadPrecTree a -> ReadPrec a
toReadPrec ReadPrecTree (g a)
g
identHLexemes :: String -> [Lexeme]
identHLexemes :: String -> [Lexeme]
identHLexemes s :: String
s | Just (ss :: String
ss, '#') <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
snocView String
s = [String -> Lexeme
Ident String
ss, String -> Lexeme
Symbol "#"]
| Bool
otherwise = [String -> Lexeme
Ident String
s]
readPrefixCon :: String -> ReadPrec ()
readPrefixCon :: String -> ReadPrec ()
readPrefixCon name :: String
name
| String -> Bool
isSymDataCon String
name
= Char -> ReadPrec () -> Char -> ReadPrec ()
forall a. Char -> ReadPrec a -> Char -> ReadPrec a
readSurround '(' (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Symbol String
name)) ')'
| Bool
otherwise
= (Lexeme -> ReadPrec ()) -> [Lexeme] -> ReadPrec ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Lexeme -> ReadPrec ()
expectP (String -> [Lexeme]
identHLexemes String
name)
readSurround :: Char -> ReadPrec a -> Char -> ReadPrec a
readSurround :: Char -> ReadPrec a -> Char -> ReadPrec a
readSurround c1 :: Char
c1 r :: ReadPrec a
r c2 :: Char
c2 = do
Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Punc [Char
c1])
a
r' <- ReadPrec a
r
Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Punc [Char
c2])
a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r'
snocView :: [a] -> Maybe ([a], a)
snocView :: [a] -> Maybe ([a], a)
snocView [] = Maybe ([a], a)
forall a. Maybe a
Nothing
snocView xs :: [a]
xs = [a] -> [a] -> Maybe ([a], a)
forall a. [a] -> [a] -> Maybe ([a], a)
go [] [a]
xs
where
go :: [a] -> [a] -> Maybe ([a], a)
go acc :: [a]
acc [a :: a
a] = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc, a
a)
go acc :: [a]
acc (a :: a
a:as :: [a]
as) = [a] -> [a] -> Maybe ([a], a)
go (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) [a]
as
go _ [] = String -> Maybe ([a], a)
forall a. HasCallStack => String -> a
error "Util: snocView"