{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Symantic.Plaintext.Output where

import Data.Bool
import Data.Char (Char)
import Data.Eq (Eq (..))
import Data.Foldable qualified as Fold
import Data.Function (id, ($), (.))
import Data.Function qualified as Fun
import Data.Functor (Functor, (<$>))
import Data.List qualified as List
import Data.Maybe (Maybe (..))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import Data.Semigroup qualified as SG
import Data.String (IsString (..), String)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TLB
import Prelude (fromIntegral)

import Numeric.Natural (Natural)
import Symantic.Plaintext.Classes
import Text.Show (Show)

-- * Class 'Outputable'
class
  ( IsString o
  , Convertible Char o
  , Convertible String o
  , Convertible T.Text o
  , Convertible TL.Text o
  , Monoid o
  ) =>
  Outputable o
  where
  char :: Char -> o
  nl :: o
  repeatedChar :: Width -> Char -> o
instance Outputable String where
  char = (: [])
  nl = "\n"
  repeatedChar w c = fromString (List.replicate (fromIntegral w) c)
instance Outputable T.Text where
  char = T.singleton
  nl = "\n"
  repeatedChar w = T.replicate (fromIntegral w) . T.singleton
instance Outputable TL.Text where
  char = TL.singleton
  nl = "\n"
  repeatedChar w = TL.replicate (fromIntegral w) . TL.singleton

-- * Class 'Lengthable'
class Lengthable o where
  length :: o -> Column
  isEmpty :: o -> Bool
  isEmpty x = length x == 0
instance Lengthable Char where
  length _ = 1
  isEmpty = Fun.const False
instance Lengthable String where
  length = fromIntegral . List.length
  isEmpty = Fold.null
instance Lengthable T.Text where
  length = fromIntegral . T.length
  isEmpty = T.null
instance Lengthable TL.Text where
  length = fromIntegral . TL.length
  isEmpty = TL.null

-- * Class 'Dimensionable'
class Dimensionable a where
  width :: a -> Natural
  height :: a -> Natural
instance Dimensionable a => Dimensionable (Line a) where
  width = width . unLine
  height _ = 1
instance Dimensionable a => Dimensionable (Word a) where
  width _ = 1
  height _ = 1

-- * Class 'Splitable'
class (Lengthable o, Monoid o) => Splitable o where
  tail :: o -> Maybe (o)
  break :: (Char -> Bool) -> o -> (o, o)
  span :: (Char -> Bool) -> o -> (o, o)
  span f = break (not . f)

  splitOnChar :: (Char -> Bool) -> o -> [o]
  splitOnChar f d0 =
    if isEmpty d0 then [] else go d0
    where
      go o =
        let (l, r) = f `break` o
         in l : case tail r of
              Nothing -> []
              Just rt
                | isEmpty rt -> [mempty]
                | otherwise -> go rt
  splitOnCharNoEmpty :: (Char -> Bool) -> o -> [o]
  splitOnCharNoEmpty f x =
    let (l, r) = f `break` x
     in [l | not (isEmpty l)]
        SG.<> case tail r of
          Nothing -> []
          Just rt -> splitOnCharNoEmpty f rt
instance Splitable String where
  tail [] = Nothing
  tail s = Just $ List.tail s
  break = List.break
instance Splitable T.Text where
  tail "" = Nothing
  tail s = Just $ T.tail s
  break = T.break
instance Splitable TL.Text where
  tail "" = Nothing
  tail s = Just $ TL.tail s
  break = TL.break

-- ** Type 'Line'
newtype Line o = Line o
  deriving (Functor, Semigroup, Monoid, Lengthable, Splitable)
  deriving stock (Show)

unLine :: Line o -> o
unLine (Line x) = x
lines :: Splitable o => o -> [Line o]
linesNoEmpty :: Splitable o => o -> [Line o]
lines = (Line <$>) . splitOnChar (== '\n')
linesNoEmpty = (Line <$>) . splitOnCharNoEmpty (== '\n')

-- ** Type 'Word'
newtype Word o = Word o
  deriving (Functor, Semigroup, Monoid, Lengthable, Splitable)
  deriving stock (Show)

unWord :: Word o -> o
unWord (Word x) = x
words :: Splitable o => Line o -> [Word o]
wordsNoEmpty :: Splitable o => Line o -> [Word o]
words = (Word <$>) . splitOnChar (== ' ') . unLine
wordsNoEmpty = (Word <$>) . splitOnCharNoEmpty (== ' ') . unLine

-- * Class 'Convertible'
class Convertible i o where
  convert :: i -> o
instance Convertible Char String where
  convert = (: [])
instance Convertible String String where
  convert = id
instance Convertible T.Text String where
  convert = T.unpack
instance Convertible TL.Text String where
  convert = TL.unpack
instance Convertible Char T.Text where
  convert = T.singleton
instance Convertible String T.Text where
  convert = T.pack
instance Convertible T.Text T.Text where
  convert = id
instance Convertible TL.Text T.Text where
  convert = TL.toStrict
instance Convertible Char TL.Text where
  convert = TL.singleton
instance Convertible String TL.Text where
  convert = TL.pack
instance Convertible T.Text TL.Text where
  convert = TL.fromStrict
instance Convertible TL.Text TL.Text where
  convert = id
instance Convertible Char TLB.Builder where
  convert = TLB.singleton
instance Convertible String TLB.Builder where
  convert = fromString
instance Convertible T.Text TLB.Builder where
  convert = TLB.fromText
instance Convertible TL.Text TLB.Builder where
  convert = TLB.fromLazyText
instance Convertible TLB.Builder TLB.Builder where
  convert = id
instance Convertible i o => Convertible (Word i) (Word o) where
  convert = Word . convert . unWord
instance Convertible i o => Convertible (Line i) (Line o) where
  convert = Line . convert . unLine