{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Data.WText where

import Prelude hiding (break, drop, map, splitAt, take)
import Prelude qualified

import Data.Coerce (coerce)
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.WCWidth qualified as WT

import Data.Sequences
import Data.MonoTraversable


newtype WText = WText { unWText :: Text }
  deriving (Eq, Ord, Show, IsString, Semigroup, Monoid)
  deriving (MonoFoldable, MonoFunctor) via Text


type instance Element WText = Char

instance MonoTraversable WText where
  otraverse f (WText t) = WText <$> otraverse f t

instance MonoPointed WText where
  opoint c = WText (T.singleton c)

instance GrowingAppend WText
--gappend (WText a) (WText b) = WText (a <> b)

instance IsSequence WText where
  fromList    = WText . T.pack
  --singleton   = WText . T.singleton

  --index (WText t)       = T.index t
  lengthIndex (WText t) = T.length t

  take n (WText t)    = WText (T.take n t)
  drop n (WText t)    = WText (T.drop n t)
  splitAt n (WText t) =
    let (a,b) = T.splitAt n t
    in (WText a, WText b)

instance SemiSequence WText where
  type Index WText = Int

  intersperse c (WText t) = WText (T.intersperse c t)

  reverse (WText t) = WText (T.reverse t)

  cons c (WText t) = WText (T.cons c t)
  snoc (WText t) c = WText (T.snoc t c)

  find p (WText t) = find p t

  sortBy cmp (WText t) =
    WText (T.pack (sortBy cmp (T.unpack t)))

instance Textual WText where
  words (WText t)   = Prelude.map WText (T.words t)
  unwords ws        = WText (T.unwords (ofoldMap (\(WText t) -> [t]) ws))

  lines (WText t)   = Prelude.map WText (T.lines t)
  unlines ws        = WText (T.unlines (ofoldMap (\(WText t) -> [t]) ws))

  toLower (WText t)    = WText (T.toLower t)
  toUpper (WText t)    = WText (T.toUpper t)
  toCaseFold (WText t) = WText (T.toCaseFold t)


--------------------------------------------------------------------------------
-- low-level
--------------------------------------------------------------------------------

split :: (Char -> Bool) -> WText -> [WText]
split = coerce WT.wsplit

splitAt :: Int -> WText -> (WText, WText)
splitAt = coerce WT.wsplitAt

take :: Int -> WText -> WText
take = coerce WT.wtake

drop :: Int -> WText -> WText
drop = coerce WT.wdrop

length :: WText -> Int
length = coerce WT.wlength


--------------------------------------------------------------------------------
-- coercible
--------------------------------------------------------------------------------

null :: WText -> Bool
null = coerce T.null 

filter :: (Char -> Bool) -> WText -> WText
filter = coerce T.filter

map :: (Char -> Char) -> WText -> WText
map = coerce T.map

reverse
  , strip
  , toUpper
  , toLower
  :: WText -> WText
reverse = coerce T.reverse
strip = coerce T.strip
toUpper = coerce T.toUpper
toLower = coerce T.toLower

stripPrefix, stripSuffix :: WText -> WText -> Maybe WText
stripPrefix = coerce T.stripPrefix
stripSuffix = coerce T.stripSuffix

replace :: WText -> WText -> WText -> WText
replace = coerce T.replace

intercalate :: WText -> [WText] -> WText
intercalate = coerce T.intercalate

isPrefixOf
  , isSuffixOf
  , isInfixOf
  :: WText -> WText -> Bool
isPrefixOf = coerce T.isPrefixOf
isSuffixOf = coerce T.isSuffixOf
isInfixOf = coerce T.isInfixOf