{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}

module DSV.Text
  ( Text
  , stringToText, textToString
  , textNull, textStripPrefix
  , TextReader, textReadMaybe, textReadRational, textReadDecimal
  ) where

import DSV.Numbers
import DSV.Prelude

-- text
import Data.Text (Text)
import qualified Data.Text
import qualified Data.Text.Read

stringToText :: String -> Text
stringToText :: String -> Text
stringToText = String -> Text
Data.Text.pack

textToString :: Text -> String
textToString :: Text -> String
textToString = Text -> String
Data.Text.unpack

textNull :: Text -> Bool
textNull :: Text -> Bool
textNull = Text -> Bool
Data.Text.null

textStripPrefix :: Text -> Text -> Maybe Text
textStripPrefix :: Text -> Text -> Maybe Text
textStripPrefix = Text -> Text -> Maybe Text
Data.Text.stripPrefix

type TextReader a = Data.Text.Read.Reader a

textReadMaybe ::
    forall a .
    TextReader a -> Text -> Maybe a

textReadMaybe :: TextReader a -> Text -> Maybe a
textReadMaybe TextReader a
f Text
t =
    case TextReader a
f Text
t of
        Right (a
x, Text
r) | Text -> Bool
textNull Text
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
        Either String (a, Text)
_ -> Maybe a
forall a. Maybe a
Nothing

textReadRational :: TextReader Rational
textReadRational :: TextReader Rational
textReadRational = TextReader Rational
forall a. Fractional a => Reader a
Data.Text.Read.rational

textReadDecimal :: TextReader Natural
textReadDecimal :: TextReader Natural
textReadDecimal = TextReader Natural
forall a. Integral a => Reader a
Data.Text.Read.decimal