{-# LANGUAGE UndecidableInstances #-}

-- | Textual conversion for strings.
module MCSP.Data.String.Text (
    -- * Specializable `Show`.
    ShowString (..),
    showChars,
    showCharsWith,
    showWords,
    showWordsWith,

    -- * Specializable `Read`.
    ReadString (..),
    readChars,
    readCharsWith,
    readWords,
    readWordsWith,
) where

import Control.Monad (Functor (fmap), mapM, (>>=))
import Data.Char (Char)
import Data.Foldable (Foldable, foldr, toList)
import Data.Function (flip, id, ($), (.))
import Data.List (intersperse, singleton)
import Data.Maybe (Maybe (..))
import Data.String (String)
import Text.ParserCombinators.ReadP (ReadP)
import Text.Read (Read (..))
import Text.Show (Show (..), ShowS, showChar, shows)

import MCSP.Text.ReadP (maybeP, readMaybeP, readP, word, words)

-- ---------------------- --
-- Textual Output classes --
-- ---------------------- --

-- | Shows characters of a string separated by spaces.
--
-- >>> import Data.Int
-- >>> import Numeric
--
-- >>> showWordsWith @[] @Int showHex [1, 2, 12] ""
-- "1 2 c"
showWordsWith :: Foldable t => (a -> ShowS) -> t a -> ShowS
showWordsWith :: forall (t :: * -> *) a. Foldable t => (a -> ShowS) -> t a -> ShowS
showWordsWith a -> ShowS
showItem =
    (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id
        ([ShowS] -> ShowS) -> (t a -> [ShowS]) -> t a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (Char -> ShowS
showChar Char
' ')
        ([ShowS] -> [ShowS]) -> (t a -> [ShowS]) -> t a -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ShowS) -> [a] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ShowS
showItem
        ([a] -> [ShowS]) -> (t a -> [a]) -> t a -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Shows characters of a string separated by spaces.
--
-- This implementation uses the default converter for @Show a@.
--
-- >>> import Data.Int
--
-- >>> showWords @[] @Int [1, 2, 12] ""
-- "1 2 12"
showWords :: (Foldable f, Show a) => f a -> ShowS
showWords :: forall (f :: * -> *) a. (Foldable f, Show a) => f a -> ShowS
showWords = (a -> ShowS) -> f a -> ShowS
forall (t :: * -> *) a. Foldable t => (a -> ShowS) -> t a -> ShowS
showWordsWith a -> ShowS
forall a. Show a => a -> ShowS
shows

-- | Shows all elements without quoting or separation.
--
-- >>> import Data.Int
-- >>> import Data.List
-- >>> import Numeric
-- >>> data DNA = A | C | G | T deriving (Show, Read)
--
-- >>> showCharsWith (\n -> head $ showHex n "") [1, 2, 12] ""
-- "12c"
--
-- >>> showCharsWith @[] @DNA (head . show) [A, C, C, A] ""
-- "ACCA"
showCharsWith :: Foldable f => (a -> Char) -> f a -> ShowS
showCharsWith :: forall (f :: * -> *) a. Foldable f => (a -> Char) -> f a -> ShowS
showCharsWith a -> Char
showItem = (String -> f a -> String) -> f a -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String -> f a -> String) -> f a -> ShowS)
-> (String -> f a -> String) -> f a -> ShowS
forall a b. (a -> b) -> a -> b
$ (a -> ShowS) -> String -> f a -> String
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char -> ShowS
showChar (Char -> ShowS) -> (a -> Char) -> a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Char
showItem)

-- | Shows all elements without quoting or separation.
--
-- This implementation uses the default converter for @Show a@.
--
-- >>> import Data.Int
-- >>> import Data.List
-- >>> data DNA = A | C | G | T deriving (Show, Read)
--
-- >>> showChars @[] @Int [1, 2, 12, 3, 56] ""
-- "12\65533\&3\65533"
--
-- >>> showChars @[] @DNA [A, C, C, A] ""
-- "ACCA"
showChars :: (Foldable f, Show a) => f a -> ShowS
showChars :: forall (f :: * -> *) a. (Foldable f, Show a) => f a -> ShowS
showChars = (a -> Char) -> f a -> ShowS
forall (f :: * -> *) a. Foldable f => (a -> Char) -> f a -> ShowS
showCharsWith (String -> Char
String -> Item String
forall {l}. (Item l ~ Char, IsList l) => l -> Item l
toChar (String -> Char) -> (a -> String) -> a -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)
  where
    toChar :: l -> Item l
toChar [Item l
ch] = Item l
ch
    toChar l
_ = Char
Item l
'�'

-- | Specializable `MCSP.Data.String.String` to text conversion.
--
-- Used for showing a string of the given character @a@.
class ShowString a where
    {-# MINIMAL showStr #-}

    -- | Shows characters of a `MCSP.Data.String.String`.
    --
    -- `Show` @(String a)@ uses this specialized implementation.
    showStr :: Foldable f => f a -> ShowS

instance {-# OVERLAPPABLE #-} Show a => ShowString a where
    showStr :: forall (f :: * -> *). Foldable f => f a -> ShowS
showStr = f a -> ShowS
forall (f :: * -> *) a. (Foldable f, Show a) => f a -> ShowS
showWords

-- | `MCSP.Data.String.String` `Char` represented by unseparated characters without quotes
-- (@abcd@).
instance ShowString Char where
    showStr :: forall (f :: * -> *). Foldable f => f Char -> ShowS
showStr = (Char -> Char) -> f Char -> ShowS
forall (f :: * -> *) a. Foldable f => (a -> Char) -> f a -> ShowS
showCharsWith Char -> Char
forall a. a -> a
id

-- --------------------- --
-- Textual Input classes --
-- --------------------- --

-- | Reads characters of a string separated by spaces.
--
-- >>> import Data.Int
-- >>> import MCSP.Text.ReadP
-- >>> import Text.Read.Lex
--
-- >>> readP_to_S (readWordsWith @Int $ readMaybeP readHexP) "1 2 c"
-- [([],"1 2 c"),([1],"2 c"),([1,2],"c"),([1,2,12],"")]
--
-- >>> readP_to_S (readWordsWith $ readMaybeP word) " a  xy  b "
-- [([],"a  xy  b "),(["a"],"xy  b "),(["a","xy"],"b "),(["a","xy","b"],"")]
readWordsWith :: (String -> Maybe a) -> ReadP [a]
readWordsWith :: forall a. (String -> Maybe a) -> ReadP [a]
readWordsWith String -> Maybe a
parse = ReadP [String]
words ReadP [String] -> ([String] -> ReadP [a]) -> ReadP [a]
forall a b. ReadP a -> (a -> ReadP b) -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> ReadP a) -> [String] -> ReadP [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe a -> ReadP a
forall a. Maybe a -> ReadP a
maybeP (Maybe a -> ReadP a) -> (String -> Maybe a) -> String -> ReadP a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
parse)

-- | Reads characters of a string separated by spaces.
--
-- This implementation uses the default converter for @Read a@.
--
-- >>> import Data.Int
-- >>> import MCSP.Text.ReadP
--
-- >>> readP_to_S (readWords @Int) "1 2 12"
-- [([],"1 2 12"),([1],"2 12"),([1,2],"12"),([1,2,12],"")]
readWords :: Read a => ReadP [a]
readWords :: forall a. Read a => ReadP [a]
readWords = (String -> Maybe a) -> ReadP [a]
forall a. (String -> Maybe a) -> ReadP [a]
readWordsWith (ReadP a -> String -> Maybe a
forall a. ReadP a -> String -> Maybe a
readMaybeP ReadP a
forall a. Read a => ReadP a
readP)

-- | Reads all elements without quoting or separation.
--
-- >>> import Data.Int
-- >>> import MCSP.Text.ReadP
-- >>> import Text.Read.Lex
-- >>> data DNA = A | C | G | T deriving (Show, Read)
--
-- >>> readP_to_S (readCharsWith @Int (\ch -> readMaybeP readHexP [ch])) "12c"
-- [([1,2,12],"")]
--
-- >>> readP_to_S (readCharsWith @DNA (\ch -> readMaybeP readP [ch])) "TTGA"
-- [([T,T,G,A],"")]
readCharsWith :: (Char -> Maybe a) -> ReadP [a]
readCharsWith :: forall a. (Char -> Maybe a) -> ReadP [a]
readCharsWith Char -> Maybe a
parse = ReadP String
word ReadP String -> (String -> ReadP [a]) -> ReadP [a]
forall a b. ReadP a -> (a -> ReadP b) -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Char -> ReadP a) -> String -> ReadP [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe a -> ReadP a
forall a. Maybe a -> ReadP a
maybeP (Maybe a -> ReadP a) -> (Char -> Maybe a) -> Char -> ReadP a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe a
parse)

-- | Reads all elements without quoting or separation.
--
-- This implementation uses the default converter for @Read a@.
--
-- >>> import Data.Int
-- >>> import MCSP.Text.ReadP
-- >>> data DNA = A | C | G | T deriving (Show, Read)
--
-- >>> readP_to_S (readChars @Int) "1212"
-- [([1,2,1,2],"")]
--
-- >>> readP_to_S (readChars @DNA) "TTGA"
-- [([T,T,G,A],"")]
readChars :: Read a => ReadP [a]
readChars :: forall a. Read a => ReadP [a]
readChars = (Char -> Maybe a) -> ReadP [a]
forall a. (Char -> Maybe a) -> ReadP [a]
readCharsWith (ReadP a -> String -> Maybe a
forall a. ReadP a -> String -> Maybe a
readMaybeP ReadP a
forall a. Read a => ReadP a
readP (String -> Maybe a) -> (Char -> String) -> Char -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
singleton)

-- | Specializable text to `Strings.Data.String.String` conversion.
--
-- Used for reading a string of the given character @a@.
class ReadString a where
    {-# MINIMAL readStr #-}

    -- | Read characters of a `Strings.Data.String.String`.
    --
    -- `Read` @(String a)@ uses this specialized implementation.
    readStr :: ReadP [a]

instance {-# OVERLAPPABLE #-} Read a => ReadString a where
    readStr :: ReadP [a]
readStr = ReadP [a]
forall a. Read a => ReadP [a]
readWords

-- | `MCSP.Data.String.String` `Char` represented by unseparated characters without quotes
-- (@abcd@).
instance ReadString Char where
    readStr :: ReadP String
readStr = (Char -> Maybe Char) -> ReadP String
forall a. (Char -> Maybe a) -> ReadP [a]
readCharsWith Char -> Maybe Char
forall a. a -> Maybe a
Just