{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Safe #-}

module Data.Strict.Classes (
    Strict (..),
) where

import Prelude ((.))
import qualified Prelude as L
import qualified Data.These as L

import Data.Strict.These
import Data.Strict.Tuple
import Data.Strict.Maybe
import Data.Strict.Either

import qualified Control.Monad.ST.Lazy as L
import qualified Control.Monad.ST.Strict as S
import qualified Control.Monad.Trans.RWS.Lazy as L
import qualified Control.Monad.Trans.RWS.Strict as S
import qualified Control.Monad.Trans.State.Lazy as L
import qualified Control.Monad.Trans.State.Strict as S
import qualified Control.Monad.Trans.Writer.Lazy as L
import qualified Control.Monad.Trans.Writer.Strict as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT

-- | Ad hoc conversion between "strict" and "lazy" versions of a structure.
--
-- Unfortunately all externally defined instances are doomed to
-- be orphans: https://gitlab.haskell.org/ghc/ghc/-/issues/11999
-- See also https://qfpl.io/posts/orphans-and-fundeps/index.html for
--
class Strict lazy strict | lazy -> strict, strict -> lazy where
  toStrict :: lazy -> strict
  toLazy   :: strict -> lazy

instance Strict (L.Maybe a) (Maybe a) where
  toStrict :: Maybe a -> Maybe a
toStrict Maybe a
L.Nothing  = Maybe a
forall a. Maybe a
Nothing
  toStrict (L.Just a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
  
  toLazy :: Maybe a -> Maybe a
toLazy Maybe a
Nothing  = Maybe a
forall a. Maybe a
L.Nothing
  toLazy (Just a
x) = a -> Maybe a
forall a. a -> Maybe a
L.Just a
x

instance Strict (a, b) (Pair a b) where
  toStrict :: (a, b) -> Pair a b
toStrict (a
a, b
b) = a
a a -> b -> Pair a b
forall a b. a -> b -> Pair a b
:!: b
b
  toLazy :: Pair a b -> (a, b)
toLazy (a
a :!: b
b) = (a
a, b
b)

instance Strict (L.Either a b) (Either a b) where
  toStrict :: Either a b -> Either a b
toStrict (L.Left a
x)  = a -> Either a b
forall a b. a -> Either a b
Left a
x
  toStrict (L.Right b
y) = b -> Either a b
forall a b. b -> Either a b
Right b
y
  
  toLazy :: Either a b -> Either a b
toLazy (Left a
x)  = a -> Either a b
forall a b. a -> Either a b
L.Left a
x
  toLazy (Right b
y) = b -> Either a b
forall a b. b -> Either a b
L.Right b
y

instance Strict (L.These a b) (These a b) where
  toStrict :: These a b -> These a b
toStrict (L.This a
x)    = a -> These a b
forall a b. a -> These a b
This a
x
  toStrict (L.That b
y)    = b -> These a b
forall a b. b -> These a b
That b
y
  toStrict (L.These a
x b
y) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y
  
  toLazy :: These a b -> These a b
toLazy (This a
x)    = a -> These a b
forall a b. a -> These a b
L.This a
x
  toLazy (That b
y)    = b -> These a b
forall a b. b -> These a b
L.That b
y
  toLazy (These a
x b
y) = a -> b -> These a b
forall a b. a -> b -> These a b
L.These a
x b
y

instance Strict LBS.ByteString BS.ByteString where
  toStrict :: ByteString -> ByteString
toStrict = ByteString -> ByteString
LBS.toStrict
  toLazy :: ByteString -> ByteString
toLazy   = ByteString -> ByteString
LBS.fromStrict

instance Strict LT.Text T.Text where
  toStrict :: Text -> Text
toStrict = Text -> Text
LT.toStrict
  toLazy :: Text -> Text
toLazy   = Text -> Text
LT.fromStrict

instance Strict (L.ST s a) (S.ST s a) where
  toStrict :: ST s a -> ST s a
toStrict = ST s a -> ST s a
forall s a. ST s a -> ST s a
L.lazyToStrictST
  toLazy :: ST s a -> ST s a
toLazy   = ST s a -> ST s a
forall s a. ST s a -> ST s a
L.strictToLazyST

instance Strict (L.RWST r w s m a) (S.RWST r w s m a) where
  toStrict :: RWST r w s m a -> RWST r w s m a
toStrict = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
S.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (RWST r w s m a -> r -> s -> m (a, s, w))
-> RWST r w s m a
-> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST
  toLazy :: RWST r w s m a -> RWST r w s m a
toLazy   = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
L.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (RWST r w s m a -> r -> s -> m (a, s, w))
-> RWST r w s m a
-> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST

instance Strict (L.StateT s m a) (S.StateT s m a) where
  toStrict :: StateT s m a -> StateT s m a
toStrict = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s)) -> StateT s m a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT
  toLazy :: StateT s m a -> StateT s m a
toLazy   = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
L.StateT ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s)) -> StateT s m a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT

instance Strict (L.WriterT w m a) (S.WriterT w m a) where
  toStrict :: WriterT w m a -> WriterT w m a
toStrict = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
S.WriterT (m (a, w) -> WriterT w m a)
-> (WriterT w m a -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
L.runWriterT
  toLazy :: WriterT w m a -> WriterT w m a
toLazy   = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
L.WriterT (m (a, w) -> WriterT w m a)
-> (WriterT w m a -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
S.runWriterT