{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

module Text.Grampa.Internal.Storable (Storable(..), Storable1(..), Storable11(..),
                                      Dependencies(..), ParserFlags(..)) where

import Data.Functor.Const (Const(Const, getConst))
import qualified Rank2
import Text.Grampa.Class (ParseFailure(ParseFailure))
import Text.Grampa.Internal (ResultList(ResultList), ResultsOfLength(ResultsOfLength),
                             ParserFlags (ParserFlags, nullable, dependsOn),
                             Dependencies (DynamicDependencies, StaticDependencies))
import qualified Text.Grampa.ContextFree.SortedMemoizing.Transformer as Transformer

class Storable s a where
   store :: a -> s
   reuse :: s -> a

class Storable1 s a where
   store1 :: a -> s b
   reuse1 :: s b -> a

class Storable11 s t where
   store11 :: t a -> s b
   reuse11 :: s b -> t a

instance Storable a a where
   store :: a -> a
store = forall a. a -> a
id
   reuse :: a -> a
reuse = forall a. a -> a
id

instance Storable1 (Const a) a where
   store1 :: forall b. a -> Const a b
store1 = forall {k} a (b :: k). a -> Const a b
Const
   reuse1 :: forall b. Const a b -> a
reuse1 = forall {k} a (b :: k). Const a b -> a
getConst

instance Storable1 s a => Storable11 s (Const a) where
   store11 :: forall a b. Const a a -> s b
store11 = forall (s :: * -> *) a b. Storable1 s a => a -> s b
store1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst
   reuse11 :: forall b a. s b -> Const a a
reuse11 = forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) a b. Storable1 s a => s b -> a
reuse1

instance (Storable1 f a, Rank2.Functor g) => Storable (g f) (g (Const a)) where
   store :: g (Const a) -> g f
store = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall (s :: * -> *) a b. Storable1 s a => a -> s b
store1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst)
   reuse :: g f -> g (Const a)
reuse = forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) a b. Storable1 s a => s b -> a
reuse1)

instance Ord s => Storable1 (ResultList g s) Bool where
   store1 :: forall b. Bool -> ResultList g s b
store1 Bool
bit = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList [] (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (if Bool
bit then Pos
1 else Pos
0) forall a. Monoid a => a
mempty [])
   reuse1 :: forall b. ResultList g s b -> Bool
reuse1 (ResultList [ResultsOfLength g s b]
_ (ParseFailure Pos
pos FailureDescription s
_ [String]
_)) = Pos
pos forall a. Eq a => a -> a -> Bool
/= Pos
0

instance (Rank2.Functor g, Monoid s, Ord s) => Storable1 (ResultList g s) (ParserFlags g) where
   store1 :: forall b. ParserFlags g -> ResultList g s b
store1 ParserFlags g
a = forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList [forall s a. Storable s a => a -> s
store ParserFlags g
a] forall a. Monoid a => a
mempty
   reuse1 :: forall b. ResultList g s b -> ParserFlags g
reuse1 (ResultList [ResultsOfLength g s b
s] ParseFailure Pos s
_) = forall s a. Storable s a => s -> a
reuse ResultsOfLength g s b
s

instance (Rank2.Functor g, Monoid s, Ord s) => Storable (ResultsOfLength g s r) (ParserFlags g) where
   store :: ParserFlags g -> ResultsOfLength g s r
store (ParserFlags Bool
n Dependencies g
d) = forall (g :: (* -> *) -> *) s r.
Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
ResultsOfLength (if Bool
n then Int
1 else Int
0) (forall s a. Storable s a => a -> s
store Dependencies g
d) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"unused")
   reuse :: ResultsOfLength g s r -> ParserFlags g
reuse (ResultsOfLength Int
n [(s, g (ResultList g s))]
d NonEmpty r
_) = forall (g :: (* -> *) -> *).
Bool -> Dependencies g -> ParserFlags g
ParserFlags (Int
n forall a. Eq a => a -> a -> Bool
/= Int
0) (forall s a. Storable s a => s -> a
reuse [(s, g (ResultList g s))]
d)

instance (Rank2.Functor g, Monoid s, Ord s) => Storable [(s, g (ResultList g s))] (Dependencies g) where
   store :: Dependencies g -> [(s, g (ResultList g s))]
store Dependencies g
DynamicDependencies = []
   store (StaticDependencies g (Const Bool)
deps) = [(forall a. Monoid a => a
mempty, forall s a. Storable s a => a -> s
store g (Const Bool)
deps)]
   reuse :: [(s, g (ResultList g s))] -> Dependencies g
reuse [] = forall (g :: (* -> *) -> *). Dependencies g
DynamicDependencies
   reuse [(s
_, g (ResultList g s)
deps)] = forall (g :: (* -> *) -> *). g (Const Bool) -> Dependencies g
StaticDependencies (forall s a. Storable s a => s -> a
reuse g (ResultList g s)
deps)

instance Ord s => Storable1 (Transformer.ResultListT m g s) Bool where
   store1 :: forall b. Bool -> ResultListT m g s b
store1 Bool
bit = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
Transformer.ResultList [] (forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (if Bool
bit then Pos
1 else Pos
0) forall a. Monoid a => a
mempty [])
   reuse1 :: forall b. ResultListT m g s b -> Bool
reuse1 (Transformer.ResultList [ResultsOfLengthT m g s b]
_ (ParseFailure Pos
pos FailureDescription s
_ [String]
_)) = Pos
pos forall a. Eq a => a -> a -> Bool
/= Pos
0

instance (Rank2.Functor g, Monoid s, Ord s) => Storable1 (Transformer.ResultListT m g s) (ParserFlags g) where
   store1 :: forall b. ParserFlags g -> ResultListT m g s b
store1 ParserFlags g
a = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
Transformer.ResultList [forall s a. Storable s a => a -> s
store ParserFlags g
a] forall a. Monoid a => a
mempty
   reuse1 :: forall b. ResultListT m g s b -> ParserFlags g
reuse1 (Transformer.ResultList [ResultsOfLengthT m g s b
s] ParseFailure Pos s
_) = forall s a. Storable s a => s -> a
reuse ResultsOfLengthT m g s b
s

instance (Rank2.Functor g, Monoid s, Ord s) => Storable (Transformer.ResultsOfLengthT m g s r) (ParserFlags g) where
   store :: ParserFlags g -> ResultsOfLengthT m g s r
store = forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
Transformer.ResultsOfLengthT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Storable s a => a -> s
store
   reuse :: ResultsOfLengthT m g s r -> ParserFlags g
reuse = forall s a. Storable s a => s -> a
reuse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLengthT m g s r -> ResultsOfLength m g s (m r)
Transformer.getResultsOfLength

instance (Rank2.Functor g, Monoid s, Ord s) => Storable (Transformer.ResultsOfLength m g s r) (ParserFlags g) where
   store :: ParserFlags g -> ResultsOfLength m g s r
store (ParserFlags Bool
n Dependencies g
d) = forall (m :: * -> *) (g :: (* -> *) -> *) s a.
Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty a
-> ResultsOfLength m g s a
Transformer.ROL (if Bool
n then Int
1 else Int
0) (forall s a. Storable s a => a -> s
store Dependencies g
d) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"unused")
   reuse :: ResultsOfLength m g s r -> ParserFlags g
reuse (Transformer.ROL Int
n [(s, g (ResultListT m g s))]
d NonEmpty r
_) = forall (g :: (* -> *) -> *).
Bool -> Dependencies g -> ParserFlags g
ParserFlags (Int
n forall a. Eq a => a -> a -> Bool
/= Int
0) (forall s a. Storable s a => s -> a
reuse [(s, g (ResultListT m g s))]
d)

instance (Rank2.Functor g, Monoid s, Ord s) => Storable [(s, g (Transformer.ResultListT m g s))] (Dependencies g) where
   store :: Dependencies g -> [(s, g (ResultListT m g s))]
store Dependencies g
DynamicDependencies = []
   store (StaticDependencies g (Const Bool)
deps) = [(forall a. Monoid a => a
mempty, forall s a. Storable s a => a -> s
store g (Const Bool)
deps)]
   reuse :: [(s, g (ResultListT m g s))] -> Dependencies g
reuse [] = forall (g :: (* -> *) -> *). Dependencies g
DynamicDependencies
   reuse [(s
_, g (ResultListT m g s)
deps)] = forall (g :: (* -> *) -> *). g (Const Bool) -> Dependencies g
StaticDependencies (forall s a. Storable s a => s -> a
reuse g (ResultListT m g s)
deps)