module HsDev.Tools.Ghc.Prelude (
	reduce, one, trim,
	-- * Regexes
	rx, srx, splitRx,
	-- * Case
	lowerCase, upperCase, titleCase, camelCase, underscoreCase,

	module Control.Lens,
	module Data.Char,
	module Data.List,
	module Data.Maybe
	) where

import Control.Lens
import Data.Array (assocs)
import Data.Char
import Data.List hiding (uncons)
import Data.Maybe
import Text.Regex.PCRE

-- | Reduce list to one element
reduce :: ([a] -> a) -> [a] -> [a]
reduce = (return .)

-- | Make list from single element
one :: a -> [a]
one = return

-- | Trim string
trim :: String -> String
trim = p . p where
	p = reverse . dropWhile isSpace

-- | Match regex
rx :: String -> String -> Maybe String
rx r s = case s =~ r of
	"" -> Nothing
	res -> Just res

-- | Replace regex
srx :: String -> String -> String -> String
srx pat s = concat . unfoldr split' . Just where
	split' :: Maybe String -> Maybe (String, Maybe String)
	split' Nothing = Nothing
	split' (Just str) = case mrMatch r of
		"" -> Just (mrBefore r, Nothing)
		_ -> Just (mrBefore r ++ subst, Just $ mrAfter r)
		where
			r = str =~ pat
			groups = filter (not . null . snd) $ assocs $ mrSubs r
			look i = lookup i groups
			subst = subst' s where
				subst' :: String -> String
				subst' "" = ""
				subst' "\\" = "\\"
				subst' ('\\':'\\':ss') = '\\' : subst' ss'
				subst' ('\\':ss') = case span isDigit ss' of
					([], _) -> '\\' : subst' ss'
					(num, tl) -> fromMaybe "" (look $ read num) ++ subst' tl
				subst' (s':ss') = s' : subst' ss'

-- | Split by regex
splitRx :: String -> String -> [String]
splitRx pat = unfoldr split' . Just where
	split' :: Maybe String -> Maybe (String, Maybe String)
	split' Nothing = Nothing
	split' (Just str) = case mrMatch r of
		"" -> Just (mrBefore r, Nothing)
		_ -> Just (mrBefore r, Just $ mrAfter r)
		where
			r = str =~ pat

lowerCase :: String -> String
lowerCase = map toLower

upperCase :: String -> String
upperCase = map toUpper

-- | Convert to title case
titleCase :: String -> String
titleCase = over _head toUpper

-- | Convert to camel case
camelCase :: String -> String
camelCase = concatMap titleCase . splitRx "[\\s_]+"

-- | Convert to underscore case
underscoreCase :: String -> String
underscoreCase = intercalate "_" . map lowerCase . unfoldr break' where
	break' :: String -> Maybe (String, String)
	break' str = do
		(s, ss) <- uncons str
		let
			(h, tl) = break isUpper ss
		return (s:h, tl)