diff options
Diffstat (limited to 'app/Data')
-rw-r--r-- | app/Data/Iban.hs | 10 | ||||
-rw-r--r-- | app/Data/Res.hs | 31 |
2 files changed, 36 insertions, 5 deletions
diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs index 45343ec..412577a 100644 --- a/app/Data/Iban.hs +++ b/app/Data/Iban.hs | |||
@@ -4,6 +4,8 @@ import Control.Applicative ((<|>)) | |||
4 | import Data.Attoparsec.Text as AP | 4 | import Data.Attoparsec.Text as AP |
5 | import Data.Char | 5 | import Data.Char |
6 | ( digitToInt, | 6 | ( digitToInt, |
7 | isAscii, | ||
8 | isDigit, | ||
7 | ord, | 9 | ord, |
8 | toUpper, | 10 | toUpper, |
9 | ) | 11 | ) |
@@ -24,7 +26,7 @@ validateIban = AP.parseOnly $ do | |||
24 | then | 26 | then |
25 | if valid countryCode checkDigits chars | 27 | if valid countryCode checkDigits chars |
26 | then return () | 28 | then return () |
27 | else fail $ "IBAN checksum does not match (" <> countryCode <> checkDigits <> chars <> ")" | 29 | else fail $ "IBAN checksum does not match (" ++ countryCode ++ checkDigits ++ chars ++ ")" |
28 | else fail "IBAN has more than 34 characters" | 30 | else fail "IBAN has more than 34 characters" |
29 | where | 31 | where |
30 | letterToInt c = ord (toUpper c) - ord 'A' + 10 | 32 | letterToInt c = ord (toUpper c) - ord 'A' + 10 |
@@ -32,10 +34,8 @@ validateIban = AP.parseOnly $ do | |||
32 | foldl' | 34 | foldl' |
33 | ( \acc -> \case | 35 | ( \acc -> \case |
34 | d | 36 | d |
35 | | '0' <= d && d <= '9' -> acc * 10 + toInteger (digitToInt d) | 37 | | isDigit d -> acc * 10 + toInteger (digitToInt d) |
36 | | 'A' <= d && d <= 'Z' | 38 | | isAscii d -> acc * 100 + toInteger (letterToInt d) |
37 | || 'a' <= d && d <= 'z' -> | ||
38 | acc * 100 + toInteger (letterToInt d) | ||
39 | | otherwise -> error "unreachable" | 39 | | otherwise -> error "unreachable" |
40 | ) | 40 | ) |
41 | 0 | 41 | 0 |
diff --git a/app/Data/Res.hs b/app/Data/Res.hs new file mode 100644 index 0000000..e8c4ca4 --- /dev/null +++ b/app/Data/Res.hs | |||
@@ -0,0 +1,31 @@ | |||
1 | module Data.Res where | ||
2 | |||
3 | import Control.Applicative | ||
4 | import Data.String (IsString (fromString)) | ||
5 | |||
6 | data Res e r = Ok r | Err e | ||
7 | |||
8 | instance Functor (Res e) where | ||
9 | fmap f (Ok v) = Ok (f v) | ||
10 | fmap _ (Err e) = Err e | ||
11 | |||
12 | instance Applicative (Res e) where | ||
13 | pure = Ok | ||
14 | (Ok f) <*> (Ok v) = Ok (f v) | ||
15 | (Err e) <*> _ = Err e | ||
16 | _ <*> (Err e) = Err e | ||
17 | |||
18 | instance Monad (Res e) where | ||
19 | (Ok v) >>= f = f v | ||
20 | (Err e) >>= _ = Err e | ||
21 | |||
22 | instance IsString e => MonadFail (Res e) where | ||
23 | fail = Err . fromString | ||
24 | |||
25 | instance IsString e => Alternative (Res e) where | ||
26 | empty = fail "mzero" | ||
27 | m1@(Ok _) <|> _ = m1 | ||
28 | (Err _) <|> m2 = m2 | ||
29 | |||
30 | liftEither :: Either e r -> Res e r | ||
31 | liftEither = either Err Ok | ||