{-# LANGUAGE DerivingStrategies, DeriveAnyClass #-}
{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}

module DSV.NumberViews
  ( InvalidNat (..), byteStringNatView, textNatView
                   , byteStringNatView_, textNatView_
  , InvalidRational (..), byteStringRationalView, textRationalView
                        , byteStringRationalView_, textRationalView_
  , InvalidDollars (..), byteStringDollarsView, textDollarsView
                       , byteStringDollarsView_, textDollarsView_
  ) where

import DSV.AttoView
import DSV.ByteString
import DSV.IO
import DSV.Numbers
import DSV.Prelude
import DSV.Text
import DSV.TextReaderView
import DSV.UTF8
import DSV.Validation
import DSV.ViewType

-- attoparsec
import qualified Data.Attoparsec.ByteString.Char8

data InvalidNat = InvalidNat
  deriving stock (InvalidNat -> InvalidNat -> Bool
(InvalidNat -> InvalidNat -> Bool)
-> (InvalidNat -> InvalidNat -> Bool) -> Eq InvalidNat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidNat -> InvalidNat -> Bool
$c/= :: InvalidNat -> InvalidNat -> Bool
== :: InvalidNat -> InvalidNat -> Bool
$c== :: InvalidNat -> InvalidNat -> Bool
Eq, Int -> InvalidNat -> ShowS
[InvalidNat] -> ShowS
InvalidNat -> String
(Int -> InvalidNat -> ShowS)
-> (InvalidNat -> String)
-> ([InvalidNat] -> ShowS)
-> Show InvalidNat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidNat] -> ShowS
$cshowList :: [InvalidNat] -> ShowS
show :: InvalidNat -> String
$cshow :: InvalidNat -> String
showsPrec :: Int -> InvalidNat -> ShowS
$cshowsPrec :: Int -> InvalidNat -> ShowS
Show)
  deriving anyclass Show InvalidNat
Typeable InvalidNat
Typeable InvalidNat
-> Show InvalidNat
-> (InvalidNat -> SomeException)
-> (SomeException -> Maybe InvalidNat)
-> (InvalidNat -> String)
-> Exception InvalidNat
SomeException -> Maybe InvalidNat
InvalidNat -> String
InvalidNat -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: InvalidNat -> String
$cdisplayException :: InvalidNat -> String
fromException :: SomeException -> Maybe InvalidNat
$cfromException :: SomeException -> Maybe InvalidNat
toException :: InvalidNat -> SomeException
$ctoException :: InvalidNat -> SomeException
$cp2Exception :: Show InvalidNat
$cp1Exception :: Typeable InvalidNat
Exception

byteStringNatView :: View InvalidNat ByteString Natural
byteStringNatView :: View InvalidNat ByteString Natural
byteStringNatView = InvalidNat
-> AttoParser Natural -> View InvalidNat ByteString Natural
forall e a. e -> AttoParser a -> View e ByteString a
attoByteStringView InvalidNat
InvalidNat AttoParser Natural
p
  where
    p :: AttoParser Natural
p = AttoParser Natural
forall a. Integral a => Parser a
Data.Attoparsec.ByteString.Char8.decimal

byteStringNatView_ :: View () ByteString Natural
byteStringNatView_ :: View () ByteString Natural
byteStringNatView_ = View InvalidNat ByteString Natural -> View () ByteString Natural
forall e a b. View e a b -> View () a b
discardViewError View InvalidNat ByteString Natural
byteStringNatView

textNatView :: View InvalidNat Text Natural
textNatView :: View InvalidNat Text Natural
textNatView = InvalidNat -> TextReader Natural -> View InvalidNat Text Natural
forall e a. e -> TextReader a -> View e Text a
textReaderView InvalidNat
InvalidNat TextReader Natural
textReadDecimal

textNatView_ :: View () Text Natural
textNatView_ :: View () Text Natural
textNatView_ = View InvalidNat Text Natural -> View () Text Natural
forall e a b. View e a b -> View () a b
discardViewError View InvalidNat Text Natural
textNatView

data InvalidRational = InvalidRational
  deriving stock (InvalidRational -> InvalidRational -> Bool
(InvalidRational -> InvalidRational -> Bool)
-> (InvalidRational -> InvalidRational -> Bool)
-> Eq InvalidRational
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidRational -> InvalidRational -> Bool
$c/= :: InvalidRational -> InvalidRational -> Bool
== :: InvalidRational -> InvalidRational -> Bool
$c== :: InvalidRational -> InvalidRational -> Bool
Eq, Int -> InvalidRational -> ShowS
[InvalidRational] -> ShowS
InvalidRational -> String
(Int -> InvalidRational -> ShowS)
-> (InvalidRational -> String)
-> ([InvalidRational] -> ShowS)
-> Show InvalidRational
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidRational] -> ShowS
$cshowList :: [InvalidRational] -> ShowS
show :: InvalidRational -> String
$cshow :: InvalidRational -> String
showsPrec :: Int -> InvalidRational -> ShowS
$cshowsPrec :: Int -> InvalidRational -> ShowS
Show)
  deriving anyclass Show InvalidRational
Typeable InvalidRational
Typeable InvalidRational
-> Show InvalidRational
-> (InvalidRational -> SomeException)
-> (SomeException -> Maybe InvalidRational)
-> (InvalidRational -> String)
-> Exception InvalidRational
SomeException -> Maybe InvalidRational
InvalidRational -> String
InvalidRational -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: InvalidRational -> String
$cdisplayException :: InvalidRational -> String
fromException :: SomeException -> Maybe InvalidRational
$cfromException :: SomeException -> Maybe InvalidRational
toException :: InvalidRational -> SomeException
$ctoException :: InvalidRational -> SomeException
$cp2Exception :: Show InvalidRational
$cp1Exception :: Typeable InvalidRational
Exception

{- |

Read a rational number written in decimal notation.

=== Examples

>>> :set -XOverloadedStrings

>>> applyView byteStringRationalView "1234"
Success (1234 % 1)

>>> applyView byteStringRationalView "1234.567"
Success (1234567 % 1000)

>>> applyView byteStringRationalView "12.3.4"
Failure InvalidRational

-}

byteStringRationalView :: View InvalidRational ByteString Rational
byteStringRationalView :: View InvalidRational ByteString Rational
byteStringRationalView =
    View InvalidRational Text Rational
textRationalView View InvalidRational Text Rational
-> View InvalidRational ByteString Text
-> View InvalidRational ByteString Rational
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
    (InvalidUtf8 -> InvalidRational)
-> View InvalidUtf8 ByteString Text
-> View InvalidRational ByteString Text
forall e1 e2 a b. (e1 -> e2) -> View e1 a b -> View e2 a b
overViewError (\InvalidUtf8
InvalidUtf8 -> InvalidRational
InvalidRational) View InvalidUtf8 ByteString Text
utf8TextView

byteStringRationalView_ :: View () ByteString Rational
byteStringRationalView_ :: View () ByteString Rational
byteStringRationalView_ = View InvalidRational ByteString Rational
-> View () ByteString Rational
forall e a b. View e a b -> View () a b
discardViewError View InvalidRational ByteString Rational
byteStringRationalView

{- |

Read a rational number written in decimal notation.

=== Examples

>>> :set -XOverloadedStrings

>>> applyView textRationalView "1234"
Success (1234 % 1)

>>> applyView textRationalView "1234.567"
Success (1234567 % 1000)

>>> applyView textRationalView "12.3.4"
Failure InvalidRational

-}

textRationalView :: View InvalidRational Text Rational
textRationalView :: View InvalidRational Text Rational
textRationalView = InvalidRational
-> TextReader Rational -> View InvalidRational Text Rational
forall e a. e -> TextReader a -> View e Text a
textReaderView InvalidRational
InvalidRational TextReader Rational
textReadRational

textRationalView_ :: View () Text Rational
textRationalView_ :: View () Text Rational
textRationalView_ = View InvalidRational Text Rational -> View () Text Rational
forall e a b. View e a b -> View () a b
discardViewError View InvalidRational Text Rational
textRationalView

data InvalidDollars = InvalidDollars
  deriving stock (InvalidDollars -> InvalidDollars -> Bool
(InvalidDollars -> InvalidDollars -> Bool)
-> (InvalidDollars -> InvalidDollars -> Bool) -> Eq InvalidDollars
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidDollars -> InvalidDollars -> Bool
$c/= :: InvalidDollars -> InvalidDollars -> Bool
== :: InvalidDollars -> InvalidDollars -> Bool
$c== :: InvalidDollars -> InvalidDollars -> Bool
Eq, Int -> InvalidDollars -> ShowS
[InvalidDollars] -> ShowS
InvalidDollars -> String
(Int -> InvalidDollars -> ShowS)
-> (InvalidDollars -> String)
-> ([InvalidDollars] -> ShowS)
-> Show InvalidDollars
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidDollars] -> ShowS
$cshowList :: [InvalidDollars] -> ShowS
show :: InvalidDollars -> String
$cshow :: InvalidDollars -> String
showsPrec :: Int -> InvalidDollars -> ShowS
$cshowsPrec :: Int -> InvalidDollars -> ShowS
Show)
  deriving anyclass Show InvalidDollars
Typeable InvalidDollars
Typeable InvalidDollars
-> Show InvalidDollars
-> (InvalidDollars -> SomeException)
-> (SomeException -> Maybe InvalidDollars)
-> (InvalidDollars -> String)
-> Exception InvalidDollars
SomeException -> Maybe InvalidDollars
InvalidDollars -> String
InvalidDollars -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: InvalidDollars -> String
$cdisplayException :: InvalidDollars -> String
fromException :: SomeException -> Maybe InvalidDollars
$cfromException :: SomeException -> Maybe InvalidDollars
toException :: InvalidDollars -> SomeException
$ctoException :: InvalidDollars -> SomeException
$cp2Exception :: Show InvalidDollars
$cp1Exception :: Typeable InvalidDollars
Exception

{- | Read a dollar amount.

=== Examples

>>> applyView byteStringDollarsView "$1234.567"
Success (1234567 % 1000)

>>> applyView byteStringDollarsView "1234.567"
Failure InvalidDollars

-}

byteStringDollarsView :: View InvalidDollars ByteString Rational
byteStringDollarsView :: View InvalidDollars ByteString Rational
byteStringDollarsView =
    View InvalidDollars Text Rational
textDollarsView View InvalidDollars Text Rational
-> View InvalidDollars ByteString Text
-> View InvalidDollars ByteString Rational
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
    (InvalidUtf8 -> InvalidDollars)
-> View InvalidUtf8 ByteString Text
-> View InvalidDollars ByteString Text
forall e1 e2 a b. (e1 -> e2) -> View e1 a b -> View e2 a b
overViewError (\InvalidUtf8
InvalidUtf8 -> InvalidDollars
InvalidDollars) View InvalidUtf8 ByteString Text
utf8TextView

byteStringDollarsView_ :: View () ByteString Rational
byteStringDollarsView_ :: View () ByteString Rational
byteStringDollarsView_ = View InvalidDollars ByteString Rational
-> View () ByteString Rational
forall e a b. View e a b -> View () a b
discardViewError View InvalidDollars ByteString Rational
byteStringDollarsView

{- | Read a dollar amount.

=== Examples

>>> applyView textDollarsView "$1234.567"
Success (1234567 % 1000)

>>> applyView textDollarsView "1234.567"
Failure InvalidDollars

-}

textDollarsView :: View InvalidDollars Text Rational
textDollarsView :: View InvalidDollars Text Rational
textDollarsView =
    (InvalidRational -> InvalidDollars)
-> View InvalidRational Text Rational
-> View InvalidDollars Text Rational
forall e1 e2 a b. (e1 -> e2) -> View e1 a b -> View e2 a b
overViewError
        (\InvalidRational
InvalidRational -> InvalidDollars
InvalidDollars)
        View InvalidRational Text Rational
textRationalView
    View InvalidDollars Text Rational
-> View InvalidDollars Text Text
-> View InvalidDollars Text Rational
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
    (Text -> Validation InvalidDollars Text)
-> View InvalidDollars Text Text
forall e a b. (a -> Validation e b) -> View e a b
View (
        Validation InvalidDollars Text
-> (Text -> Validation InvalidDollars Text)
-> Maybe Text
-> Validation InvalidDollars Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InvalidDollars -> Validation InvalidDollars Text
forall err a. err -> Validation err a
Failure InvalidDollars
InvalidDollars) Text -> Validation InvalidDollars Text
forall err a. a -> Validation err a
Success (Maybe Text -> Validation InvalidDollars Text)
-> (Text -> Maybe Text) -> Text -> Validation InvalidDollars Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
        Text -> Text -> Maybe Text
textStripPrefix Text
"$"
    )

textDollarsView_ :: View () Text Rational
textDollarsView_ :: View () Text Rational
textDollarsView_ = View InvalidDollars Text Rational -> View () Text Rational
forall e a b. View e a b -> View () a b
discardViewError View InvalidDollars Text Rational
textDollarsView