{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module LiveCoding.Debugger.StatePrint where
import Data.Data
import Data.Maybe (fromJust, fromMaybe)
import Data.Proxy
import Data.Typeable
import Unsafe.Coerce
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict
import Data.Generics.Aliases
import Data.Generics.Text (gshow)
import LiveCoding.Cell
import LiveCoding.Cell.Feedback
import LiveCoding.Debugger
import LiveCoding.Exceptions
import LiveCoding.Forever
statePrint :: Debugger IO
statePrint :: Debugger IO
statePrint = forall (m :: * -> *).
(forall s. Data s => LiveProgram (StateT s m)) -> Debugger m
Debugger forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Cell m () () -> LiveProgram m
liveCell forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ do
s
s <- forall (m :: * -> *) s. Monad m => StateT s m s
get
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall s. Data s => s -> String
stateShow s
s
stateShow :: Data s => s -> String
stateShow :: forall s. Data s => s -> String
stateShow =
forall s. Data s => s -> String
gshow
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall s1 s2. (Data s1, Data s2) => Composition s1 s2 -> String
compositionShow
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall e s. (Data e, Data s) => ForeverE e s -> String
foreverEShow
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall state s. (Data state, Data s) => Feedback state s -> String
feedbackShow
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall s1 s2. (Data s1, Data s2) => Parallel s1 s2 -> String
parallelShow
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall s e. (Data s, Data e) => ExceptState s e -> String
exceptShow
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall stateL stateR.
(Data stateL, Data stateR) =>
Choice stateL stateR -> String
choiceShow
isUnit :: Data s => s -> Bool
isUnit :: forall s. Data s => s -> Bool
isUnit =
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ
Bool
False
(\() -> Bool
True)
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` (\(d1
a, d2
b) -> forall s. Data s => s -> Bool
isUnit d1
a Bool -> Bool -> Bool
&& forall s. Data s => s -> Bool
isUnit d2
b)
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` (\(Composition d1
s1 d2
s2) -> forall s. Data s => s -> Bool
isUnit d1
s1 Bool -> Bool -> Bool
&& forall s. Data s => s -> Bool
isUnit d2
s2)
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` (\(Parallel d1
s1 d2
s2) -> forall s. Data s => s -> Bool
isUnit d1
s1 Bool -> Bool -> Bool
&& forall s. Data s => s -> Bool
isUnit d2
s2)
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` (\(Choice d1
sL d2
sR) -> forall s. Data s => s -> Bool
isUnit d1
sL Bool -> Bool -> Bool
&& forall s. Data s => s -> Bool
isUnit d2
sR)
compositionShow :: (Data s1, Data s2) => Composition s1 s2 -> String
compositionShow :: forall s1 s2. (Data s1, Data s2) => Composition s1 s2 -> String
compositionShow (Composition s1
s1 s2
s2)
| forall s. Data s => s -> Bool
isUnit s1
s1 = forall s. Data s => s -> String
stateShow s2
s2
| forall s. Data s => s -> Bool
isUnit s2
s2 = forall s. Data s => s -> String
stateShow s1
s1
| Bool
otherwise = forall s. Data s => s -> String
stateShow s1
s1 forall a. [a] -> [a] -> [a]
++ String
" >>> " forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow s2
s2
parallelShow :: (Data s1, Data s2) => Parallel s1 s2 -> String
parallelShow :: forall s1 s2. (Data s1, Data s2) => Parallel s1 s2 -> String
parallelShow (Parallel s1
s1 s2
s2)
| forall s. Data s => s -> Bool
isUnit s1
s1 = forall s. Data s => s -> String
stateShow s2
s2
| forall s. Data s => s -> Bool
isUnit s2
s2 = forall s. Data s => s -> String
stateShow s1
s1
| Bool
otherwise = String
"(" forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow s1
s1 forall a. [a] -> [a] -> [a]
++ String
" *** " forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow s2
s2 forall a. [a] -> [a] -> [a]
++ String
")"
foreverEShow :: (Data e, Data s) => ForeverE e s -> String
foreverEShow :: forall e s. (Data e, Data s) => ForeverE e s -> String
foreverEShow ForeverE {e
s
currentState :: forall e s. ForeverE e s -> s
initState :: forall e s. ForeverE e s -> s
lastException :: forall e s. ForeverE e s -> e
currentState :: s
initState :: s
lastException :: e
..} =
String
"forever("
forall a. [a] -> [a] -> [a]
++ (if forall s. Data s => s -> Bool
isUnit e
lastException then String
"" else forall s. Data s => s -> String
gshow e
lastException forall a. [a] -> [a] -> [a]
++ String
", ")
forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow s
initState
forall a. [a] -> [a] -> [a]
++ String
"): "
forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow s
currentState
feedbackShow :: (Data state, Data s) => Feedback state s -> String
feedbackShow :: forall state s. (Data state, Data s) => Feedback state s -> String
feedbackShow Feedback {state
s
sAdditional :: forall sPrevious sAdditional.
Feedback sPrevious sAdditional -> sAdditional
sPrevious :: forall sPrevious sAdditional.
Feedback sPrevious sAdditional -> sPrevious
sAdditional :: s
sPrevious :: state
..} = String
"feedback " forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
gshow s
sAdditional forall a. [a] -> [a] -> [a]
++ String
" $ " forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow state
sPrevious
exceptShow :: (Data s, Data e) => ExceptState s e -> String
exceptShow :: forall s e. (Data s, Data e) => ExceptState s e -> String
exceptShow (NotThrown s
s) = String
"NotThrown: " forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow s
s forall a. [a] -> [a] -> [a]
++ String
"\n"
exceptShow (Exception e
e) =
String
"Exception"
forall a. [a] -> [a] -> [a]
++ (if forall s. Data s => s -> Bool
isUnit e
e then String
"" else String
" " forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
gshow e
e)
forall a. [a] -> [a] -> [a]
++ String
":\n"
choiceShow :: (Data stateL, Data stateR) => Choice stateL stateR -> String
choiceShow :: forall stateL stateR.
(Data stateL, Data stateR) =>
Choice stateL stateR -> String
choiceShow Choice {stateL
stateR
choiceRight :: forall stateL stateR. Choice stateL stateR -> stateR
choiceLeft :: forall stateL stateR. Choice stateL stateR -> stateL
choiceRight :: stateR
choiceLeft :: stateL
..}
| forall s. Data s => s -> Bool
isUnit stateL
choiceLeft = String
"+" forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow stateR
choiceRight forall a. [a] -> [a] -> [a]
++ String
"+"
| forall s. Data s => s -> Bool
isUnit stateR
choiceRight = String
"+" forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow stateL
choiceLeft forall a. [a] -> [a] -> [a]
++ String
"+"
| Bool
otherwise = String
"+" forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow stateL
choiceLeft forall a. [a] -> [a] -> [a]
++ String
" +++ " forall a. [a] -> [a] -> [a]
++ forall s. Data s => s -> String
stateShow stateR
choiceRight forall a. [a] -> [a] -> [a]
++ String
"+"
gcast3 ::
forall f t t' a b c.
(Typeable t, Typeable t') =>
f (t a b c) ->
Maybe (f (t' a b c))
gcast3 :: forall (f :: * -> *) (t :: * -> * -> * -> *)
(t' :: * -> * -> * -> *) a b c.
(Typeable t, Typeable t') =>
f (t a b c) -> Maybe (f (t' a b c))
gcast3 f (t a b c)
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t :~: t'
Refl -> f (t a b c)
x) (forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (t :~: t'))
ext3 ::
(Data a, Data b, Data c, Data d, Typeable t, Typeable f) =>
f a ->
f (t b c d) ->
f a
ext3 :: forall a b c d (t :: * -> * -> * -> *) (f :: * -> *).
(Data a, Data b, Data c, Data d, Typeable t, Typeable f) =>
f a -> f (t b c d) -> f a
ext3 f a
def f (t b c d)
ext = forall b a. b -> (a -> b) -> Maybe a -> b
maybe f a
def forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f (t b c d)
ext
ext3Q ::
(Data a, Data b, Data c, Data d, Typeable t, Typeable q) =>
(a -> q) ->
(t b c d -> q) ->
a ->
q
ext3Q :: forall a b c d (t :: * -> * -> * -> *) q.
(Data a, Data b, Data c, Data d, Typeable t, Typeable q) =>
(a -> q) -> (t b c d -> q) -> a -> q
ext3Q a -> q
def t b c d -> q
ext = forall q x. Q q x -> x -> q
unQ ((forall q x. (x -> q) -> Q q x
Q a -> q
def) forall a b c d (t :: * -> * -> * -> *) (f :: * -> *).
(Data a, Data b, Data c, Data d, Typeable t, Typeable f) =>
f a -> f (t b c d) -> f a
`ext3` (forall q x. (x -> q) -> Q q x
Q t b c d -> q
ext))
newtype Q q x = Q {forall q x. Q q x -> x -> q
unQ :: x -> q}