{-# LANGUAGE CPP
            ,MultiParamTypeClasses
            ,FlexibleInstances
            ,TypeFamilies
            ,TypeSynonymInstances #-}
{-# OPTIONS -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ > 901
{-# OPTIONS -fno-warn-incomplete-uni-patterns #-}
#endif

{-
Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file COPYRIGHT

-}

{- |
   Module     : Data.ListLike.Instances
   Copyright  : Copyright (C) 2007 John Goerzen
   License    : BSD3

   Maintainer : David Fox <dsf@seereason.com>, Andreas Abel
   Stability  : stable
   Portability: portable

Instances of 'Data.ListLike.ListLike' and related classes.
Re-exported by "Data.ListLike".

Written by John Goerzen, jgoerzen\@complete.org
-}

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 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
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup (Semigroup(..))
#endif
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
--import qualified Data.Foldable as F
--import qualified Data.Traversable as T
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)
--import           Data.String.UTF8 (UTF8)
--import qualified Data.String.UTF8 as UTF8
import qualified System.IO as IO
import           Data.Word
import           GHC.Exts (IsList(..))

--------------------------------------------------
-- []

-- Basic list instance is in Base.hs
-- FoldableLL instance implied by Foldable

instance ListLikeIO String Char where
    hGetLine :: Handle -> IO String
hGetLine = Handle -> IO String
IO.hGetLine
    hGetContents :: Handle -> IO String
hGetContents = Handle -> IO String
IO.hGetContents
    hGet :: Handle -> Int -> IO String
hGet Handle
_ Int
c | Int
c forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    hGet Handle
h Int
c = forall full item. ListLike full item => item -> full -> full
cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Char
IO.hGetChar Handle
h forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall full item. ListLikeIO full item => Handle -> Int -> IO full
hGet Handle
h (forall a. Enum a => a -> a
pred Int
c)
    -- hGetNonBlocking h i >>= (return . toString)
    hGetNonBlocking :: Handle -> Int -> IO String
hGetNonBlocking Handle
_h Int
_i = forall a. HasCallStack => String -> a
error String
"Unimplemented: hGetNonBlocking in instance ListLikeIO String Char"
    hPutStr :: Handle -> String -> IO ()
hPutStr = Handle -> String -> IO ()
IO.hPutStr
    hPutStrLn :: Handle -> String -> IO ()
hPutStrLn = Handle -> String -> IO ()
IO.hPutStrLn
    getLine :: IO String
getLine = IO String
IO.getLine
    getContents :: IO String
getContents = IO String
IO.getContents
    putStr :: String -> IO ()
putStr = String -> IO ()
IO.putStr
    putStrLn :: String -> IO ()
putStrLn = String -> IO ()
IO.putStrLn
    interact :: (String -> String) -> IO ()
interact = (String -> String) -> IO ()
IO.interact
    readFile :: String -> IO String
readFile = String -> IO String
IO.readFile
    writeFile :: String -> String -> IO ()
writeFile = String -> String -> IO ()
IO.writeFile

{-
import           Data.ByteString.Internal (createAndTrim)
import qualified System.IO.Error as IO

hGetNonBlocking :: IO.Handle -> Int -> IO BS.ByteString
hGetNonBlocking h i
    | i >  0    = createAndTrim i $ \p -> IO.hGetBufNonBlocking h p i
    | i == 0    = return empty
    | otherwise = illegalBufferSize h "hGetNonBlocking'" i

illegalBufferSize :: IO.Handle -> String -> Int -> IO a
illegalBufferSize handle fn sz =
    ioError (IO.mkIOError IO.illegalOperationErrorType msg (Just handle) Nothing)
    --TODO: System.IO uses InvalidArgument here, but it's not exported :-(
    where
      msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []
-}

instance StringLike String where
    toString :: String -> String
toString = forall a. a -> a
id
    --fromString = id

instance InfiniteListLike [a] a where
    iterate :: (a -> a) -> a -> [a]
iterate = forall a. (a -> a) -> a -> [a]
L.iterate
    repeat :: a -> [a]
repeat = forall a. a -> [a]
L.repeat
    cycle :: [a] -> [a]
cycle = forall a. [a] -> [a]
L.cycle

--------------------------------------------------
-- ByteString

instance FoldableLL BS.ByteString Word8 where
    foldl :: forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl
    foldl' :: forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl'
    foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 = HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BS.foldl1
    foldr :: forall b. (Word8 -> b -> b) -> b -> ByteString -> b
foldr = forall b. (Word8 -> b -> b) -> b -> ByteString -> b
BS.foldr
    foldr' :: forall b. (Word8 -> b -> b) -> b -> ByteString -> b
foldr' = forall b. (Word8 -> b -> b) -> b -> ByteString -> b
BS.foldr'
    foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1 = HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BS.foldr1

#if !MIN_VERSION_bytestring(0,10,12)
instance IsList BS.ByteString where
    type Item BS.ByteString = Word8
    toList = BS.unpack
    fromList = BS.pack
#endif

instance ListLike BS.ByteString Word8 where
    empty :: ByteString
empty = ByteString
BS.empty
    singleton :: Word8 -> ByteString
singleton = Word8 -> ByteString
BS.singleton
    cons :: Word8 -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
BS.cons
    snoc :: ByteString -> Word8 -> ByteString
snoc = ByteString -> Word8 -> ByteString
BS.snoc
    append :: ByteString -> ByteString -> ByteString
append = ByteString -> ByteString -> ByteString
BS.append
    uncons :: ByteString -> Maybe (Word8, ByteString)
uncons = ByteString -> Maybe (Word8, ByteString)
BS.uncons
    head :: ByteString -> Word8
head = HasCallStack => ByteString -> Word8
BS.head
    last :: ByteString -> Word8
last = HasCallStack => ByteString -> Word8
BS.last
    tail :: ByteString -> ByteString
tail = HasCallStack => ByteString -> ByteString
BS.tail
    init :: ByteString -> ByteString
init = HasCallStack => ByteString -> ByteString
BS.init
    null :: ByteString -> Bool
null = ByteString -> Bool
BS.null
    length :: ByteString -> Int
length = ByteString -> Int
BS.length
    -- map =
    rigidMap :: (Word8 -> Word8) -> ByteString -> ByteString
rigidMap = (Word8 -> Word8) -> ByteString -> ByteString
BS.map
    reverse :: ByteString -> ByteString
reverse = ByteString -> ByteString
BS.reverse
    intersperse :: Word8 -> ByteString -> ByteString
intersperse = Word8 -> ByteString -> ByteString
BS.intersperse
    concat :: forall full'. ListLike full' ByteString => full' -> ByteString
concat = [ByteString] -> ByteString
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    --concatMap =
    rigidConcatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
rigidConcatMap = (Word8 -> ByteString) -> ByteString -> ByteString
BS.concatMap
    any :: (Word8 -> Bool) -> ByteString -> Bool
any = (Word8 -> Bool) -> ByteString -> Bool
BS.any
    all :: (Word8 -> Bool) -> ByteString -> Bool
all = (Word8 -> Bool) -> ByteString -> Bool
BS.all
    maximum :: Ord Word8 => ByteString -> Word8
maximum = HasCallStack => ByteString -> Word8
BS.maximum
    minimum :: Ord Word8 => ByteString -> Word8
minimum = HasCallStack => ByteString -> Word8
BS.minimum
    replicate :: Int -> Word8 -> ByteString
replicate = Int -> Word8 -> ByteString
BS.replicate
    take :: Int -> ByteString -> ByteString
take = Int -> ByteString -> ByteString
BS.take
    drop :: Int -> ByteString -> ByteString
drop = Int -> ByteString -> ByteString
BS.drop
    splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt
    takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile = (Word8 -> Bool) -> ByteString -> ByteString
BS.takeWhile
    dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile
    span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
span = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span
    break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break
    group :: forall full'.
(ListLike full' ByteString, Eq Word8) =>
ByteString -> full'
group = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.group
    inits :: forall full'. ListLike full' ByteString => ByteString -> full'
inits = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.inits
    tails :: forall full'. ListLike full' ByteString => ByteString -> full'
tails = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.tails
    isPrefixOf :: Eq Word8 => ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
BS.isPrefixOf
    isSuffixOf :: Eq Word8 => ByteString -> ByteString -> Bool
isSuffixOf = ByteString -> ByteString -> Bool
BS.isSuffixOf
    --isInfixOf = BS.isInfixOf
    elem :: Eq Word8 => Word8 -> ByteString -> Bool
elem = Word8 -> ByteString -> Bool
BS.elem
    notElem :: Eq Word8 => Word8 -> ByteString -> Bool
notElem = Word8 -> ByteString -> Bool
BS.notElem
    find :: (Word8 -> Bool) -> ByteString -> Maybe Word8
find = (Word8 -> Bool) -> ByteString -> Maybe Word8
BS.find
    filter :: (Word8 -> Bool) -> ByteString -> ByteString
filter = (Word8 -> Bool) -> ByteString -> ByteString
BS.filter
    --partition = BS.partition
    index :: ByteString -> Int -> Word8
index = HasCallStack => ByteString -> Int -> Word8
BS.index
    elemIndex :: Eq Word8 => Word8 -> ByteString -> Maybe Int
elemIndex = Word8 -> ByteString -> Maybe Int
BS.elemIndex
    elemIndices :: forall result.
(Eq Word8, ListLike result Int) =>
Word8 -> ByteString -> result
elemIndices Word8
x = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [Int]
BS.elemIndices Word8
x
    findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex = (Word8 -> Bool) -> ByteString -> Maybe Int
BS.findIndex
    findIndices :: forall result.
ListLike result Int =>
(Word8 -> Bool) -> ByteString -> result
findIndices Word8 -> Bool
x = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> [Int]
BS.findIndices Word8 -> Bool
x
    -- the default definitions don't work well for array-like things, so
    -- do monadic stuff via a list instead
    sequence :: forall (m :: * -> *) fullinp.
(Applicative m, ListLike fullinp (m Word8)) =>
fullinp -> m ByteString
sequence  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
P.sequenceA  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    mapM :: forall (m :: * -> *) full' item'.
(Applicative m, ListLike full' item') =>
(Word8 -> m item') -> ByteString -> m full'
mapM Word8 -> m item'
func = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
P.traverse Word8 -> m item'
func forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    --nub = BS.nub
    --delete = BS.delete
    --deleteFirsts = BS.deleteFirsts
    --union = BS.union
    --intersect = BS.intersect
    sort :: Ord Word8 => ByteString -> ByteString
sort = ByteString -> ByteString
BS.sort
    --insert = BS.insert
    --fromListLike = fromList . toList
    --nubBy = BS.nubBy
    --deleteBy = BS.deleteBy
    --deleteFirstsBy = BS.deleteFirstsBy
    --unionBy = BS.unionBy
    --intersectBy = BS.intersectBy
    groupBy :: forall full'.
(ListLike full' ByteString, Eq Word8) =>
(Word8 -> Word8 -> Bool) -> ByteString -> full'
groupBy Word8 -> Word8 -> Bool
f = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
BS.groupBy Word8 -> Word8 -> Bool
f
    --sortBy = BS.sortBy
    --insertBy = BS.insertBy
    genericLength :: forall a. Num a => ByteString -> a
genericLength = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length
    genericTake :: forall a. Integral a => a -> ByteString -> ByteString
genericTake a
i = Int -> ByteString -> ByteString
BS.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericDrop :: forall a. Integral a => a -> ByteString -> ByteString
genericDrop a
i = Int -> ByteString -> ByteString
BS.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericSplitAt :: forall a. Integral a => a -> ByteString -> (ByteString, ByteString)
genericSplitAt a
i = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericReplicate :: forall a. Integral a => a -> Word8 -> ByteString
genericReplicate a
i = Int -> Word8 -> ByteString
BS.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)

instance ListLikeIO BS.ByteString Word8 where
    hGetLine :: Handle -> IO ByteString
hGetLine = Handle -> IO ByteString
BSC.hGetLine
    hGetContents :: Handle -> IO ByteString
hGetContents = Handle -> IO ByteString
BS.hGetContents
    hGet :: Handle -> Int -> IO ByteString
hGet = Handle -> Int -> IO ByteString
BS.hGet
    hGetNonBlocking :: Handle -> Int -> IO ByteString
hGetNonBlocking = Handle -> Int -> IO ByteString
BS.hGetNonBlocking
    hPutStr :: Handle -> ByteString -> IO ()
hPutStr = Handle -> ByteString -> IO ()
BS.hPutStr
    hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn = Handle -> ByteString -> IO ()
BSC.hPutStrLn
    getLine :: IO ByteString
getLine = IO ByteString
BSC.getLine
    getContents :: IO ByteString
getContents = IO ByteString
BS.getContents
    putStr :: ByteString -> IO ()
putStr = ByteString -> IO ()
BS.putStr
    putStrLn :: ByteString -> IO ()
putStrLn = ByteString -> IO ()
BSC.putStrLn
    interact :: (ByteString -> ByteString) -> IO ()
interact = (ByteString -> ByteString) -> IO ()
BS.interact
    readFile :: String -> IO ByteString
readFile = String -> IO ByteString
BS.readFile
    writeFile :: String -> ByteString -> IO ()
writeFile = String -> ByteString -> IO ()
BS.writeFile
    appendFile :: String -> ByteString -> IO ()
appendFile = String -> ByteString -> IO ()
BS.appendFile

-- There is no bijection between Strings and ByteStrings that I know
-- of.  The elements of a String are Unicode code points, and while
-- every String can be UTF8-encoded into a ByteString, there are
-- ByteStrings that can not be decoded into valid Strings - notably
-- "\128".  So should ByteString be an instance of StringLike?
-- Probably not.  Unfortunately, this instance is used to implement
-- the ListLikeIO instance for String!  This must not stand.
#if 0
instance StringLike BS.ByteString where
    toString = BSU.toString
    --fromString = BSU.fromString
#endif

--------------------------------------------------
-- ByteString.Lazy

instance FoldableLL BSL.ByteString Word8 where
    foldl :: forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BSL.foldl
    foldl' :: forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BSL.foldl'
    foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 = HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BSL.foldl1
    foldr :: forall b. (Word8 -> b -> b) -> b -> ByteString -> b
foldr = forall b. (Word8 -> b -> b) -> b -> ByteString -> b
BSL.foldr
    --foldr' = BSL.foldr'
    foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1 = HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BSL.foldr1

mi64toi :: Maybe Int64 -> Maybe Int
mi64toi :: Maybe Int64 -> Maybe Int
mi64toi Maybe Int64
Nothing = forall a. Maybe a
Nothing
mi64toi (Just Int64
x) = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)

#if !MIN_VERSION_bytestring(0,10,12)
instance IsList BSL.ByteString where
    type Item BSL.ByteString = Word8
    toList = BSL.unpack
    fromList = BSL.pack
#endif

instance ListLike BSL.ByteString Word8 where
    empty :: ByteString
empty = ByteString
BSL.empty
    singleton :: Word8 -> ByteString
singleton = Word8 -> ByteString
BSL.singleton
    cons :: Word8 -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
BSL.cons
    snoc :: ByteString -> Word8 -> ByteString
snoc = ByteString -> Word8 -> ByteString
BSL.snoc
    append :: ByteString -> ByteString -> ByteString
append = ByteString -> ByteString -> ByteString
BSL.append
    uncons :: ByteString -> Maybe (Word8, ByteString)
uncons = ByteString -> Maybe (Word8, ByteString)
BSL.uncons
    head :: ByteString -> Word8
head = HasCallStack => ByteString -> Word8
BSL.head
    last :: ByteString -> Word8
last = HasCallStack => ByteString -> Word8
BSL.last
    tail :: ByteString -> ByteString
tail = HasCallStack => ByteString -> ByteString
BSL.tail
    init :: ByteString -> ByteString
init = HasCallStack => ByteString -> ByteString
BSL.init
    null :: ByteString -> Bool
null = ByteString -> Bool
BSL.null
    length :: ByteString -> Int
length = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length
    -- map = BSL.map
    rigidMap :: (Word8 -> Word8) -> ByteString -> ByteString
rigidMap = (Word8 -> Word8) -> ByteString -> ByteString
BSL.map
    reverse :: ByteString -> ByteString
reverse = ByteString -> ByteString
BSL.reverse
    --intersperse = BSL.intersperse
    concat :: forall full'. ListLike full' ByteString => full' -> ByteString
concat = [ByteString] -> ByteString
BSL.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    --concatMap = BSL.concatMap
    rigidConcatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
rigidConcatMap = (Word8 -> ByteString) -> ByteString -> ByteString
BSL.concatMap
    any :: (Word8 -> Bool) -> ByteString -> Bool
any = (Word8 -> Bool) -> ByteString -> Bool
BSL.any
    all :: (Word8 -> Bool) -> ByteString -> Bool
all = (Word8 -> Bool) -> ByteString -> Bool
BSL.all
    maximum :: Ord Word8 => ByteString -> Word8
maximum = HasCallStack => ByteString -> Word8
BSL.maximum
    minimum :: Ord Word8 => ByteString -> Word8
minimum = HasCallStack => ByteString -> Word8
BSL.minimum
    replicate :: Int -> Word8 -> ByteString
replicate Int
i = Int64 -> Word8 -> ByteString
BSL.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    take :: Int -> ByteString -> ByteString
take Int
i = Int64 -> ByteString -> ByteString
BSL.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    drop :: Int -> ByteString -> ByteString
drop Int
i = Int64 -> ByteString -> ByteString
BSL.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt Int
i = Int64 -> ByteString -> (ByteString, ByteString)
BSL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile = (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile
    dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile = (Word8 -> Bool) -> ByteString -> ByteString
BSL.dropWhile
    span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
span = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BSL.span
    break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BSL.break
    group :: forall full'.
(ListLike full' ByteString, Eq Word8) =>
ByteString -> full'
group = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.group
    inits :: forall full'. ListLike full' ByteString => ByteString -> full'
inits = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.inits
    tails :: forall full'. ListLike full' ByteString => ByteString -> full'
tails = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.tails
    isPrefixOf :: Eq Word8 => ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
BSL.isPrefixOf
    --isSuffixOf = BSL.isSuffixOf
    --isInfixOf = BSL.isInfixOf
    elem :: Eq Word8 => Word8 -> ByteString -> Bool
elem = Word8 -> ByteString -> Bool
BSL.elem
    notElem :: Eq Word8 => Word8 -> ByteString -> Bool
notElem = Word8 -> ByteString -> Bool
BSL.notElem
    find :: (Word8 -> Bool) -> ByteString -> Maybe Word8
find = (Word8 -> Bool) -> ByteString -> Maybe Word8
BSL.find
    filter :: (Word8 -> Bool) -> ByteString -> ByteString
filter = (Word8 -> Bool) -> ByteString -> ByteString
BSL.filter
    --partition = BSL.partition
    index :: ByteString -> Int -> Word8
index ByteString
l Int
i = HasCallStack => ByteString -> Int64 -> Word8
BSL.index ByteString
l (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    elemIndex :: Eq Word8 => Word8 -> ByteString -> Maybe Int
elemIndex Word8
i = Maybe Int64 -> Maybe Int
mi64toi forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> Maybe Int64
BSL.elemIndex Word8
i
    --elemIndices x = fromList . L.map fromIntegral . BSL.elemIndices x
    findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex Word8 -> Bool
f = Maybe Int64 -> Maybe Int
mi64toi forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> Maybe Int64
BSL.findIndex Word8 -> Bool
f
    --findIndices x = fromList . L.map fromIntegral . BSL.findIndices x
    sequence :: forall (m :: * -> *) fullinp.
(Applicative m, ListLike fullinp (m Word8)) =>
fullinp -> m ByteString
sequence  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
P.sequenceA  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    mapM :: forall (m :: * -> *) full' item'.
(Applicative m, ListLike full' item') =>
(Word8 -> m item') -> ByteString -> m full'
mapM Word8 -> m item'
func = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
P.traverse Word8 -> m item'
func forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    --sequence = BSL.sequence
    --mapM = BSL.mapM
    --mapM_ = BSL.mapM_
    --nub = BSL.nub
    --delete = BSL.delete
    --deleteFirsts = BSL.deleteFirsts
    --union = BSL.union
    --intersect = BSL.intersect
    --sort = BSL.sort
    --insert = BSL.insert
    --fromListLike = fromList . toList
    --nubBy = BSL.nubBy
    --deleteBy = BSL.deleteBy
    --deleteFirstsBy = BSL.deleteFirstsBy
    --unionBy = BSL.unionBy
    --intersectBy = BSL.intersectBy
    -- BSL.groupBy is broken. groupBy f = fromList . BSL.groupBy f
    -- the below works on ghc but generates a type error on hugs
    -- groupBy func = map fromList . L.groupBy func . toList
    --sortBy = BSL.sortBy
    --insertBy = BSL.insertBy
    genericLength :: forall a. Num a => ByteString -> a
genericLength = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length
    genericTake :: forall a. Integral a => a -> ByteString -> ByteString
genericTake a
i = Int64 -> ByteString -> ByteString
BSL.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericDrop :: forall a. Integral a => a -> ByteString -> ByteString
genericDrop a
i = Int64 -> ByteString -> ByteString
BSL.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericSplitAt :: forall a. Integral a => a -> ByteString -> (ByteString, ByteString)
genericSplitAt a
i = Int64 -> ByteString -> (ByteString, ByteString)
BSL.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericReplicate :: forall a. Integral a => a -> Word8 -> ByteString
genericReplicate a
i = Int64 -> Word8 -> ByteString
BSL.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)

strict2lazy :: BS.ByteString -> IO BSL.ByteString
strict2lazy :: ByteString -> IO ByteString
strict2lazy ByteString
b = forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BSL.fromChunks [ByteString
b])
instance ListLikeIO BSL.ByteString Word8 where
    hGetLine :: Handle -> IO ByteString
hGetLine Handle
h = Handle -> IO ByteString
BSC.hGetLine Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO ByteString
strict2lazy
    hGetContents :: Handle -> IO ByteString
hGetContents = Handle -> IO ByteString
BSL.hGetContents
    hGet :: Handle -> Int -> IO ByteString
hGet = Handle -> Int -> IO ByteString
BSL.hGet
    hGetNonBlocking :: Handle -> Int -> IO ByteString
hGetNonBlocking = Handle -> Int -> IO ByteString
BSL.hGetNonBlocking
    hPutStr :: Handle -> ByteString -> IO ()
hPutStr = Handle -> ByteString -> IO ()
BSL.hPut
    -- hPutStrLn = BSLC.hPutStrLn
    getLine :: IO ByteString
getLine = IO ByteString
BSC.getLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO ByteString
strict2lazy
    getContents :: IO ByteString
getContents = IO ByteString
BSL.getContents
    putStr :: ByteString -> IO ()
putStr = ByteString -> IO ()
BSL.putStr
    putStrLn :: ByteString -> IO ()
putStrLn = ByteString -> IO ()
BSLC.putStrLn
    interact :: (ByteString -> ByteString) -> IO ()
interact = (ByteString -> ByteString) -> IO ()
BSL.interact
    readFile :: String -> IO ByteString
readFile = String -> IO ByteString
BSL.readFile
    writeFile :: String -> ByteString -> IO ()
writeFile = String -> ByteString -> IO ()
BSL.writeFile
    appendFile :: String -> ByteString -> IO ()
appendFile = String -> ByteString -> IO ()
BSL.appendFile

#if 0
instance StringLike BSL.ByteString where
    toString = BSLU.toString
    --fromString = BSLU.fromString
#endif

--------------------------------------------------
-- Map
-- N.B. the Map instance is broken because it treats the key as part of the
-- element.  Consider:
--  let m = fromList [(False,0)] :: Map Bool Int
--  let m' = cons (False, 1) m
--  m' == fromList [(False,1)] =/= [(False,1), (False,0)]
--  Map isn't a suitable candidate for ListLike...


--------------------------------------------------
-- Arrays

-- This constraint is required for ghc < 8
instance Ix i => FoldableLL (A.Array i e) e where
    foldl :: forall a. (a -> e -> a) -> a -> Array i e -> a
foldl = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl
    foldl1 :: (e -> e -> e) -> Array i e -> e
foldl1 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldl1
    foldl' :: forall a. (a -> e -> a) -> a -> Array i e -> a
foldl' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'
    foldr :: forall b. (e -> b -> b) -> b -> Array i e -> b
foldr = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr
    foldr1 :: (e -> e -> e) -> Array i e -> e
foldr1 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldr1
    foldr' :: forall b. (e -> b -> b) -> b -> Array i e -> b
foldr' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr'

instance (Integral i, Ix i) => Semigroup (A.Array i e) where
  Array i e
l1 <> :: Array i e -> Array i e -> Array i e
<> Array i e
l2 = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (i
blow, i
newbhigh) forall a b. (a -> b) -> a -> b
$
               forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
A.assocs Array i e
l1 forall a. [a] -> [a] -> [a]
++ forall full item fullb itemb result.
(ListLike full item, ListLike fullb itemb,
 ListLike result (item, itemb)) =>
full -> fullb -> result
zip [i
bhigh forall a. Num a => a -> a -> a
+ i
1 .. i
newbhigh] (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Array i e
l2)
    where
    newlen :: i
newlen        = forall full item a. (ListLike full item, Num a) => full -> a
genericLength [e]
newelems
    newelems :: [e]
newelems      = forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Array i e
l2
    newbhigh :: i
newbhigh      = i
bhigh forall a. Num a => a -> a -> a
+ i
newlen
    (i
blow, i
bhigh) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l1

instance (Integral i, Ix i) => Monoid (A.Array i e) where
  mempty :: Array i e
mempty  = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (i
0, -i
1) []
  mappend :: Array i e -> Array i e -> Array i e
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance (Integral i, Ix i) => IsList (A.Array i e) where
    type Item (A.Array i e) = e
    toList :: Array i e -> [Item (Array i e)]
toList = forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems
    fromList :: [Item (Array i e)] -> Array i e
fromList [Item (Array i e)]
l = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (i
0, forall full item a. (ListLike full item, Num a) => full -> a
genericLength [Item (Array i e)]
l forall a. Num a => a -> a -> a
- i
1) [Item (Array i e)]
l

instance (Integral i, Ix i) => ListLike (A.Array i e) e where
    empty :: Array i e
empty = forall a. Monoid a => a
mempty
    singleton :: e -> Array i e
singleton e
i = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (i
0, i
0) [e
i]
    cons :: e -> Array i e -> Array i e
cons e
i Array i e
l =
        -- To add something to the beginning of an array, we must
        -- change the bounds and set the first element.
        (forall (a :: * -> * -> *) e i j.
(IArray a e, Ix i, Ix j) =>
(i, i) -> (i -> j) -> a j e -> a i e
A.ixmap (i
blow forall a. Num a => a -> a -> a
- i
1, i
bhigh) forall a. a -> a
id Array i e
l) forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [(i
blow forall a. Num a => a -> a -> a
- i
1, e
i)]
        where (i
blow, i
bhigh) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l
    snoc :: Array i e -> e -> Array i e
snoc Array i e
l e
i =
        -- Here we must change the bounds and set the last element
        (forall (a :: * -> * -> *) e i j.
(IArray a e, Ix i, Ix j) =>
(i, i) -> (i -> j) -> a j e -> a i e
A.ixmap (i
blow, i
bhigh forall a. Num a => a -> a -> a
+ i
1) forall a. a -> a
id Array i e
l) forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [(i
bhigh forall a. Num a => a -> a -> a
+ i
1, e
i)]
        where (i
blow, i
bhigh) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l
    append :: Array i e -> Array i e -> Array i e
append = forall a. Monoid a => a -> a -> a
mappend
    head :: Array i e -> e
head Array i e
l = Array i e
l forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (forall a b. (a, b) -> a
fst (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l))
    last :: Array i e -> e
last Array i e
l = Array i e
l forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (forall a b. (a, b) -> b
snd (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l))
    tail :: Array i e -> Array i e
tail Array i e
l = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (i
blow forall a. Num a => a -> a -> a
+ i
1, i
bhigh) (forall full item. ListLike full item => full -> full
tail (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
A.assocs Array i e
l))
            where (i
blow, i
bhigh) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l
    init :: Array i e -> Array i e
init Array i e
l = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (i
blow, i
bhigh forall a. Num a => a -> a -> a
- i
1) (forall full item. ListLike full item => full -> full
init (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
A.assocs Array i e
l))
            where (i
blow, i
bhigh) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l
    null :: Array i e -> Bool
null Array i e
l = forall full item a. (ListLike full item, Num a) => full -> a
genericLength Array i e
l forall a. Eq a => a -> a -> Bool
== (Integer
0::Integer)
    length :: Array i e -> Int
length = forall full item a. (ListLike full item, Num a) => full -> a
genericLength
    -- map
    rigidMap :: (e -> e) -> Array i e -> Array i e
rigidMap = forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
A.amap
    reverse :: Array i e -> Array i e
reverse Array i e
l = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l) (forall a. [a] -> [a]
L.reverse (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Array i e
l))
    -- intersperse
    -- concat
    -- concatMap
    -- rigidConcatMap
    any :: (e -> Bool) -> Array i e -> Bool
any e -> Bool
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any e -> Bool
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems
    all :: (e -> Bool) -> Array i e -> Bool
all e -> Bool
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.all e -> Bool
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems
    maximum :: Ord e => Array i e -> e
maximum = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
L.maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems
    minimum :: Ord e => Array i e -> e
minimum = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
L.minimum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems
    replicate :: Int -> e -> Array i e
replicate = forall full item a.
(ListLike full item, Integral a) =>
a -> item -> full
genericReplicate
    take :: Int -> Array i e -> Array i e
take = forall full item a.
(ListLike full item, Integral a) =>
a -> full -> full
genericTake
    drop :: Int -> Array i e -> Array i e
drop = forall full item a.
(ListLike full item, Integral a) =>
a -> full -> full
genericDrop
    -- splitAt
    -- takeWhile
    -- dropWhile
    -- span
    -- break
    -- group
    -- inits
    -- tails
    isPrefixOf :: Eq e => Array i e -> Array i e -> Bool
isPrefixOf Array i e
l1 Array i e
l2 = forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf (forall l. IsList l => l -> [Item l]
toList Array i e
l1) (forall l. IsList l => l -> [Item l]
toList Array i e
l2)
    isSuffixOf :: Eq e => Array i e -> Array i e -> Bool
isSuffixOf Array i e
l1 Array i e
l2 = forall a. Eq a => [a] -> [a] -> Bool
L.isSuffixOf (forall l. IsList l => l -> [Item l]
toList Array i e
l1) (forall l. IsList l => l -> [Item l]
toList Array i e
l2)
    isInfixOf :: Eq e => Array i e -> Array i e -> Bool
isInfixOf Array i e
l1 Array i e
l2 = forall a. Eq a => [a] -> [a] -> Bool
L.isInfixOf (forall l. IsList l => l -> [Item l]
toList Array i e
l1) (forall l. IsList l => l -> [Item l]
toList Array i e
l2)
    elem :: Eq e => e -> Array i e -> Bool
elem e
i Array i e
l = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
L.elem e
i (forall l. IsList l => l -> [Item l]
toList Array i e
l)
    -- notElem
    filter :: (e -> Bool) -> Array i e -> Array i e
filter e -> Bool
f = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
L.filter e -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    -- partition
    index :: Array i e -> Int -> e
index Array i e
l Int
i = Array i e
l forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) forall a. Num a => a -> a -> a
+ i
offset)
        where offset :: i
offset = (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l)
    elemIndex :: Eq e => e -> Array i e -> Maybe Int
elemIndex e
i = forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex e
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    elemIndices :: forall result.
(Eq e, ListLike result Int) =>
e -> Array i e -> result
elemIndices e
i = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> [Int]
L.elemIndices e
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    findIndex :: (e -> Bool) -> Array i e -> Maybe Int
findIndex e -> Bool
f = forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex e -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    findIndices :: forall result.
ListLike result Int =>
(e -> Bool) -> Array i e -> result
findIndices e -> Bool
f = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [Int]
L.findIndices e -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    sequence :: forall (m :: * -> *) fullinp.
(Applicative m, ListLike fullinp (m e)) =>
fullinp -> m (Array i e)
sequence  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
P.sequenceA  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    mapM :: forall (m :: * -> *) full' item'.
(Applicative m, ListLike full' item') =>
(e -> m item') -> Array i e -> m full'
mapM e -> m item'
func = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
P.traverse e -> m item'
func forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    -- rigidMapM = mapM
    nub :: Eq e => Array i e -> Array i e
nub = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
L.nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    -- delete
    -- deleteFirsts
    -- union
    -- intersect
    sort :: Ord e => Array i e -> Array i e
sort Array i e
l = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l) (forall a. Ord a => [a] -> [a]
L.sort (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Array i e
l))
    -- insert
    -- fromListLike
    nubBy :: (e -> e -> Bool) -> Array i e -> Array i e
nubBy e -> e -> Bool
f = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy e -> e -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
    -- deleteBy
    -- deleteFirstsBy
    -- unionBy
    -- intersectBy
    -- groupBy
    sortBy :: (e -> e -> Ordering) -> Array i e -> Array i e
sortBy e -> e -> Ordering
f Array i e
l = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l) (forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy e -> e -> Ordering
f (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Array i e
l))
    -- insertBy
    genericLength :: forall a. Num a => Array i e -> a
genericLength Array i e
l = forall a b. (Integral a, Num b) => a -> b
fromIntegral (i
bhigh forall a. Num a => a -> a -> a
- i
blow forall a. Num a => a -> a -> a
+ i
1)
        where (i
blow, i
bhigh) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l
    genericTake :: forall a. Integral a => a -> Array i e -> Array i e
genericTake a
count Array i e
l
        | a
count forall a. Ord a => a -> a -> Bool
> forall full item a. (ListLike full item, Num a) => full -> a
genericLength Array i e
l = Array i e
l
        | a
count forall a. Ord a => a -> a -> Bool
<= a
0 = forall full item. ListLike full item => full
empty
        | Bool
otherwise = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (i
blow, i
blow forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
count) forall a. Num a => a -> a -> a
- i
1)
                          (forall i a. Integral i => i -> [a] -> [a]
L.genericTake a
count (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Array i e
l))
        where (i
blow, i
_) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l
    genericDrop :: forall a. Integral a => a -> Array i e -> Array i e
genericDrop a
count Array i e
l = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (i
blow forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
count), i
bhigh)
                          (forall i a. Integral i => i -> [a] -> [a]
L.genericDrop a
count (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems Array i e
l))
        where (i
blow, i
bhigh) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Array i e
l
    -- geneicSplitAt
    genericReplicate :: forall a. Integral a => a -> e -> Array i e
genericReplicate a
count e
i = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (i
0, (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
count) forall a. Num a => a -> a -> a
- i
1)
                                           (forall i a. Integral i => i -> a -> [a]
L.genericReplicate a
count e
i)


instance (Integral i, Ix i) => IsString (A.Array i Char) where
    fromString :: String -> Array i Char
fromString = forall l. IsList l => [Item l] -> l
fromList

instance (Integral i, Ix i) => StringLike (A.Array i Char) where
    toString :: Array i Char -> String
toString = forall l. IsList l => l -> [Item l]
toList
    -- lines
    -- words

instance (Integral i, Ix i) => ListLikeIO (A.Array i Char) Char where
    hGetLine :: Handle -> IO (Array i Char)
hGetLine Handle
h = Handle -> IO String
IO.hGetLine Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
    hGetContents :: Handle -> IO (Array i Char)
hGetContents Handle
h = Handle -> IO String
IO.hGetContents Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
    hGet :: Handle -> Int -> IO (Array i Char)
hGet Handle
h Int
i = ((forall full item. ListLikeIO full item => Handle -> Int -> IO full
hGet Handle
h Int
i)::IO String) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
    hGetNonBlocking :: Handle -> Int -> IO (Array i Char)
hGetNonBlocking Handle
h Int
i = ((forall full item. ListLikeIO full item => Handle -> Int -> IO full
hGetNonBlocking Handle
h Int
i):: IO String) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
    hPutStr :: Handle -> Array i Char -> IO ()
hPutStr Handle
h = forall full item. ListLikeIO full item => Handle -> full -> IO ()
hPutStr Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => s -> String
toString
    hPutStrLn :: Handle -> Array i Char -> IO ()
hPutStrLn Handle
h = forall full item. ListLikeIO full item => Handle -> full -> IO ()
hPutStrLn Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => s -> String
toString
    getLine :: IO (Array i Char)
getLine = IO String
IO.getLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString)
    getContents :: IO (Array i Char)
getContents = IO String
IO.getContents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString)
    putStr :: Array i Char -> IO ()
putStr = String -> IO ()
IO.putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => s -> String
toString
    putStrLn :: Array i Char -> IO ()
putStrLn = String -> IO ()
IO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => s -> String
toString
    -- interact
    -- readFile
    -- writeFile
    -- appendFile

-- ---------------------------
-- Data.Sequence instances

instance ListLikeIO (S.Seq Char) Char where
    hGetLine :: Handle -> IO (Seq Char)
hGetLine Handle
h = Handle -> IO String
IO.hGetLine Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
    hGetContents :: Handle -> IO (Seq Char)
hGetContents Handle
h = Handle -> IO String
IO.hGetContents Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
    hGet :: Handle -> Int -> IO (Seq Char)
hGet Handle
h Int
i = ((forall full item. ListLikeIO full item => Handle -> Int -> IO full
hGet Handle
h Int
i)::IO String) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
    hGetNonBlocking :: Handle -> Int -> IO (Seq Char)
hGetNonBlocking Handle
h Int
i = ((forall full item. ListLikeIO full item => Handle -> Int -> IO full
hGetNonBlocking Handle
h Int
i):: IO String) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList)
    hPutStr :: Handle -> Seq Char -> IO ()
hPutStr Handle
h = forall full item. ListLikeIO full item => Handle -> full -> IO ()
hPutStr Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => s -> String
toString
    hPutStrLn :: Handle -> Seq Char -> IO ()
hPutStrLn Handle
h = forall full item. ListLikeIO full item => Handle -> full -> IO ()
hPutStrLn Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => s -> String
toString
    getLine :: IO (Seq Char)
getLine = IO String
IO.getLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString)
    getContents :: IO (Seq Char)
getContents = IO String
IO.getContents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString)
    putStr :: Seq Char -> IO ()
putStr = String -> IO ()
IO.putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => s -> String
toString
    putStrLn :: Seq Char -> IO ()
putStrLn = String -> IO ()
IO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. StringLike s => s -> String
toString
    -- interact
    -- readFile
    -- writeFile
    -- appendFile

#if !MIN_VERSION_containers(0,5,7)
instance IsString (S.Seq Char) where
  fromString = S.fromList
#endif

instance StringLike (S.Seq Char) where
    toString :: Seq Char -> String
toString = forall l. IsList l => l -> [Item l]
toList
    --fromString = fromList

instance FoldableLL (S.Seq a) a where
    foldl :: forall a. (a -> a -> a) -> a -> Seq a -> a
foldl = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl
    foldl' :: forall a. (a -> a -> a) -> a -> Seq a -> a
foldl' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'
    foldl1 :: (a -> a -> a) -> Seq a -> a
foldl1 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldl1
    foldr :: forall b. (a -> b -> b) -> b -> Seq a -> b
foldr = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr
    foldr' :: forall b. (a -> b -> b) -> b -> Seq a -> b
foldr' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr'
    foldr1 :: (a -> a -> a) -> Seq a -> a
foldr1 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldr1

instance ListLike (S.Seq a) a where
    empty :: Seq a
empty = forall a. Seq a
S.empty
    singleton :: a -> Seq a
singleton = forall a. a -> Seq a
S.singleton
    cons :: a -> Seq a -> Seq a
cons = forall a. a -> Seq a -> Seq a
(<|)
    snoc :: Seq a -> a -> Seq a
snoc = forall a. Seq a -> a -> Seq a
(|>)
    append :: Seq a -> Seq a -> Seq a
append = forall a. Seq a -> Seq a -> Seq a
(><)
    head :: Seq a -> a
head Seq a
s = let (a
a S.:< Seq a
_) = forall a. Seq a -> ViewL a
S.viewl Seq a
s in a
a
    last :: Seq a -> a
last Seq a
s = let (Seq a
_ S.:> a
a) = forall a. Seq a -> ViewR a
S.viewr Seq a
s in a
a
    tail :: Seq a -> Seq a
tail Seq a
s = forall a. Seq a -> Int -> a
S.index (forall a. Seq a -> Seq (Seq a)
S.tails Seq a
s) Int
1
    init :: Seq a -> Seq a
init Seq a
s = forall a. Seq a -> Int -> a
S.index (forall a. Seq a -> Seq (Seq a)
S.inits Seq a
s) (forall a. Seq a -> Int
S.length Seq a
s forall a. Num a => a -> a -> a
- Int
1)
    null :: Seq a -> Bool
null = forall a. Seq a -> Bool
S.null
    length :: Seq a -> Int
length = forall a. Seq a -> Int
S.length
    map :: forall full' item'.
ListLike full' item' =>
(a -> item') -> Seq a -> full'
map a -> item'
f = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> item'
f
    --rigidMap =
    reverse :: Seq a -> Seq a
reverse = forall a. Seq a -> Seq a
S.reverse
    --intersperse =
    --concat =
    --concatMap =
    --rigidConcatMap =
    any :: (a -> Bool) -> Seq a -> Bool
any = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any
    all :: (a -> Bool) -> Seq a -> Bool
all = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all
    maximum :: Ord a => Seq a -> a
maximum = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
F.maximum
    minimum :: Ord a => Seq a -> a
minimum = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
F.minimum
    replicate :: Int -> a -> Seq a
replicate Int
n = forall a. Int -> a -> Seq a
S.replicate (if Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
n else Int
0)
    take :: Int -> Seq a -> Seq a
take = forall a. Int -> Seq a -> Seq a
S.take
    drop :: Int -> Seq a -> Seq a
drop = forall a. Int -> Seq a -> Seq a
S.drop
    splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt = forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt
    --takeWhile =
    --dropWhile =
    span :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
span = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.spanl
    -- break =
    --group =
    inits :: forall full'. ListLike full' (Seq a) => Seq a -> full'
inits = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq (Seq a)
S.inits
    tails :: forall full'. ListLike full' (Seq a) => Seq a -> full'
tails = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq (Seq a)
S.tails
    --isPrefixOf =
    --isSuffixOf =
    --isInfixOf =
    --elem =
    --notElem =
    --find =
    filter :: (a -> Bool) -> Seq a -> Seq a
filter = forall a. (a -> Bool) -> Seq a -> Seq a
S.filter
    partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
partition = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.partition
    index :: Seq a -> Int -> a
index = forall a. Seq a -> Int -> a
S.index
    elemIndex :: Eq a => a -> Seq a -> Maybe Int
elemIndex = forall a. Eq a => a -> Seq a -> Maybe Int
S.elemIndexL
    elemIndices :: forall result. (Eq a, ListLike result Int) => a -> Seq a -> result
elemIndices a
p = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Seq a -> [Int]
S.elemIndicesL a
p
    findIndex :: (a -> Bool) -> Seq a -> Maybe Int
findIndex = forall a. (a -> Bool) -> Seq a -> Maybe Int
S.findIndexL
    findIndices :: forall result.
ListLike result Int =>
(a -> Bool) -> Seq a -> result
findIndices a -> Bool
p = forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> [Int]
S.findIndicesL a -> Bool
p
    --sequence =
    --mapM f =
    --nub =
    --delete =
    --deleteFirsts =
    --union =
    --intersect =
    sort :: Ord a => Seq a -> Seq a
sort = forall a. Ord a => Seq a -> Seq a
S.sort
    --insert = S.insert
    --fromListLike = fromList . toList
    --nubBy =
    --deleteBy =
    --deleteFirstsBy =
    --unionBy =
    --intersectBy =
    --groupBy f =
    sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
sortBy = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
S.sortBy
    --insertBy =
    genericLength :: forall a. Num a => Seq a -> a
genericLength = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Int
S.length
    genericTake :: forall a. Integral a => a -> Seq a -> Seq a
genericTake a
i = forall a. Int -> Seq a -> Seq a
S.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericDrop :: forall a. Integral a => a -> Seq a -> Seq a
genericDrop a
i = forall a. Int -> Seq a -> Seq a
S.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericSplitAt :: forall a. Integral a => a -> Seq a -> (Seq a, Seq a)
genericSplitAt a
i = forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericReplicate :: forall a. Integral a => a -> a -> Seq a
genericReplicate a
i = forall a. Int -> a -> Seq a
S.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)