module Sifflet.Util (
             -- | Parser Utilities
             SuccFail(Succ, Fail)
            , parsef, parseInt, parseDouble, parseVerbatim
             -- | String Utilities
            , par
             -- Output Utilities
            , putCatsLn
            , putCatLn
            , info
            , fake
            , stub

            -- | Error Reporting
             , errcat
             , errcats

            -- | List Utilities
            , map2, mapM2
            , adjustAList, adjustAListM
            , insertLastLast, insertLast
            )

where

import Control.Monad()

-- SuccFail: the result of an attempt, succeeds or fails
data SuccFail a = Succ a        -- value
                | Fail String   -- error message
                deriving (Eq, Read, Show)

instance Monad SuccFail where
  Succ val >>= f = f val
  Fail err >>= _f = Fail err
  return = Succ
  fail = Fail

-- PARSER UTILITIES

parsef :: (Read a) => String -> String -> String -> SuccFail a
parsef typeName inputLabel input =
    case reads input of
      [(value, "")] -> Succ value
      [(_, more)] -> 
          Fail $ inputLabel ++ ": extra characters after " ++ 
                    typeName ++ ": " ++ more
      _  -> Fail $ inputLabel ++ ": cannot parse as " ++ 
                     typeName ++ ": " ++ input

parseInt :: String -> String -> SuccFail Int
parseInt = parsef "integer"

parseDouble :: String -> String -> SuccFail Double
parseDouble = parsef "real number"

parseVerbatim :: String -> String -> SuccFail String
parseVerbatim _label = Succ

-- | Enclose in parentheses, like a Lisp function call.
-- Example: par "foo" ["x", "y"] = "(foo x y)"

par :: String -> [String] -> String
par f xs = "(" ++ unwords (f:xs) ++ ")"

-- | Write a list of words, separated by spaces
putCatsLn :: [String] -> IO ()
putCatsLn = putStrLn . unwords

-- | Write a list of words, not separated by spaces
putCatLn :: [String] -> IO ()
putCatLn = putStrLn . concat

info :: (Show t) => t -> IO ()
info = print

fake :: String -> IO ()
fake what = putStrLn $ "Faking " ++ what ++ "..."

stub :: String -> IO ()
stub name = putStrLn $ "Stub for " ++ name

-- ERROR REPORTING

-- | Signal an error using a list of strings to be concatenated
errcat :: [String] -> a
errcat = error . concat

-- | Signal an error using a list of strings to be concatenated
-- with spaces between (unwords).
errcats :: [String] -> a
errcats = error . unwords

-- LIST UTILITIES

-- | Generalization of map to lists of lists
map2 :: (a -> b) -> [[a]] -> [[b]]
map2 f rows = -- map (\ row -> map f row) rows
              map (map f) rows

-- | Generalization of mapM to lists of lists
mapM2 :: (Monad m) => (a -> m b) -> [[a]] -> m [[b]]
mapM2 f rows = -- mapM (\ row -> mapM f row) rows
               mapM (mapM f) rows

-- | Insert an item into a list of lists of items,
-- making it the last element in the last sublist
insertLastLast :: [[a]] -> a -> [[a]]
insertLastLast xss x = init xss ++ [insertLast (last xss) x]

-- | Insert an item in a list of items, making it the last element
insertLast :: [a] -> a -> [a]
insertLast xs x = xs ++ [x]

-- | Update a value at a given key by applying a function.
-- Similar to Data.Map.adjust.

-- This implementation, using map, could be inefficient
-- if the key to be updated is near the front of a long list.
adjustAList :: (Eq k) => k -> (v -> v) -> [(k, v)] -> [(k, v)]
adjustAList key f alist =
    map (\ (k, v) -> if k == key then (k, f v) else (k, v)) 
        alist

-- | Monadic generalization of adjustAList 

-- Same caution re. inefficiency
adjustAListM :: (Eq k, Monad m) => 
                k -> (v -> m v) -> [(k, v)] -> m [(k, v)]
adjustAListM key f alist =
    mapM (\ (k, v) -> 
              if k == key 
              then do { v' <- f v; return (k, v') }
              else return (k, v))
         alist