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 Data.List as L
import Data.ListLike.Base
import Data.ListLike.String
import Data.ListLike.IO
import Data.ListLike.FoldableLL
import Data.Int
import Data.Monoid
import qualified Data.ByteString as BS
import qualified Data.Foldable as F
import qualified Data.Array.IArray as A
import Data.Array.IArray((!), (//), Ix(..))
import qualified Data.ByteString.Lazy as BSL
import qualified System.IO as IO
import Data.Word
import qualified Data.Map as Map
instance ListLikeIO String Char where
hGetLine = IO.hGetLine
hGetContents = IO.hGetContents
hGet h c = BSL.hGet h c >>= (return . toString)
hGetNonBlocking h i = BSL.hGetNonBlocking h i >>= (return . toString)
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
fromString = 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 ListLike BS.ByteString Word8 where
empty = BS.empty
singleton = BS.singleton
cons = BS.cons
snoc = BS.snoc
append = BS.append
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
sort = BS.sort
toList = BS.unpack
fromList = BS.pack
fromListLike = fromList . toList
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 = BS.hPutStrLn
getLine = BS.getLine
getContents = BS.getContents
putStr = BS.putStr
putStrLn = BS.putStrLn
interact = BS.interact
readFile = BS.readFile
writeFile = BS.writeFile
appendFile = BS.appendFile
instance StringLike BS.ByteString where
toString = map (toEnum . fromIntegral) . BS.unpack
fromString = BS.pack . map (fromIntegral . fromEnum)
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 ListLike BSL.ByteString Word8 where
empty = BSL.empty
singleton = BSL.singleton
cons = BSL.cons
snoc = BSL.snoc
append = BSL.append
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
toList = BSL.unpack
fromList = BSL.pack
fromListLike = fromList . 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 = BSL.putStrLn
interact = BSL.interact
readFile = BSL.readFile
writeFile = BSL.writeFile
appendFile = BSL.appendFile
instance StringLike BSL.ByteString where
toString = map (toEnum . fromIntegral) . BSL.unpack
fromString = BSL.pack . map (fromIntegral . fromEnum)
instance (Ord key) => FoldableLL (Map.Map key val) (key, val) where
foldr f start m = Map.foldWithKey func start m
where func k v accum = f (k, v) accum
foldl f start m = L.foldl f start (Map.toList m)
l2m :: (Ord k, Ord k2) => ([(k, v)], [(k2, v2)]) -> (Map.Map k v, Map.Map k2 v2)
l2m (l1, l2) = (Map.fromList l1, Map.fromList l2)
instance (Ord key, Eq val) => ListLike (Map.Map key val) (key, val) where
empty = Map.empty
singleton (k, v) = Map.singleton k v
cons (k, v) m = Map.insert k v m
snoc = flip cons
append = Map.union
head = Map.elemAt 0
last m = Map.elemAt (Map.size m 1) m
tail = drop 1
init = Map.fromAscList . L.init . Map.toAscList
null = Map.null
length = Map.size
map f = fromList . map f . Map.toList
rigidMap f = Map.fromList . L.map f . Map.toList
reverse = id
intersperse i f
| Map.size f <= 1 = f
| otherwise = cons i f
replicate = genericReplicate
take n = Map.fromAscList . L.take n . Map.toAscList
drop n = Map.fromAscList . L.drop n . Map.toAscList
splitAt n = l2m . L.splitAt n . Map.toList
takeWhile f = Map.fromAscList . L.takeWhile f . Map.toAscList
dropWhile f = Map.fromAscList . L.dropWhile f . Map.toAscList
span f = l2m . L.span f . Map.toList
break f = span (not . f)
group m
| null m = empty
| otherwise = cons (singleton (head m)) (group (tail m))
isPrefixOf f1 f2 = L.isPrefixOf (Map.toList f1) (Map.toList f2)
isSuffixOf f1 f2 = L.isSuffixOf (Map.toList f1) (Map.toList f2)
isInfixOf = Map.isSubmapOf
filter f m = Map.filterWithKey func m
where func k v = f (k, v)
index = flip Map.elemAt
elemIndex (k, v) m =
case Map.lookupIndex k m of
Nothing -> fail "elemIndex: no matching key"
Just i -> if snd (Map.elemAt i m) == v
then Just i
else fail "elemIndex on Map: matched key but not value"
elemIndices i m =
case elemIndex i m of
Nothing -> empty
Just x -> singleton x
nub = id
delete (k, v) m =
case Map.lookup k m of
Nothing -> m
Just x -> if x == v
then Map.delete k m
else m
union = Map.union
sort = id
insert = cons
toList = Map.toList
fromList = Map.fromList
nubBy func = Map.fromAscList . L.nubBy func . Map.toAscList
--deleteBy
deleteFirstsBy func m1 m2 = Map.fromAscList $
L.deleteFirstsBy func (Map.toAscList m1)
(Map.toAscList m2)
--deleteFirstsBy
unionBy func m1 m2 = Map.fromList $
L.unionBy func (Map.toList m1) (Map.toList m2)
--intersectBy
--groupBy
sortBy _ = id
insertBy _ = insert
genericLength = fromIntegral . Map.size
genericTake n = Map.fromAscList . L.genericTake n . Map.toAscList
genericDrop n = Map.fromAscList . L.genericDrop n . Map.toAscList
genericSplitAt n = l2m . L.genericSplitAt n . Map.toList
genericReplicate count item
| count <= 0 = empty
| otherwise = singleton item
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) => 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) => 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
nub = fromList . L.nub . toList
sort l = A.listArray (A.bounds l) (L.sort (A.elems l))
toList = A.elems
fromList l = A.listArray (0, genericLength l 1) 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) => StringLike (A.Array i Char) where
toString = toList
fromString = fromList
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