{-# 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 = a -> a
forall a. a -> a
id
   reuse :: a -> a
reuse = a -> a
forall a. a -> a
id

instance Storable1 (Const a) a where
   store1 :: forall b. a -> Const a b
store1 = a -> Const a b
forall {k} a (b :: k). a -> Const a b
Const
   reuse1 :: forall b. Const a b -> a
reuse1 = Const a b -> a
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 = a -> s b
forall b. a -> s b
forall (s :: * -> *) a b. Storable1 s a => a -> s b
store1 (a -> s b) -> (Const a a -> a) -> Const a a -> s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const a a -> a
forall {k} a (b :: k). Const a b -> a
getConst
   reuse11 :: forall b a. s b -> Const a a
reuse11 = a -> Const a a
forall {k} a (b :: k). a -> Const a b
Const (a -> Const a a) -> (s b -> a) -> s b -> Const a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s b -> a
forall b. s b -> a
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 a. Const a a -> f a) -> g (Const a) -> g f
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (a -> f a
forall b. a -> f b
forall (s :: * -> *) a b. Storable1 s a => a -> s b
store1 (a -> f a) -> (Const a a -> a) -> Const a a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const a a -> a
forall {k} a (b :: k). Const a b -> a
getConst)
   reuse :: g f -> g (Const a)
reuse = (forall a. f a -> Const a a) -> g f -> g (Const a)
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.fmap (a -> Const a a
forall {k} a (b :: k). a -> Const a b
Const (a -> Const a a) -> (f a -> a) -> f a -> Const a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a
forall b. f b -> a
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 = [ResultsOfLength g s b] -> ParseFailure Pos s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList [] (Pos -> FailureDescription s -> [String] -> ParseFailure Pos s
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (if Bool
bit then Pos
1 else Pos
0) FailureDescription s
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 Pos -> Pos -> Bool
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 = [ResultsOfLength g s b] -> ParseFailure Pos s -> ResultList g s b
forall (g :: (* -> *) -> *) s r.
[ResultsOfLength g s r] -> ParseFailure Pos s -> ResultList g s r
ResultList [ParserFlags g -> ResultsOfLength g s b
forall s a. Storable s a => a -> s
store ParserFlags g
a] ParseFailure Pos s
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
_) = ResultsOfLength g s b -> ParserFlags g
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) = Int
-> [(s, g (ResultList g s))] -> NonEmpty r -> ResultsOfLength g s r
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) (Dependencies g -> [(s, g (ResultList g s))]
forall s a. Storable s a => a -> s
store Dependencies g
d) (r -> NonEmpty r
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> NonEmpty r) -> r -> NonEmpty r
forall a b. (a -> b) -> a -> b
$ String -> r
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
_) = Bool -> Dependencies g -> ParserFlags g
forall (g :: (* -> *) -> *).
Bool -> Dependencies g -> ParserFlags g
ParserFlags (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(s, g (ResultList g s))] -> Dependencies g
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) = [(s
forall a. Monoid a => a
mempty, g (Const Bool) -> g (ResultList g s)
forall s a. Storable s a => a -> s
store g (Const Bool)
deps)]
   reuse :: [(s, g (ResultList g s))] -> Dependencies g
reuse [] = Dependencies g
forall (g :: (* -> *) -> *). Dependencies g
DynamicDependencies
   reuse [(s
_, g (ResultList g s)
deps)] = g (Const Bool) -> Dependencies g
forall (g :: (* -> *) -> *). g (Const Bool) -> Dependencies g
StaticDependencies (g (ResultList g s) -> g (Const Bool)
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 = [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
Transformer.ResultList [] (Pos -> FailureDescription s -> [String] -> ParseFailure Pos s
forall pos s.
pos -> FailureDescription s -> [String] -> ParseFailure pos s
ParseFailure (if Bool
bit then Pos
1 else Pos
0) FailureDescription s
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 Pos -> Pos -> Bool
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 = [ResultsOfLengthT m g s b]
-> ParseFailure Pos s -> ResultListT m g s b
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
[ResultsOfLengthT m g s r]
-> ParseFailure Pos s -> ResultListT m g s r
Transformer.ResultList [ParserFlags g -> ResultsOfLengthT m g s b
forall s a. Storable s a => a -> s
store ParserFlags g
a] ParseFailure Pos s
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
_) = ResultsOfLengthT m g s b -> ParserFlags g
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 = ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
forall (m :: * -> *) (g :: (* -> *) -> *) s r.
ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r
Transformer.ResultsOfLengthT (ResultsOfLength m g s (m r) -> ResultsOfLengthT m g s r)
-> (ParserFlags g -> ResultsOfLength m g s (m r))
-> ParserFlags g
-> ResultsOfLengthT m g s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserFlags g -> ResultsOfLength m g s (m r)
forall s a. Storable s a => a -> s
store
   reuse :: ResultsOfLengthT m g s r -> ParserFlags g
reuse = ResultsOfLength m g s (m r) -> ParserFlags g
forall s a. Storable s a => s -> a
reuse (ResultsOfLength m g s (m r) -> ParserFlags g)
-> (ResultsOfLengthT m g s r -> ResultsOfLength m g s (m r))
-> ResultsOfLengthT m g s r
-> ParserFlags g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultsOfLengthT m g s r -> ResultsOfLength m g s (m r)
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) = Int
-> [(s, g (ResultListT m g s))]
-> NonEmpty r
-> ResultsOfLength m g s r
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) (Dependencies g -> [(s, g (ResultListT m g s))]
forall s a. Storable s a => a -> s
store Dependencies g
d) (r -> NonEmpty r
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> NonEmpty r) -> r -> NonEmpty r
forall a b. (a -> b) -> a -> b
$ String -> r
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
_) = Bool -> Dependencies g -> ParserFlags g
forall (g :: (* -> *) -> *).
Bool -> Dependencies g -> ParserFlags g
ParserFlags (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(s, g (ResultListT m g s))] -> Dependencies g
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) = [(s
forall a. Monoid a => a
mempty, g (Const Bool) -> g (ResultListT m g s)
forall s a. Storable s a => a -> s
store g (Const Bool)
deps)]
   reuse :: [(s, g (ResultListT m g s))] -> Dependencies g
reuse [] = Dependencies g
forall (g :: (* -> *) -> *). Dependencies g
DynamicDependencies
   reuse [(s
_, g (ResultListT m g s)
deps)] = g (Const Bool) -> Dependencies g
forall (g :: (* -> *) -> *). g (Const Bool) -> Dependencies g
StaticDependencies (g (ResultListT m g s) -> g (Const Bool)
forall s a. Storable s a => s -> a
reuse g (ResultListT m g s)
deps)