{-# LANGUAGE FlexibleInstances #-}
module Web.Encodings.StringLike
    ( StringLike (..)
    ) where

import Prelude (Char, Bool (..), String, Int, Eq (..), Show, ($), (.),
                (<=), (-), otherwise, Maybe (..), (&&), not)
import qualified Prelude as P
import qualified Data.List as L
import qualified Web.Encodings.ListHelper as LH
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Monoid as M
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import Data.Maybe (fromMaybe)

class (Eq a, Show a) => StringLike a where
    span :: (Char -> Bool) -> a -> (a, a)
    null :: a -> Bool
    concatMap :: (Char -> String) -> a -> a
    dropWhile :: (Char -> Bool) -> a -> a
    break :: (Char -> Bool) -> a -> (a, a)
    cons :: Char -> a -> a
    uncons :: a -> Maybe (Char, a)
    append :: a -> a -> a
    intercalate :: a -> [a] -> a
    isPrefixOf :: a -> a -> Bool
    take :: Int -> a -> a
    head :: a -> Char
    tail :: a -> a
    init :: a -> a
    last :: a -> Char
    empty :: a

    pack :: String -> a
    unpack :: a -> String

    dropPrefix :: a -> a -> Maybe a
    dropPrefix porig sorig = helper porig sorig where
        helper p s
            | null p && null s = Just empty
            | null p = Just s
            | null s = Nothing
            | head p == head s = helper (tail p) (tail s)
            | otherwise = Nothing
    dropPrefix' :: a -> a -> a
    dropPrefix' p c = case dropPrefix p c of
        Just x -> x
        Nothing -> c
    dropQuotes :: a -> a
    dropQuotes s
        | lengthGE 2 s && head s == '"' && last s == '"' = tail $ init s
        | otherwise = s
    chomp :: a -> a
    chomp s | null s = s
    chomp s = case last s of
                '\n' -> chomp $ init s
                '\r' -> chomp $ init s
                _ -> s
    split :: Char -> a -> [a]
    split c s =
        let (next, rest) = breakChar c s
         in if null next
                then (if null rest then [] else [rest])
                else next : split c rest
    breakCharMaybe :: Char -> a -> Maybe (a, a)
    breakCharMaybe c s
        | null s = Nothing
        | c == head s = Just (empty, tail s)
        | otherwise = do
            (next, rest) <- breakCharMaybe c (tail s)
            Just (cons (head s) next, rest)
    breakChar :: Char -> a -> (a, a)
    breakChar c s = fromMaybe (s, empty) $ breakCharMaybe c s
    breakString :: a -> a -> (a, a)
    breakString _ c | null c = (empty, empty)
    breakString p c = case dropPrefix p c of
        Just x -> (empty, x)
        Nothing ->
            let x = head c
                xs = tail c
                (next, rest) = breakString p xs
             in (cons x next, rest)
    takeLine :: a -> (a, a)
    takeLine a =
        let (x, y) = breakChar '\n' a
            x' = chomp x
         in (x', y)
    takeUntilBlank :: a -> ([a], a)
    takeUntilBlank a =
        let (next, rest) = takeLine a
         in if null next
                then ([], rest)
                else let (nexts, rest') = takeUntilBlank rest
                      in (next : nexts, rest')

    lengthLT :: Int -> a -> Bool
    lengthLT i _ | i <= 0 = False
    lengthLT i a
        | null a = True
        | otherwise = lengthLT (i - 1) $ tail a
    lengthGE :: Int -> a -> Bool
    lengthGE i = not . lengthLT i

instance StringLike [Char] where
    intercalate = L.intercalate
    null = P.null
    concatMap = P.concatMap
    tail = P.tail
    head = P.head
    cons = LH.cons
    uncons [] = Nothing
    uncons (x:xs) = Just (x, xs)
    span = P.span
    dropWhile = P.dropWhile
    break = P.break
    append = M.mappend
    isPrefixOf = L.isPrefixOf
    take = P.take
    empty = M.mempty
    pack = P.id
    unpack = P.id
    init = P.init
    last = P.last

instance StringLike BS.ByteString where
    span = BS.span
    null = BS.null
    concatMap f = BS.concatMap $ pack . f
    dropWhile = BS.dropWhile
    break = BS.break
    cons = BS.cons
    uncons = BS.uncons
    append = BS.append
    intercalate = BS.intercalate
    isPrefixOf = BS.isPrefixOf
    take = BS.take
    head = BS.head
    tail = BS.tail
    empty = BS.empty
    pack = BS.pack
    unpack = BS.unpack
    init = BS.init
    last = BS.last

instance StringLike BL.ByteString where
    span = BL.span
    null = BL.null
    concatMap f = BL.concatMap $ pack . f
    dropWhile = BL.dropWhile
    break = BL.break
    cons = BL.cons
    uncons = BL.uncons
    append = BL.append
    intercalate = BL.intercalate
    isPrefixOf = BL.isPrefixOf
    take i = BL.take $ P.fromIntegral i
    head = BL.head
    tail = BL.tail
    empty = BL.empty
    pack = BL.pack
    unpack = BL.unpack
    init = BL.init
    last = BL.last

instance StringLike TS.Text where
    span = TS.spanBy
    null = TS.null
    concatMap f = TS.concatMap $ pack . f
    dropWhile = TS.dropWhile
    break = TS.breakBy
    cons = TS.cons
    uncons = TS.uncons
    append = TS.append
    intercalate = TS.intercalate
    isPrefixOf = TS.isPrefixOf
    take i = TS.take $ P.fromIntegral i
    head = TS.head
    tail = TS.tail
    empty = TS.empty
    pack = TS.pack
    unpack = TS.unpack
    init = TS.init
    last = TS.last

instance StringLike TL.Text where
    span = TL.spanBy
    null = TL.null
    concatMap f = TL.concatMap $ pack . f
    dropWhile = TL.dropWhile
    break = TL.breakBy
    cons = TL.cons
    uncons = TL.uncons
    append = TL.append
    intercalate = TL.intercalate
    isPrefixOf = TL.isPrefixOf
    take i = TL.take $ P.fromIntegral i
    head = TL.head
    tail = TL.tail
    empty = TL.empty
    pack = TL.pack
    unpack = TL.unpack
    init = TL.init
    last = TL.last