1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FunctionalDependencies #-}
3#if MIN_VERSION_base(4,8,0)
4{-# LANGUAGE Safe #-}
5#else
6{-# LANGUAGE Trustworthy #-}
7#endif
8
9module Data.Strict.Classes (
10    Strict (..),
11) where
12
13import Prelude ((.))
14import qualified Prelude as L
15import qualified Data.These as L
16
17import Data.Strict.These
18import Data.Strict.Tuple
19import Data.Strict.Maybe
20import Data.Strict.Either
21
22import qualified Control.Monad.ST.Lazy as L
23import qualified Control.Monad.ST.Strict as S
24import qualified Control.Monad.Trans.RWS.Lazy as L
25import qualified Control.Monad.Trans.RWS.Strict as S
26import qualified Control.Monad.Trans.State.Lazy as L
27import qualified Control.Monad.Trans.State.Strict as S
28import qualified Control.Monad.Trans.Writer.Lazy as L
29import qualified Control.Monad.Trans.Writer.Strict as S
30import qualified Data.ByteString as BS
31import qualified Data.ByteString.Lazy as LBS
32import qualified Data.Text as T
33import qualified Data.Text.Lazy as LT
34
35-- | Ad hoc conversion between "strict" and "lazy" versions of a structure.
36--
37-- Unfortunately all externally defined instances are doomed to
38-- be orphans: https://gitlab.haskell.org/ghc/ghc/-/issues/11999
39-- See also https://qfpl.io/posts/orphans-and-fundeps/index.html for
40--
41class Strict lazy strict | lazy -> strict, strict -> lazy where
42  toStrict :: lazy -> strict
43  toLazy   :: strict -> lazy
44
45instance Strict (L.Maybe a) (Maybe a) where
46  toStrict L.Nothing  = Nothing
47  toStrict (L.Just x) = Just x
48
49  toLazy Nothing  = L.Nothing
50  toLazy (Just x) = L.Just x
51
52instance Strict (a, b) (Pair a b) where
53  toStrict (a, b) = a :!: b
54  toLazy (a :!: b) = (a, b)
55
56instance Strict (L.Either a b) (Either a b) where
57  toStrict (L.Left x)  = Left x
58  toStrict (L.Right y) = Right y
59
60  toLazy (Left x)  = L.Left x
61  toLazy (Right y) = L.Right y
62
63instance Strict (L.These a b) (These a b) where
64  toStrict (L.This x)    = This x
65  toStrict (L.That y)    = That y
66  toStrict (L.These x y) = These x y
67
68  toLazy (This x)    = L.This x
69  toLazy (That y)    = L.That y
70  toLazy (These x y) = L.These x y
71
72instance Strict LBS.ByteString BS.ByteString where
73#if MIN_VERSION_bytestring(0,10,0)
74  toStrict = LBS.toStrict
75  toLazy   = LBS.fromStrict
76#else
77  toStrict = BS.concat . LBS.toChunks
78  toLazy   = LBS.fromChunks . L.return {- singleton -}
79#endif
80
81instance Strict LT.Text T.Text where
82  toStrict = LT.toStrict
83  toLazy   = LT.fromStrict
84
85instance Strict (L.ST s a) (S.ST s a) where
86  toStrict = L.lazyToStrictST
87  toLazy   = L.strictToLazyST
88
89instance Strict (L.RWST r w s m a) (S.RWST r w s m a) where
90  toStrict = S.RWST . L.runRWST
91  toLazy   = L.RWST . S.runRWST
92
93instance Strict (L.StateT s m a) (S.StateT s m a) where
94  toStrict = S.StateT . L.runStateT
95  toLazy   = L.StateT . S.runStateT
96
97instance Strict (L.WriterT w m a) (S.WriterT w m a) where
98  toStrict = S.WriterT . L.runWriterT
99  toLazy   = L.WriterT . S.runWriterT
100