{-# LANGUAGE CPP #-}
module Graphics.UI.Qtah.Generator.Common (
splitOn,
butLast,
replaceLast,
fromMaybeM,
maybeFail,
firstM,
lowerFirst,
upperFirst,
writeFileIfDifferent,
) where
import Control.Exception (evaluate)
import Control.Monad (when)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import Data.Char (toLower, toUpper)
import Data.Foldable (asum)
import Data.List (findIndex)
import System.Directory (doesFileExist)
import System.IO (IOMode (ReadMode), hGetContents, withFile)
splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen a -> Bool
_ [] = []
splitWhen a -> Bool
f [a]
xs = case (a -> Bool) -> [a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex a -> Bool
f [a]
xs of
Just Int
index -> let ([a]
term, a
_:[a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
index [a]
xs
in [a]
term [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen a -> Bool
f [a]
rest
Maybe Int
Nothing -> [[a]
xs]
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn :: a -> [a] -> [[a]]
splitOn a
x = (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x)
butLast :: [a] -> [a]
butLast :: [a] -> [a]
butLast [] = []
butLast [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs
replaceLast :: a -> [a] -> [a]
replaceLast :: a -> [a] -> [a]
replaceLast a
_ [] = []
replaceLast a
y [a
_] = [a
y]
replaceLast a
y (a
x:[a]
xs) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> [a] -> [a]
forall a. a -> [a] -> [a]
replaceLast a
y [a]
xs
fromMaybeM :: Monad m => m a -> Maybe a -> m a
fromMaybeM :: m a -> Maybe a -> m a
fromMaybeM = (m a -> (a -> m a) -> Maybe a -> m a)
-> (a -> m a) -> m a -> Maybe a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
maybeFail :: MonadFail m => String -> Maybe a -> m a
maybeFail :: String -> Maybe a -> m a
maybeFail = m a -> Maybe a -> m a
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM (m a -> Maybe a -> m a)
-> (String -> m a) -> String -> Maybe a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
firstM :: (Functor m, Monad m) => [m (Maybe a)] -> m (Maybe a)
firstM :: [m (Maybe a)] -> m (Maybe a)
firstM = MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m a -> m (Maybe a))
-> ([m (Maybe a)] -> MaybeT m a) -> [m (Maybe a)] -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT m a] -> MaybeT m a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([MaybeT m a] -> MaybeT m a)
-> ([m (Maybe a)] -> [MaybeT m a]) -> [m (Maybe a)] -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (Maybe a) -> MaybeT m a) -> [m (Maybe a)] -> [MaybeT m a]
forall a b. (a -> b) -> [a] -> [b]
map m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
lowerFirst :: String -> String
lowerFirst :: String -> String
lowerFirst String
"" = String
""
lowerFirst (Char
c:String
cs) = Char -> Char
toLower Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
upperFirst :: String -> String
upperFirst :: String -> String
upperFirst String
"" = String
""
upperFirst (Char
c:String
cs) = Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
writeFileIfDifferent :: FilePath -> String -> IO ()
writeFileIfDifferent :: String -> String -> IO ()
writeFileIfDifferent String
path String
newContents = do
Bool
exists <- String -> IO Bool
doesFileExist String
path
Bool
doWrite <- if Bool
exists
then (String
newContents String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=) (String -> Bool) -> IO String -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
readStrictly
else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doWrite (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
path String
newContents
where readStrictly :: IO String
readStrictly = String -> IOMode -> (Handle -> IO String) -> IO String
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
ReadMode ((Handle -> IO String) -> IO String)
-> (Handle -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
String
contents <- Handle -> IO String
hGetContents Handle
handle
Int
_ <- Int -> IO Int
forall a. a -> IO a
evaluate (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
contents
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
contents