{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Symantic.Formatter.Output where

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

import Symantic.Formatter.Class

-- * 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 '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 { unLine :: o }
  deriving (Functor, Semigroup, Monoid, Lengthable, Splitable)

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 { unWord :: o }
  deriving (Functor, Semigroup, Monoid, Lengthable, Splitable)

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