    {- misc utility functions
     -
     - Copyright 2010-2011 Joey Hess <id@joeyh.name>
     -
     - License: BSD-2-clause
     -}

    {-# OPTIONS_GHC -fno-warn-tabs #-}

    module Utility.Misc where

    import System.IO
    import Control.Monad
    import Foreign
    import Data.Char
    import Data.List
    import System.Exit
    import Control.Applicative
    import Prelude

    {- A version of hgetContents that is not lazy. Ensures file is
     - all read before it gets closed. -}
    hGetContentsStrict :: Handle -> IO String
    hGetContentsStrict :: Handle -> IO String
    hGetContentsStrict = Handle -> IO String
    hGetContents (Handle -> IO String)
    -> (String -> IO String) -> Handle -> IO String
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> \s :: String
    s -> String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s Int -> IO String -> IO String
    forall a b. a -> b -> b
    `seq` String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    s

    {- A version of readFile that is not lazy. -}
    readFileStrict :: FilePath -> IO String
    readFileStrict :: String -> IO String
    readFileStrict = String -> IO String
    readFile (String -> IO String)
    -> (String -> IO String) -> String -> IO String
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> \s :: String
    s -> String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s Int -> IO String -> IO String
    forall a b. a -> b -> b
    `seq` String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    s

    {- Like break, but the item matching the condition is not included
     - in the second result list.
     -
     - separate (== ':') "foo:bar" = ("foo", "bar")
     - separate (== ':') "foobar" = ("foobar", "")
     -}
    separate :: (a -> Bool) -> [a] -> ([a], [a])
    separate :: (a -> Bool) -> [a] -> ([a], [a])
    separate c :: a -> Bool
    c l :: [a]
    l = ([a], [a]) -> ([a], [a])
    forall a a. (a, [a]) -> (a, [a])
    unbreak (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
    forall a b. (a -> b) -> a -> b
    $ (a -> Bool) -> [a] -> ([a], [a])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break a -> Bool
    c [a]
    l
      where
    	unbreak :: (a, [a]) -> (a, [a])
    unbreak r :: (a, [a])
    r@(a :: a
    a, b :: [a]
    b)
    		| [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    b = (a, [a])
    r
    		| Bool
    otherwise = (a
    a, [a] -> [a]
    forall a. [a] -> [a]
    tail [a]
    b)

    {- Breaks out the first line. -}
    firstLine :: String -> String
    firstLine :: String -> String
    firstLine = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '\n')

    {- Splits a list into segments that are delimited by items matching
     - a predicate. (The delimiters are not included in the segments.)
     - Segments may be empty. -}
    segment :: (a -> Bool) -> [a] -> [[a]]
    segment :: (a -> Bool) -> [a] -> [[a]]
    segment p :: a -> Bool
    p l :: [a]
    l = ([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> [a]
    forall a. [a] -> [a]
    reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [a] -> [[a]] -> [a] -> [[a]]
    go [] [] [a]
    l
      where
    	go :: [a] -> [[a]] -> [a] -> [[a]]
    go c :: [a]
    c r :: [[a]]
    r [] = [[a]] -> [[a]]
    forall a. [a] -> [a]
    reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [a]
    c[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    r
    	go c :: [a]
    c r :: [[a]]
    r (i :: a
    i:is :: [a]
    is)
    		| a -> Bool
    p a
    i = [a] -> [[a]] -> [a] -> [[a]]
    go [] ([a]
    c[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    r) [a]
    is
    		| Bool
    otherwise = [a] -> [[a]] -> [a] -> [[a]]
    go (a
    ia -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    c) [[a]]
    r [a]
    is

    prop_segment_regressionTest :: Bool
    prop_segment_regressionTest :: Bool
    prop_segment_regressionTest = (Bool -> Bool) -> [Bool] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Bool -> Bool
    forall a. a -> a
    id
    	-- Even an empty list is a segment.
    	[ (String -> Bool) -> [String] -> [[String]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    segment (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "--") [] [[String]] -> [[String]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [[]]
    	-- There are two segements in this list, even though the first is empty.
    	, (String -> Bool) -> [String] -> [[String]]
    forall a. (a -> Bool) -> [a] -> [[a]]
    segment (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "--") ["--", "foo", "bar"] [[String]] -> [[String]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [[],["foo","bar"]]
    	]

    {- Includes the delimiters as segments of their own. -}
    segmentDelim :: (a -> Bool) -> [a] -> [[a]]
    segmentDelim :: (a -> Bool) -> [a] -> [[a]]
    segmentDelim p :: a -> Bool
    p l :: [a]
    l = ([a] -> [a]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> [a] -> [b]
    map [a] -> [a]
    forall a. [a] -> [a]
    reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [a] -> [[a]] -> [a] -> [[a]]
    go [] [] [a]
    l
      where
    	go :: [a] -> [[a]] -> [a] -> [[a]]
    go c :: [a]
    c r :: [[a]]
    r [] = [[a]] -> [[a]]
    forall a. [a] -> [a]
    reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ [a]
    c[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    r
    	go c :: [a]
    c r :: [[a]]
    r (i :: a
    i:is :: [a]
    is)
    		| a -> Bool
    p a
    i = [a] -> [[a]] -> [a] -> [[a]]
    go [] ([a
    i][a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[a]
    c[a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    :[[a]]
    r) [a]
    is
    		| Bool
    otherwise = [a] -> [[a]] -> [a] -> [[a]]
    go (a
    ia -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    c) [[a]]
    r [a]
    is

    {- Replaces multiple values in a string.
     -
     - Takes care to skip over just-replaced values, so that they are not
     - mangled. For example, massReplace [("foo", "new foo")] does not
     - replace the "new foo" with "new new foo".
     -}
    massReplace :: [(String, String)] -> String -> String
    massReplace :: [(String, String)] -> String -> String
    massReplace vs :: [(String, String)]
    vs = [String] -> [(String, String)] -> String -> String
    go [] [(String, String)]
    vs
      where

    	go :: [String] -> [(String, String)] -> String -> String
    go acc :: [String]
    acc _ [] = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    acc
    	go acc :: [String]
    acc [] (c :: Char
    c:cs :: String
    cs) = [String] -> [(String, String)] -> String -> String
    go ([Char
    c]String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    acc) [(String, String)]
    vs String
    cs
    	go acc :: [String]
    acc ((val :: String
    val, replacement :: String
    replacement):rest :: [(String, String)]
    rest) s :: String
    s
    		| String
    val String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s =
    			[String] -> [(String, String)] -> String -> String
    go (String
    replacementString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    acc) [(String, String)]
    vs (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    val) String
    s)
    		| Bool
    otherwise = [String] -> [(String, String)] -> String -> String
    go [String]
    acc [(String, String)]
    rest String
    s

    {- Wrapper around hGetBufSome that returns a String.
     -
     - The null string is returned on eof, otherwise returns whatever
     - data is currently available to read from the handle, or waits for
     - data to be written to it if none is currently available.
     -
     - Note on encodings: The normal encoding of the Handle is ignored;
     - each byte is converted to a Char. Not unicode clean!
     -}
    hGetSomeString :: Handle -> Int -> IO String
    hGetSomeString :: Handle -> Int -> IO String
    hGetSomeString h :: Handle
    h sz :: Int
    sz = do
    	ForeignPtr Word8
    fp <- Int -> IO (ForeignPtr Word8)
    forall a. Int -> IO (ForeignPtr a)
    mallocForeignPtrBytes Int
    sz
    	Int
    len <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fp ((Ptr Word8 -> IO Int) -> IO Int)
    -> (Ptr Word8 -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \buf :: Ptr Word8
    buf -> Handle -> Ptr Word8 -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBufSome Handle
    h Ptr Word8
    buf Int
    sz
    	(Word8 -> Char) -> [Word8] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Char
    chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) ([Word8] -> String) -> IO [Word8] -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ForeignPtr Word8 -> (Ptr Word8 -> IO [Word8]) -> IO [Word8]
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fp (Int -> Ptr Word8 -> IO [Word8]
    peekbytes Int
    len)
      where
    	peekbytes :: Int -> Ptr Word8 -> IO [Word8]
    	peekbytes :: Int -> Ptr Word8 -> IO [Word8]
    peekbytes len :: Int
    len buf :: Ptr Word8
    buf = (Int -> IO Word8) -> [Int] -> IO [Word8]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Ptr Word8 -> Int -> IO Word8
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word8
    buf) [0..Int -> Int
    forall a. Enum a => a -> a
    pred Int
    len]

    exitBool :: Bool -> IO a
    exitBool :: Bool -> IO a
    exitBool False = IO a
    forall a. IO a
    exitFailure
    exitBool True = IO a
    forall a. IO a
    exitSuccess