1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE FlexibleInstances     #-}
3{-# LANGUAGE ScopedTypeVariables   #-}
4{-# LANGUAGE ConstraintKinds       #-}
5{-# LANGUAGE CPP                   #-}
6{-# LANGUAGE MagicHash             #-}
7{-# LANGUAGE UndecidableInstances  #-}
8{-# LANGUAGE TypeOperators         #-}
9-- |
10-- Module      : Basement.From
11-- License     : BSD-style
12-- Maintainer  : Haskell Foundation
13--
14-- Flexible Type convertion
15--
16-- From is multi parameter type class that allow converting
17-- from a to b.
18--
19-- Only type that are valid to convert to another type
20-- should be From instance; otherwise TryFrom should be used.
21--
22-- Into (resp TryInto) allows the contrary instances to be able
23-- to specify the destination type before the source. This is
24-- practical with TypeApplication
25module Basement.From
26    ( From(..)
27    , Into
28    , TryFrom(..)
29    , TryInto
30    , into
31    , tryInto
32    ) where
33
34import           Basement.Compat.Base
35
36-- basic instances
37import           GHC.Types
38import           GHC.Prim
39import           GHC.Int
40import           GHC.Word
41import           Basement.Numerical.Number
42import           Basement.Numerical.Conversion
43import qualified Basement.Block as Block
44import qualified Basement.BoxedArray as BoxArray
45import           Basement.Cast (cast)
46import qualified Basement.UArray as UArray
47import qualified Basement.String as String
48import qualified Basement.Types.AsciiString as AsciiString
49import           Basement.Types.Word128 (Word128(..))
50import           Basement.Types.Word256 (Word256(..))
51import qualified Basement.Types.Word128 as Word128
52import qualified Basement.Types.Word256 as Word256
53import           Basement.These
54import           Basement.PrimType (PrimType, PrimSize)
55import           Basement.Types.OffsetSize
56import           Basement.Compat.Natural
57import qualified Prelude (fromIntegral)
58
59-- nat instances
60#if __GLASGOW_HASKELL__ >= 800
61import           Basement.Nat
62import qualified Basement.Sized.Block as BlockN
63import           Basement.Bounded
64#endif
65
66-- | Class of things that can be converted from a to b.
67--
68-- In a valid instance, the source should be always representable by the destination,
69-- otherwise the instance should be using 'TryFrom'
70class From a b where
71    from :: a -> b
72
73type Into b a = From a b
74
75-- | Same as from but reverse the type variable so that the destination type can be specified first
76--
77-- e.g. converting:
78--
79-- from @_ @Word (10 :: Int)
80--
81-- into @Word (10 :: Int)
82--
83into :: Into b a => a -> b
84into = from
85
86-- | Class of things that can mostly be converted from a to b, but with possible error cases.
87class TryFrom a b where
88    tryFrom :: a -> Maybe b
89
90type TryInto b a = TryFrom a b
91
92-- | same as tryFrom but reversed
93tryInto :: TryInto b a => a -> Maybe b
94tryInto = tryFrom
95
96instance From a a where
97    from = id
98
99instance IsNatural n => From n Natural where
100    from = toNatural
101instance IsIntegral n => From n Integer where
102    from = toInteger
103
104instance From Int8 Int16 where
105    from (I8# i) = I16# i
106instance From Int8 Int32 where
107    from (I8# i) = I32# i
108instance From Int8 Int64 where
109    from (I8# i) = intToInt64 (I# i)
110instance From Int8 Int where
111    from (I8# i) = I# i
112
113instance From Int16 Int32 where
114    from (I16# i) = I32# i
115instance From Int16 Int64 where
116    from (I16# i) = intToInt64 (I# i)
117instance From Int16 Int where
118    from (I16# i) = I# i
119
120instance From Int32 Int64 where
121    from (I32# i) = intToInt64 (I# i)
122instance From Int32 Int where
123    from (I32# i) = I# i
124
125instance From Int Int64 where
126    from = intToInt64
127
128instance From Word8 Word16 where
129    from (W8# i) = W16# i
130instance From Word8 Word32 where
131    from (W8# i) = W32# i
132instance From Word8 Word64 where
133    from (W8# i) = wordToWord64 (W# i)
134instance From Word8 Word128 where
135    from (W8# i) = Word128 0 (wordToWord64 $ W# i)
136instance From Word8 Word256 where
137    from (W8# i) = Word256 0 0 0 (wordToWord64 $ W# i)
138instance From Word8 Word where
139    from (W8# i) = W# i
140instance From Word8 Int16 where
141    from (W8# w) = I16# (word2Int# w)
142instance From Word8 Int32 where
143    from (W8# w) = I32# (word2Int# w)
144instance From Word8 Int64 where
145    from (W8# w) = intToInt64 (I# (word2Int# w))
146instance From Word8 Int where
147    from (W8# w) = I# (word2Int# w)
148
149instance From Word16 Word32 where
150    from (W16# i) = W32# i
151instance From Word16 Word64 where
152    from (W16# i) = wordToWord64 (W# i)
153instance From Word16 Word128 where
154    from (W16# i) = Word128 0 (wordToWord64 $ W# i)
155instance From Word16 Word256 where
156    from (W16# i) = Word256 0 0 0 (wordToWord64 $ W# i)
157instance From Word16 Word where
158    from (W16# i) = W# i
159instance From Word16 Int32 where
160    from (W16# w) = I32# (word2Int# w)
161instance From Word16 Int64 where
162    from (W16# w) = intToInt64 (I# (word2Int# w))
163instance From Word16 Int where
164    from (W16# w) = I# (word2Int# w)
165
166instance From Word32 Word64 where
167    from (W32# i) = wordToWord64 (W# i)
168instance From Word32 Word128 where
169    from (W32# i) = Word128 0 (wordToWord64 $ W# i)
170instance From Word32 Word256 where
171    from (W32# i) = Word256 0 0 0 (wordToWord64 $ W# i)
172instance From Word32 Word where
173    from (W32# i) = W# i
174instance From Word32 Int64 where
175    from (W32# w) = intToInt64 (I# (word2Int# w))
176instance From Word32 Int where
177    from (W32# w) = I# (word2Int# w)
178
179instance From Word64 Word128 where
180    from w = Word128 0 w
181instance From Word64 Word256 where
182    from w = Word256 0 0 0 w
183
184instance From Word Word64 where
185    from = wordToWord64
186
187-- Simple prelude types
188instance From (Maybe a) (Either () a) where
189    from (Just x) = Right x
190    from Nothing  = Left ()
191
192-- basic basement types
193instance From (CountOf ty) Int where
194    from (CountOf n) = n
195instance From (CountOf ty) Word where
196    -- here it is ok to cast the underlying `Int` held by `CountOf` to a `Word`
197    -- as the `Int` should never hold a negative value.
198    from (CountOf n) = cast n
199instance From Word (Offset ty) where
200    from w = Offset (cast w)
201instance TryFrom Int (Offset ty) where
202    tryFrom i
203        | i < 0     = Nothing
204        | otherwise = Just (Offset i)
205instance TryFrom Int (CountOf ty) where
206    tryFrom i
207        | i < 0     = Nothing
208        | otherwise = Just (CountOf i)
209instance From Word (CountOf ty) where
210    from w = CountOf (cast w)
211
212instance From (Either a b) (These a b) where
213    from (Left a) = This a
214    from (Right b) = That b
215
216instance From Word128 Word256 where
217    from (Word128 a b) = Word256 0 0 a b
218
219-- basement instances
220
221-- uarrays
222instance PrimType ty => From (Block.Block ty) (UArray.UArray ty) where
223    from = UArray.fromBlock
224instance PrimType ty => From (BoxArray.Array ty) (UArray.UArray ty) where
225    from = BoxArray.mapToUnboxed id
226
227-- blocks
228instance PrimType ty => From (UArray.UArray ty) (Block.Block ty) where
229    from = UArray.toBlock
230instance PrimType ty => From (BoxArray.Array ty) (Block.Block ty) where
231    from = UArray.toBlock . BoxArray.mapToUnboxed id
232
233-- boxed array
234instance PrimType ty => From (UArray.UArray ty) (BoxArray.Array ty) where
235    from = BoxArray.mapFromUnboxed id
236
237
238instance From String.String (UArray.UArray Word8) where
239    from = String.toBytes String.UTF8
240
241instance From AsciiString.AsciiString String.String where
242    from = String.fromBytesUnsafe . UArray.unsafeRecast . AsciiString.toBytes
243instance From AsciiString.AsciiString (UArray.UArray Word8) where
244    from = UArray.unsafeRecast . AsciiString.toBytes
245
246instance TryFrom (UArray.UArray Word8) String.String where
247    tryFrom arr = case String.fromBytes String.UTF8 arr of
248                    (s, Nothing, _) -> Just s
249                    (_, Just _, _)  -> Nothing
250
251#if __GLASGOW_HASKELL__ >= 800
252instance From (BlockN.BlockN n ty) (Block.Block ty) where
253    from = BlockN.toBlock
254instance (PrimType a, PrimType b, KnownNat n, KnownNat m, ((PrimSize b) Basement.Nat.* m) ~ ((PrimSize a) Basement.Nat.* n))
255      => From (BlockN.BlockN n a) (BlockN.BlockN m b) where
256    from = BlockN.cast
257instance (NatWithinBound Int n, PrimType ty) => From (BlockN.BlockN n ty) (UArray.UArray ty) where
258    from = UArray.fromBlock . BlockN.toBlock
259instance (NatWithinBound Int n, PrimType ty) => From (BlockN.BlockN n ty) (BoxArray.Array ty) where
260    from = BoxArray.mapFromUnboxed id . UArray.fromBlock . BlockN.toBlock
261
262instance (NatWithinBound (CountOf ty) n, KnownNat n, PrimType ty)
263      => TryFrom (Block.Block ty) (BlockN.BlockN n ty) where
264    tryFrom = BlockN.toBlockN
265instance (NatWithinBound (CountOf ty) n, KnownNat n, PrimType ty)
266      => TryFrom (UArray.UArray ty) (BlockN.BlockN n ty) where
267    tryFrom = BlockN.toBlockN . UArray.toBlock
268instance (NatWithinBound (CountOf ty) n, KnownNat n, PrimType ty)
269      => TryFrom (BoxArray.Array ty) (BlockN.BlockN n ty) where
270    tryFrom = BlockN.toBlockN . UArray.toBlock . BoxArray.mapToUnboxed id
271
272instance (KnownNat n, NatWithinBound Word8 n) => From (Zn64 n) Word8 where
273    from = narrow . unZn64 where narrow (W64# w) = W8# (narrow8Word# (word64ToWord# w))
274instance (KnownNat n, NatWithinBound Word16 n) => From (Zn64 n) Word16 where
275    from = narrow . unZn64 where narrow (W64# w) = W16# (narrow16Word# (word64ToWord# w))
276instance (KnownNat n, NatWithinBound Word32 n) => From (Zn64 n) Word32 where
277    from = narrow . unZn64 where narrow (W64# w) = W32# (narrow32Word# (word64ToWord# w))
278instance From (Zn64 n) Word64 where
279    from = unZn64
280instance From (Zn64 n) Word128 where
281    from = from . unZn64
282instance From (Zn64 n) Word256 where
283    from = from . unZn64
284
285instance (KnownNat n, NatWithinBound Word8 n) => From (Zn n) Word8 where
286    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (narrow8Word# (word64ToWord# w))
287instance (KnownNat n, NatWithinBound Word16 n) => From (Zn n) Word16 where
288    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (narrow16Word# (word64ToWord# w))
289instance (KnownNat n, NatWithinBound Word32 n) => From (Zn n) Word32 where
290    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (narrow32Word# (word64ToWord# w))
291instance (KnownNat n, NatWithinBound Word64 n) => From (Zn n) Word64 where
292    from = naturalToWord64 . unZn
293instance (KnownNat n, NatWithinBound Word128 n) => From (Zn n) Word128 where
294    from = Word128.fromNatural . unZn
295instance (KnownNat n, NatWithinBound Word256 n) => From (Zn n) Word256 where
296    from = Word256.fromNatural . unZn
297
298instance (KnownNat n, NatWithinBound Word64 n) => From (Zn n) (Zn64 n) where
299    from = zn64 . naturalToWord64 . unZn
300instance KnownNat n => From (Zn64 n) (Zn n) where
301    from = zn . from . unZn64
302
303naturalToWord64 :: Natural -> Word64
304naturalToWord64 = Prelude.fromIntegral
305#endif
306