{-# LANGUAGE CPP
            ,MultiParamTypeClasses
            ,FlexibleInstances
            ,TypeSynonymInstances #-}
{-# OPTIONS -fno-warn-orphans #-}

{-
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 : John Lato <jwlato@gmail.com>
   Stability  : provisional
   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           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.Maybe (fromMaybe)
import           Data.Monoid
import           Data.Semigroup (Semigroup(..))
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.UTF8 (UTF8)
--import qualified Data.String.UTF8 as UTF8
import qualified System.IO as IO
import           Data.Word

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

-- 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 _ c :: Int
c | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
forall a. Monoid a => a
mempty
    hGet h :: Handle
h c :: Int
c = Char -> String -> String
forall full item. ListLike full item => item -> full -> full
cons (Char -> String -> String) -> IO Char -> IO (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Char
IO.hGetChar Handle
h IO (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> Int -> IO String
forall full item. ListLikeIO full item => Handle -> Int -> IO full
hGet Handle
h (Int -> Int
forall a. Enum a => a -> a
pred Int
c)
    -- hGetNonBlocking h i >>= (return . toString)
    hGetNonBlocking :: Handle -> Int -> IO String
hGetNonBlocking _h :: Handle
_h _i :: Int
_i = String -> IO String
forall a. HasCallStack => String -> a
error "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 = String -> String
forall a. a -> a
id
    fromString :: String -> String
fromString = String -> String
forall a. a -> a
id

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

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

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

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 = ByteString -> Word8
BS.head
    last :: ByteString -> Word8
last = ByteString -> Word8
BS.last
    tail :: ByteString -> ByteString
tail = ByteString -> ByteString
BS.tail
    init :: ByteString -> ByteString
init = 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 :: full' -> ByteString
concat = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (full' -> [ByteString]) -> full' -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. full' -> [ByteString]
forall full item. ListLike full item => full -> [item]
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 :: ByteString -> Word8
maximum = ByteString -> Word8
BS.maximum
    minimum :: ByteString -> Word8
minimum = 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 :: ByteString -> full'
group = [ByteString] -> full'
forall full item. ListLike full item => [item] -> full
fromList ([ByteString] -> full')
-> (ByteString -> [ByteString]) -> ByteString -> full'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.group
    inits :: ByteString -> full'
inits = [ByteString] -> full'
forall full item. ListLike full item => [item] -> full
fromList ([ByteString] -> full')
-> (ByteString -> [ByteString]) -> ByteString -> full'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.inits
    tails :: ByteString -> full'
tails = [ByteString] -> full'
forall full item. ListLike full item => [item] -> full
fromList ([ByteString] -> full')
-> (ByteString -> [ByteString]) -> ByteString -> full'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.tails
    isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
BS.isPrefixOf
    isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf = ByteString -> ByteString -> Bool
BS.isSuffixOf
    --isInfixOf = BS.isInfixOf
    elem :: Word8 -> ByteString -> Bool
elem = Word8 -> ByteString -> Bool
BS.elem
    notElem :: 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 = ByteString -> Int -> Word8
BS.index
    elemIndex :: Word8 -> ByteString -> Maybe Int
elemIndex = Word8 -> ByteString -> Maybe Int
BS.elemIndex
    elemIndices :: Word8 -> ByteString -> result
elemIndices x :: Word8
x = [Int] -> result
forall full item. ListLike full item => [item] -> full
fromList ([Int] -> result) -> (ByteString -> [Int]) -> ByteString -> result
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 :: (Word8 -> Bool) -> ByteString -> result
findIndices x :: Word8 -> Bool
x = [Int] -> result
forall full item. ListLike full item => [item] -> full
fromList ([Int] -> result) -> (ByteString -> [Int]) -> ByteString -> result
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 :: fullinp -> m ByteString
sequence  = ([Word8] -> ByteString) -> m [Word8] -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Word8] -> ByteString
forall full item. ListLike full item => [item] -> full
fromList (m [Word8] -> m ByteString)
-> (fullinp -> m [Word8]) -> fullinp -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m Word8] -> m [Word8]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
P.sequence  ([m Word8] -> m [Word8])
-> (fullinp -> [m Word8]) -> fullinp -> m [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fullinp -> [m Word8]
forall full item. ListLike full item => full -> [item]
toList
    mapM :: (Word8 -> m item') -> ByteString -> m full'
mapM func :: Word8 -> m item'
func = ([item'] -> full') -> m [item'] -> m full'
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [item'] -> full'
forall full item. ListLike full item => [item] -> full
fromList (m [item'] -> m full')
-> (ByteString -> m [item']) -> ByteString -> m full'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> m item') -> [Word8] -> m [item']
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
P.mapM Word8 -> m item'
func ([Word8] -> m [item'])
-> (ByteString -> [Word8]) -> ByteString -> m [item']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
forall full item. ListLike full item => full -> [item]
toList
    --nub = BS.nub
    --delete = BS.delete
    --deleteFirsts = BS.deleteFirsts
    --union = BS.union
    --intersect = BS.intersect
    sort :: ByteString -> ByteString
sort = ByteString -> ByteString
BS.sort
    --insert = BS.insert
    toList :: ByteString -> [Word8]
toList = ByteString -> [Word8]
BS.unpack
    fromList :: [Word8] -> ByteString
fromList = [Word8] -> ByteString
BS.pack
    --fromListLike = fromList . toList
    --nubBy = BS.nubBy
    --deleteBy = BS.deleteBy
    --deleteFirstsBy = BS.deleteFirstsBy
    --unionBy = BS.unionBy
    --intersectBy = BS.intersectBy
    groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> full'
groupBy f :: Word8 -> Word8 -> Bool
f = [ByteString] -> full'
forall full item. ListLike full item => [item] -> full
fromList ([ByteString] -> full')
-> (ByteString -> [ByteString]) -> ByteString -> full'
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 :: ByteString -> a
genericLength = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> (ByteString -> Integer) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> (ByteString -> Int) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length
    genericTake :: a -> ByteString -> ByteString
genericTake i :: a
i = Int -> ByteString -> ByteString
BS.take (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericDrop :: a -> ByteString -> ByteString
genericDrop i :: a
i = Int -> ByteString -> ByteString
BS.drop (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericSplitAt :: a -> ByteString -> (ByteString, ByteString)
genericSplitAt i :: a
i = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericReplicate :: a -> Word8 -> ByteString
genericReplicate i :: a
i = Int -> Word8 -> ByteString
BS.replicate (a -> Int
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
BS.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
BS.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 :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BSL.foldl
    foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl' = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BSL.foldl'
    foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 = (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BSL.foldl1
    foldr :: (Word8 -> b -> b) -> b -> ByteString -> b
foldr = (Word8 -> b -> b) -> b -> ByteString -> b
forall b. (Word8 -> b -> b) -> b -> ByteString -> b
BSL.foldr
    --foldr' = BSL.foldr'
    foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1 = (Word8 -> Word8 -> Word8) -> ByteString -> Word8
BSL.foldr1

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

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 = ByteString -> Word8
BSL.head
    last :: ByteString -> Word8
last = ByteString -> Word8
BSL.last
    tail :: ByteString -> ByteString
tail = ByteString -> ByteString
BSL.tail
    init :: ByteString -> ByteString
init = ByteString -> ByteString
BSL.init
    null :: ByteString -> Bool
null = ByteString -> Bool
BSL.null
    length :: ByteString -> Int
length = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (ByteString -> Int64) -> ByteString -> Int
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 :: full' -> ByteString
concat = [ByteString] -> ByteString
BSL.concat ([ByteString] -> ByteString)
-> (full' -> [ByteString]) -> full' -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. full' -> [ByteString]
forall full item. ListLike full item => full -> [item]
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 :: ByteString -> Word8
maximum = ByteString -> Word8
BSL.maximum
    minimum :: ByteString -> Word8
minimum = ByteString -> Word8
BSL.minimum
    replicate :: Int -> Word8 -> ByteString
replicate i :: Int
i = Int64 -> Word8 -> ByteString
BSL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    take :: Int -> ByteString -> ByteString
take i :: Int
i = Int64 -> ByteString -> ByteString
BSL.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    drop :: Int -> ByteString -> ByteString
drop i :: Int
i = Int64 -> ByteString -> ByteString
BSL.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt i :: Int
i = Int64 -> ByteString -> (ByteString, ByteString)
BSL.splitAt (Int -> Int64
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 :: ByteString -> full'
group = [ByteString] -> full'
forall full item. ListLike full item => [item] -> full
fromList ([ByteString] -> full')
-> (ByteString -> [ByteString]) -> ByteString -> full'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.group
    inits :: ByteString -> full'
inits = [ByteString] -> full'
forall full item. ListLike full item => [item] -> full
fromList ([ByteString] -> full')
-> (ByteString -> [ByteString]) -> ByteString -> full'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.inits
    tails :: ByteString -> full'
tails = [ByteString] -> full'
forall full item. ListLike full item => [item] -> full
fromList ([ByteString] -> full')
-> (ByteString -> [ByteString]) -> ByteString -> full'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.tails
    isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
BSL.isPrefixOf
    --isSuffixOf = BSL.isSuffixOf
    --isInfixOf = BSL.isInfixOf
    elem :: Word8 -> ByteString -> Bool
elem = Word8 -> ByteString -> Bool
BSL.elem
    notElem :: 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 l :: ByteString
l i :: Int
i = ByteString -> Int64 -> Word8
BSL.index ByteString
l (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    elemIndex :: Word8 -> ByteString -> Maybe Int
elemIndex i :: Word8
i = Maybe Int64 -> Maybe Int
mi64toi (Maybe Int64 -> Maybe Int)
-> (ByteString -> Maybe Int64) -> ByteString -> Maybe Int
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 f :: Word8 -> Bool
f = Maybe Int64 -> Maybe Int
mi64toi (Maybe Int64 -> Maybe Int)
-> (ByteString -> Maybe Int64) -> ByteString -> Maybe Int
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 :: fullinp -> m ByteString
sequence  = ([Word8] -> ByteString) -> m [Word8] -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Word8] -> ByteString
forall full item. ListLike full item => [item] -> full
fromList (m [Word8] -> m ByteString)
-> (fullinp -> m [Word8]) -> fullinp -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m Word8] -> m [Word8]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
P.sequence  ([m Word8] -> m [Word8])
-> (fullinp -> [m Word8]) -> fullinp -> m [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fullinp -> [m Word8]
forall full item. ListLike full item => full -> [item]
toList
    mapM :: (Word8 -> m item') -> ByteString -> m full'
mapM func :: Word8 -> m item'
func = ([item'] -> full') -> m [item'] -> m full'
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [item'] -> full'
forall full item. ListLike full item => [item] -> full
fromList (m [item'] -> m full')
-> (ByteString -> m [item']) -> ByteString -> m full'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> m item') -> [Word8] -> m [item']
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
P.mapM Word8 -> m item'
func ([Word8] -> m [item'])
-> (ByteString -> [Word8]) -> ByteString -> m [item']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
forall full item. ListLike full item => full -> [item]
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
    toList :: ByteString -> [Word8]
toList = ByteString -> [Word8]
BSL.unpack
    fromList :: [Word8] -> ByteString
fromList = [Word8] -> ByteString
BSL.pack
    --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 :: ByteString -> a
genericLength = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> (ByteString -> Integer) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer)
-> (ByteString -> Int64) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length
    genericTake :: a -> ByteString -> ByteString
genericTake i :: a
i = Int64 -> ByteString -> ByteString
BSL.take (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericDrop :: a -> ByteString -> ByteString
genericDrop i :: a
i = Int64 -> ByteString -> ByteString
BSL.drop (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericSplitAt :: a -> ByteString -> (ByteString, ByteString)
genericSplitAt i :: a
i = Int64 -> ByteString -> (ByteString, ByteString)
BSL.splitAt (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
    genericReplicate :: a -> Word8 -> ByteString
genericReplicate i :: a
i = Int64 -> Word8 -> ByteString
BSL.replicate (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)

strict2lazy :: BS.ByteString -> IO BSL.ByteString
strict2lazy :: ByteString -> IO ByteString
strict2lazy b :: ByteString
b = ByteString -> IO ByteString
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 h :: Handle
h = Handle -> IO ByteString
BS.hGetLine Handle
h IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
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
BS.getLine IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
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 :: (a -> e -> a) -> a -> Array i e -> a
foldl = (a -> e -> a) -> a -> Array i e -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl
    foldl1 :: (e -> e -> e) -> Array i e -> e
foldl1 = (e -> e -> e) -> Array i e -> e
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldl1
    foldl' :: (a -> e -> a) -> a -> Array i e -> a
foldl' = (a -> e -> a) -> a -> Array i e -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl'
    foldr :: (e -> b -> b) -> b -> Array i e -> b
foldr = (e -> b -> b) -> b -> Array i e -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr
    foldr1 :: (e -> e -> e) -> Array i e -> e
foldr1 = (e -> e -> e) -> Array i e -> e
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldr1
    foldr' :: (e -> b -> b) -> b -> Array i e -> b
foldr' = (e -> b -> b) -> b -> Array i e -> b
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 -> Array i e -> Array i e
(<>) = Array i e -> Array i e -> Array i e
forall a. Monoid a => a -> a -> a
mappend

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


instance (Integral i, Ix i) => StringLike (A.Array i Char) where
    toString :: Array i Char -> String
toString = Array i Char -> String
forall full item. ListLike full item => full -> [item]
toList
    fromString :: String -> Array i Char
fromString = String -> Array i Char
forall full item. ListLike full item => [item] -> full
fromList
    -- lines
    -- words

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

instance StringLike (S.Seq Char) where
    toString :: Seq Char -> String
toString = Seq Char -> String
forall full item. ListLike full item => full -> [item]
toList
    fromString :: String -> Seq Char
fromString = String -> Seq Char
forall full item. ListLike full item => [item] -> full
fromList

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

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