{-# LANGUAGE CPP
,MultiParamTypeClasses
,FlexibleInstances
,TypeFamilies
,TypeSynonymInstances #-}
{-# OPTIONS -fno-warn-orphans #-}
module Data.ListLike.Instances () 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 Prelude as P
import Control.Applicative ((<$>), (<*>))
import Control.Monad
import qualified Data.List as L
import qualified Data.Sequence as S
import Data.Sequence ((><), (|>), (<|))
import qualified Data.Foldable as F
import Data.ListLike.Base
import Data.ListLike.String
import Data.ListLike.IO
import Data.ListLike.FoldableLL
import Data.ListLike.Text ()
import Data.ListLike.UTF8 ()
import Data.ListLike.Vector ()
import Data.Int
import Data.Monoid
import Data.Semigroup (Semigroup(..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.Array.IArray as A
import Data.Array.IArray((!), (//), Ix(..))
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSLC
import Data.String (IsString(fromString))
import qualified System.IO as IO
import Data.Word
import GHC.Exts (IsList(..))
instance ListLikeIO String Char where
hGetLine = IO.hGetLine
hGetContents = IO.hGetContents
hGet _ c | c <= 0 = return mempty
hGet h c = cons <$> IO.hGetChar h <*> hGet h (pred c)
hGetNonBlocking _h _i = error "Unimplemented: hGetNonBlocking in instance ListLikeIO String Char"
hPutStr = IO.hPutStr
hPutStrLn = IO.hPutStrLn
getLine = IO.getLine
getContents = IO.getContents
putStr = IO.putStr
putStrLn = IO.putStrLn
interact = IO.interact
readFile = IO.readFile
writeFile = IO.writeFile
instance StringLike String where
toString = id
instance InfiniteListLike [a] a where
iterate = L.iterate
repeat = L.repeat
cycle = L.cycle
instance FoldableLL BS.ByteString Word8 where
foldl = BS.foldl
foldl' = BS.foldl'
foldl1 = BS.foldl1
foldr = BS.foldr
foldr' = BS.foldr'
foldr1 = BS.foldr1
instance IsList BS.ByteString where
type Item BS.ByteString = Word8
toList = BS.unpack
fromList = BS.pack
instance ListLike BS.ByteString Word8 where
empty = BS.empty
singleton = BS.singleton
cons = BS.cons
snoc = BS.snoc
append = BS.append
uncons = BS.uncons
head = BS.head
last = BS.last
tail = BS.tail
init = BS.init
null = BS.null
length = BS.length
rigidMap = BS.map
reverse = BS.reverse
intersperse = BS.intersperse
concat = BS.concat . toList
rigidConcatMap = BS.concatMap
any = BS.any
all = BS.all
maximum = BS.maximum
minimum = BS.minimum
replicate = BS.replicate
take = BS.take
drop = BS.drop
splitAt = BS.splitAt
takeWhile = BS.takeWhile
dropWhile = BS.dropWhile
span = BS.span
break = BS.break
group = fromList . BS.group
inits = fromList . BS.inits
tails = fromList . BS.tails
isPrefixOf = BS.isPrefixOf
isSuffixOf = BS.isSuffixOf
elem = BS.elem
notElem = BS.notElem
find = BS.find
filter = BS.filter
index = BS.index
elemIndex = BS.elemIndex
elemIndices x = fromList . BS.elemIndices x
findIndex = BS.findIndex
findIndices x = fromList . BS.findIndices x
sequence = liftM fromList . P.sequence . toList
mapM func = liftM fromList . P.mapM func . toList
sort = BS.sort
groupBy f = fromList . BS.groupBy f
genericLength = fromInteger . fromIntegral . BS.length
genericTake i = BS.take (fromIntegral i)
genericDrop i = BS.drop (fromIntegral i)
genericSplitAt i = BS.splitAt (fromIntegral i)
genericReplicate i = BS.replicate (fromIntegral i)
instance ListLikeIO BS.ByteString Word8 where
hGetLine = BS.hGetLine
hGetContents = BS.hGetContents
hGet = BS.hGet
hGetNonBlocking = BS.hGetNonBlocking
hPutStr = BS.hPutStr
hPutStrLn = BSC.hPutStrLn
getLine = BS.getLine
getContents = BS.getContents
putStr = BS.putStr
putStrLn = BSC.putStrLn
interact = BS.interact
readFile = BS.readFile
writeFile = BS.writeFile
appendFile = BS.appendFile
#if 0
instance StringLike BS.ByteString where
toString = BSU.toString
#endif
instance FoldableLL BSL.ByteString Word8 where
foldl = BSL.foldl
foldl' = BSL.foldl'
foldl1 = BSL.foldl1
foldr = BSL.foldr
foldr1 = BSL.foldr1
mi64toi :: Maybe Int64 -> Maybe Int
mi64toi Nothing = Nothing
mi64toi (Just x) = Just (fromIntegral x)
instance IsList BSL.ByteString where
type Item BSL.ByteString = Word8
toList = BSL.unpack
fromList = BSL.pack
instance ListLike BSL.ByteString Word8 where
empty = BSL.empty
singleton = BSL.singleton
cons = BSL.cons
snoc = BSL.snoc
append = BSL.append
uncons = BSL.uncons
head = BSL.head
last = BSL.last
tail = BSL.tail
init = BSL.init
null = BSL.null
length = fromIntegral . BSL.length
rigidMap = BSL.map
reverse = BSL.reverse
concat = BSL.concat . toList
rigidConcatMap = BSL.concatMap
any = BSL.any
all = BSL.all
maximum = BSL.maximum
minimum = BSL.minimum
replicate i = BSL.replicate (fromIntegral i)
take i = BSL.take (fromIntegral i)
drop i = BSL.drop (fromIntegral i)
splitAt i = BSL.splitAt (fromIntegral i)
takeWhile = BSL.takeWhile
dropWhile = BSL.dropWhile
span = BSL.span
break = BSL.break
group = fromList . BSL.group
inits = fromList . BSL.inits
tails = fromList . BSL.tails
isPrefixOf = BSL.isPrefixOf
elem = BSL.elem
notElem = BSL.notElem
find = BSL.find
filter = BSL.filter
index l i = BSL.index l (fromIntegral i)
elemIndex i = mi64toi . BSL.elemIndex i
findIndex f = mi64toi . BSL.findIndex f
sequence = liftM fromList . P.sequence . toList
mapM func = liftM fromList . P.mapM func . toList
genericLength = fromInteger . fromIntegral . BSL.length
genericTake i = BSL.take (fromIntegral i)
genericDrop i = BSL.drop (fromIntegral i)
genericSplitAt i = BSL.splitAt (fromIntegral i)
genericReplicate i = BSL.replicate (fromIntegral i)
strict2lazy :: BS.ByteString -> IO BSL.ByteString
strict2lazy b = return (BSL.fromChunks [b])
instance ListLikeIO BSL.ByteString Word8 where
hGetLine h = BS.hGetLine h >>= strict2lazy
hGetContents = BSL.hGetContents
hGet = BSL.hGet
hGetNonBlocking = BSL.hGetNonBlocking
hPutStr = BSL.hPut
getLine = BS.getLine >>= strict2lazy
getContents = BSL.getContents
putStr = BSL.putStr
putStrLn = BSLC.putStrLn
interact = BSL.interact
readFile = BSL.readFile
writeFile = BSL.writeFile
appendFile = BSL.appendFile
#if 0
instance StringLike BSL.ByteString where
toString = BSLU.toString
#endif
instance Ix i => FoldableLL (A.Array i e) e where
foldl = F.foldl
foldl1 = F.foldl1
foldl' = F.foldl'
foldr = F.foldr
foldr1 = F.foldr1
foldr' = F.foldr'
instance (Integral i, Ix i) => Semigroup (A.Array i e) where
(<>) = mappend
instance (Integral i, Ix i) => Monoid (A.Array i e) where
mempty = A.listArray (0, -1) []
mappend l1 l2 =
A.array (blow, newbhigh)
(A.assocs l1 ++ zip [(bhigh + 1)..newbhigh] (A.elems l2))
where newlen = genericLength newelems
newelems = A.elems l2
newbhigh = bhigh + newlen
(blow, bhigh) = A.bounds l1
instance (Integral i, Ix i) => IsList (A.Array i e) where
type Item (A.Array i e) = e
toList = A.elems
fromList l = A.listArray (0, genericLength l - 1) l
instance (Integral i, Ix i) => ListLike (A.Array i e) e where
empty = mempty
singleton i = A.listArray (0, 0) [i]
cons i l =
(A.ixmap (blow - 1, bhigh) id l) // [(blow - 1, i)]
where (blow, bhigh) = A.bounds l
snoc l i =
(A.ixmap (blow, bhigh + 1) id l) // [(bhigh + 1, i)]
where (blow, bhigh) = A.bounds l
append = mappend
head l = l ! (fst (A.bounds l))
last l = l ! (snd (A.bounds l))
tail l = A.array (blow + 1, bhigh) (tail (A.assocs l))
where (blow, bhigh) = A.bounds l
init l = A.array (blow, bhigh - 1) (init (A.assocs l))
where (blow, bhigh) = A.bounds l
null l = genericLength l == (0::Integer)
length = genericLength
rigidMap = A.amap
reverse l = A.listArray (A.bounds l) (L.reverse (A.elems l))
any x = L.any x . A.elems
all x = L.all x . A.elems
maximum = L.maximum . A.elems
minimum = L.minimum . A.elems
replicate = genericReplicate
take = genericTake
drop = genericDrop
isPrefixOf l1 l2 = L.isPrefixOf (toList l1) (toList l2)
isSuffixOf l1 l2 = L.isSuffixOf (toList l1) (toList l2)
isInfixOf l1 l2 = L.isInfixOf (toList l1) (toList l2)
elem i l = L.elem i (toList l)
filter f = fromList . L.filter f . toList
index l i = l ! ((fromIntegral i) + offset)
where offset = (fst $ A.bounds l)
elemIndex i = L.elemIndex i . toList
elemIndices i = fromList . L.elemIndices i . toList
findIndex f = L.findIndex f . toList
findIndices f = fromList . L.findIndices f . toList
sequence = liftM fromList . P.sequence . toList
mapM func = liftM fromList . P.mapM func . toList
nub = fromList . L.nub . toList
sort l = A.listArray (A.bounds l) (L.sort (A.elems l))
nubBy f = fromList . L.nubBy f . toList
sortBy f l = A.listArray (A.bounds l) (L.sortBy f (A.elems l))
genericLength l = fromIntegral (bhigh - blow + 1)
where (blow, bhigh) = A.bounds l
genericTake count l
| count > genericLength l = l
| count <= 0 = empty
| otherwise = A.listArray (blow, blow + (fromIntegral count) - 1)
(L.genericTake count (A.elems l))
where (blow, _) = A.bounds l
genericDrop count l = A.listArray (blow + (fromIntegral count), bhigh)
(L.genericDrop count (A.elems l))
where (blow, bhigh) = A.bounds l
genericReplicate count i = A.listArray (0, (fromIntegral count) - 1)
(L.genericReplicate count i)
instance (Integral i, Ix i) => IsString (A.Array i Char) where
fromString = fromList
instance (Integral i, Ix i) => StringLike (A.Array i Char) where
toString = toList
instance (Integral i, Ix i) => ListLikeIO (A.Array i Char) Char where
hGetLine h = IO.hGetLine h >>= (return . fromList)
hGetContents h = IO.hGetContents h >>= (return . fromList)
hGet h i = ((hGet h i)::IO String) >>= (return . fromList)
hGetNonBlocking h i = ((hGetNonBlocking h i):: IO String) >>= (return . fromList)
hPutStr h = hPutStr h . toString
hPutStrLn h = hPutStrLn h . toString
getLine = IO.getLine >>= (return . fromString)
getContents = IO.getContents >>= (return . fromString)
putStr = IO.putStr . toString
putStrLn = IO.putStrLn . toString
instance ListLikeIO (S.Seq Char) Char where
hGetLine h = IO.hGetLine h >>= (return . fromList)
hGetContents h = IO.hGetContents h >>= (return . fromList)
hGet h i = ((hGet h i)::IO String) >>= (return . fromList)
hGetNonBlocking h i = ((hGetNonBlocking h i):: IO String) >>= (return . fromList)
hPutStr h = hPutStr h . toString
hPutStrLn h = hPutStrLn h . toString
getLine = IO.getLine >>= (return . fromString)
getContents = IO.getContents >>= (return . fromString)
putStr = IO.putStr . toString
putStrLn = IO.putStrLn . toString
#if !MIN_VERSION_containers(0,5,7)
instance IsString (S.Seq Char) where
fromString = S.fromList
#endif
instance StringLike (S.Seq Char) where
toString = toList
instance FoldableLL (S.Seq a) a where
foldl = F.foldl
foldl' = F.foldl'
foldl1 = F.foldl1
foldr = F.foldr
foldr' = F.foldr'
foldr1 = F.foldr1
instance ListLike (S.Seq a) a where
empty = S.empty
singleton = S.singleton
cons = (<|)
snoc = (|>)
append = (><)
head s = let (a S.:< _) = S.viewl s in a
last s = let (_ S.:> a) = S.viewr s in a
tail s = S.index (S.tails s) 1
init s = S.index (S.inits s) (S.length s - 1)
null = S.null
length = S.length
map f = fromList . toList . fmap f
reverse = S.reverse
any = F.any
all = F.all
maximum = F.maximum
minimum = F.minimum
replicate n = S.replicate (if n >= 0 then n else 0)
take = S.take
drop = S.drop
splitAt = S.splitAt
span = S.spanl
inits = fromList . toList . S.inits
tails = fromList . toList . S.tails
filter = S.filter
partition = S.partition
index = S.index
elemIndex = S.elemIndexL
elemIndices p = fromList . S.elemIndicesL p
findIndex = S.findIndexL
findIndices p = fromList . S.findIndicesL p
sort = S.sort
sortBy = S.sortBy
genericLength = fromInteger . fromIntegral . S.length
genericTake i = S.take (fromIntegral i)
genericDrop i = S.drop (fromIntegral i)
genericSplitAt i = S.splitAt (fromIntegral i)
genericReplicate i = S.replicate (fromIntegral i)