-- |  Thin wrapper around 'Text', but without unsafe characters.
module LiBro.Data.SafeText
  (
  -- * Definition of /unsafe/
  unsafeChars
  -- * A thin 'Text' wrapper with smart data constructor
  -- $smartDC
  , SafeText
  , getText
  -- * Safety checks
  , isSafeChar
  , isSafeText
  , isSafeString
  -- * Explicit value creation
  , safePackText
  , safePack
  , safeModify
  -- * Other useful stuff
  , safeTextParser
  ) where

import LiBro.Util
import Data.Text (Text)
import qualified Data.Text as T
import Data.String
import Data.Maybe
import Data.Aeson
import Data.Csv
import Test.QuickCheck

-- |  A list of all characters considered /unsafe/ in our setting:
--    @'\\NUL'@ and @'\\r'@.
unsafeChars :: [Char]
unsafeChars :: [Char]
unsafeChars = [Char]
"\NUL\r"

{- $smartDC
'SafeText' is only a thin @newtype@ wrapper around 'Text'. To ensure
that its characters are /safe/, the standard data constructor is hidden
from exports.

== How to create 'SafeText' values?

* Use `safePack` or 'safePackText' to create @'Just' 'SafeText'@ values
  (or 'Nothing' if the given text or string was /unsafe/).
* Use 'SafeText'\'s 'Read' instance together with 'read' or
  'Text.Read.readMaybe'.
* Use 'SafeText'\'s 'IsString' instance together with the
  [@OverloadedStrings@](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/overloaded_strings.html)
  extension to create 'SafeText' directly from string literals:
  @"Hello, world" :: SafeText@

== Can 'SafeText' be used exactly like 'Text'?

No. There are very useful instances: 'Arbitrary' for property tests with
"Test.QuickCheck", 'ToJSON' and 'FromJSON' for JSON stuff with "Data.Aeson"
and 'ToField' and 'FromField' for CSV stuff with "Data.Csv" (Cassava).

Also, there's 'safeModify' that allows 'Text' modifying functions to be
applied /inside/ a 'SafeText'. But it seems to be a bit overkill to export
everything "Data.Text" has to offer.
-}

-- |  A simple @newtype@ wrapper around 'Text', but ensures the absence
--    of /unsafe/ characters.
newtype SafeText = SafeText
  { SafeText -> Text
getText :: Text -- ^ Extracts the 'Text' value from 'SafeText'.
  } deriving SafeText -> SafeText -> Bool
(SafeText -> SafeText -> Bool)
-> (SafeText -> SafeText -> Bool) -> Eq SafeText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeText -> SafeText -> Bool
== :: SafeText -> SafeText -> Bool
$c/= :: SafeText -> SafeText -> Bool
/= :: SafeText -> SafeText -> Bool
Eq

instance Show SafeText where
  show :: SafeText -> [Char]
show = Text -> [Char]
forall a. Show a => a -> [Char]
show (Text -> [Char]) -> (SafeText -> Text) -> SafeText -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeText -> Text
getText

-- |  A simple 'ReadS' parser for 'SafeText', useful for 'Read' instances.
safeTextParser :: ReadS SafeText
safeTextParser :: ReadS SafeText
safeTextParser [Char]
input
  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
unsafe = [(SafeText
safeText, [Char]
"")]
  | Bool
otherwise   = []
  where ([Char]
safe, [Char]
unsafe)  = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSafeChar [Char]
input
        safeText :: SafeText
safeText        = Maybe SafeText -> SafeText
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SafeText -> SafeText) -> Maybe SafeText -> SafeText
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe SafeText
safePack [Char]
safe

instance Read SafeText where
  readsPrec :: Int -> ReadS SafeText
readsPrec Int
_ = ReadS SafeText
safeTextParser

-- |  Checks if a 'Char' is considered /safe/.
isSafeChar :: Char -> Bool
isSafeChar :: Char -> Bool
isSafeChar = (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
unsafeChars)

-- |  Checks if a 'Text' is considered /safe/.
isSafeText :: Text -> Bool
isSafeText :: Text -> Bool
isSafeText = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSafeChar

-- |  Checks if a 'GHC.Base.String' is considered /safe/.
isSafeString :: String -> Bool
isSafeString :: [Char] -> Bool
isSafeString = (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSafeChar

-- |  Creates a 'SafeText' value or 'Nothing'
--    if the given 'Text' was /unsafe/.
safePackText :: Text -> Maybe SafeText
safePackText :: Text -> Maybe SafeText
safePackText = (Text -> SafeText) -> Maybe Text -> Maybe SafeText
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> SafeText
SafeText (Maybe Text -> Maybe SafeText)
-> (Text -> Maybe Text) -> Text -> Maybe SafeText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
guarded Text -> Bool
isSafeText

-- |  Creates a 'SafeText' value or 'Nothing'
--    if the given 'GHC.Base.String' was /unsafe/.
safePack :: String -> Maybe SafeText
safePack :: [Char] -> Maybe SafeText
safePack = Text -> Maybe SafeText
safePackText (Text -> Maybe SafeText)
-> ([Char] -> Text) -> [Char] -> Maybe SafeText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

-- |  Safe application of a function that modifies 'Text' values.
safeModify :: (Text -> Text) -> SafeText -> Maybe SafeText
safeModify :: (Text -> Text) -> SafeText -> Maybe SafeText
safeModify Text -> Text
m = Text -> Maybe SafeText
safePackText (Text -> Maybe SafeText)
-> (SafeText -> Text) -> SafeText -> Maybe SafeText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
m (Text -> Text) -> (SafeText -> Text) -> SafeText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeText -> Text
getText

instance IsString SafeText where
  fromString :: [Char] -> SafeText
fromString [Char]
s
    | [Char] -> Bool
isSafeString [Char]
s  = Text -> SafeText
SafeText ([Char] -> Text
T.pack [Char]
s)
    | Bool
otherwise       = [Char] -> SafeText
forall a. HasCallStack => [Char] -> a
error ([Char]
"Not a safe string: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
s)

instance Arbitrary SafeText where
  arbitrary :: Gen SafeText
arbitrary = Gen [Char] -> ([Char] -> Maybe SafeText) -> Gen SafeText
forall a b. Gen a -> (a -> Maybe b) -> Gen b
suchThatMap Gen [Char]
forall a. Arbitrary a => Gen a
arbitrary [Char] -> Maybe SafeText
safePack

instance ToJSON SafeText where
  toJSON :: SafeText -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (SafeText -> Text) -> SafeText -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeText -> Text
getText

instance FromJSON SafeText where
  parseJSON :: Value -> Parser SafeText
parseJSON = [Char] -> (Text -> Parser SafeText) -> Value -> Parser SafeText
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"SafeText" ((Text -> Parser SafeText) -> Value -> Parser SafeText)
-> (Text -> Parser SafeText) -> Value -> Parser SafeText
forall a b. (a -> b) -> a -> b
$ \Text
text ->
    case Text -> Maybe SafeText
safePackText Text
text of
      Just SafeText
st -> SafeText -> Parser SafeText
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SafeText
st
      Maybe SafeText
Nothing -> [Char] -> Parser SafeText
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser SafeText) -> [Char] -> Parser SafeText
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsafe string: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
text

instance ToField SafeText where
  toField :: SafeText -> Field
toField = Text -> Field
forall a. ToField a => a -> Field
toField (Text -> Field) -> (SafeText -> Text) -> SafeText -> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeText -> Text
getText

instance FromField SafeText where
  parseField :: Field -> Parser SafeText
parseField Field
fbs = do
    Text
text <- Field -> Parser Text
forall a. FromField a => Field -> Parser a
parseField Field
fbs
    case Text -> Maybe SafeText
safePackText Text
text of
      Just SafeText
st -> SafeText -> Parser SafeText
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SafeText
st
      Maybe SafeText
Nothing -> [Char] -> Parser SafeText
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser SafeText) -> [Char] -> Parser SafeText
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsafe string: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
text