/
Lens.hs
86 lines (76 loc) · 2.93 KB
/
Lens.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
{-# LANGUAGE Rank2Types #-}
--------------------------------------------------------------------------------
-- |
-- Module : Numeric.Lens
-- Copyright : (C) 2012-13 Edward Kmett
-- License : BSD-style (see the file LICENSE)
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : provisional
-- Portability : portable
-------------------------------------------------------------------------------
module Numeric.Lens (base, integral) where
import Control.Lens
import Data.Char (chr, ord, isAsciiLower, isAsciiUpper, isDigit)
import Data.Maybe (fromMaybe)
import Numeric (readInt, showIntAtBase)
-- | This 'Prism' extracts can be used to model the fact that every 'Integral'
-- type is a subset of 'Integer'.
--
-- Embedding through the 'Prism' only succeeds if the 'Integer' would pass
-- through unmodified when re-extracted.
integral :: (Integral a, Integral b) => Prism Integer Integer a b
integral = prism toInteger $ \ i -> let a = fromInteger i in
if toInteger a == i
then Right a
else Left i
-- | A prism that shows and reads integers in base-2 through base-36
--
-- >>> "100" ^? base 16
-- Just 256
--
-- >>> 1767707668033969 ^. re (base 36)
-- "helloworld"
base :: (Integral a, Show a) => a -> Prism' String a
base b
| b < 2 || b > 36 = error ("base: Invalid base " ++ show b)
| otherwise = prism intShow intRead
where
intShow n = showSigned' (showIntAtBase b intToDigit') n ""
intRead s =
case readSigned' (readInt b (isDigit' b) digitToInt') s of
[(n,"")] -> Right n
_ -> Left s
{-# INLINE base #-}
-- | Like 'Data.Char.intToDigit', but handles up to base-36
intToDigit' :: Int -> Char
intToDigit' i
| i >= 0 && i < 10 = chr (ord '0' + i)
| i >= 10 && i < 36 = chr (ord 'a' + i - 10)
| otherwise = error ("intToDigit': Invalid int " ++ show i)
-- | Like 'Data.Char.digitToInt', but handles up to base-36
digitToInt' :: Char -> Int
digitToInt' c = fromMaybe (error ("digitToInt': Invalid digit " ++ show c))
(digitToIntMay c)
-- | A safe variant of 'digitToInt''
digitToIntMay :: Char -> Maybe Int
digitToIntMay c
| isDigit c = Just (ord c - ord '0')
| isAsciiLower c = Just (ord c - ord 'a' + 10)
| isAsciiUpper c = Just (ord c - ord 'A' + 10)
| otherwise = Nothing
-- | Select digits that fall into the given base
isDigit' :: Integral a => a -> Char -> Bool
isDigit' b c = case digitToIntMay c of
Just i | fromIntegral i < b -> True
_ -> False
-- | A simpler variant of 'Numeric.showSigned' that only prepends a dash and
-- doesn't know about parentheses
showSigned' :: Real a => (a -> ShowS) -> a -> ShowS
showSigned' f n
| n < 0 = showChar '-' . f (negate n)
| otherwise = f n
-- | A simpler variant of 'Numeric.readSigned' that supports any base, only
-- recognizes an initial dash and doesn't know about parentheses
readSigned' :: Real a => ReadS a -> ReadS a
readSigned' f ('-':xs) = f xs & mapped . _1 %~ negate
readSigned' f xs = f xs