module Data.ListLike.String
( StringLike(..)
)
where
import Prelude hiding (length, head, last, null, tail, map, filter, concat,
any, lookup, init, all, foldl, foldr, foldl1, foldr1,
maximum, minimum, iterate, span, break, takeWhile,
dropWhile, reverse, zip, zipWith, sequence,
sequence_, mapM, mapM_, concatMap, and, or, sum,
product, repeat, replicate, cycle, take, drop,
splitAt, elem, notElem, unzip, lines, words,
unlines, unwords)
import qualified Data.List as L
import Data.ListLike.Base
class StringLike s where
toString :: s -> String
fromString :: String -> s
lines :: (ListLike full s) => s -> full
lines = myLines
words :: ListLike full s => s -> full
words = myWords
unlines :: ListLike full s => full -> s
unlines = myUnlines
unwords :: ListLike full s => full -> s
unwords = myUnwords
myLines :: (StringLike s, ListLike full s) => s -> full
myLines = map fromString . L.lines . toString
myWords :: (StringLike s, ListLike full s) => s -> full
myWords = map fromString . L.words . toString
myUnlines :: (StringLike s, ListLike full s) => full -> s
myUnlines = fromString . L.unlines . map toString
myUnwords :: (StringLike s, ListLike full s) => full -> s
myUnwords = fromString . L.unwords . map toString