-- This file is part of Qtah.
--
-- Copyright 2015-2021 The Qtah Authors.
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE CPP #-}

-- | General routines.
module Graphics.UI.Qtah.Generator.Common (
  splitOn,
  butLast,
  replaceLast,
  fromMaybeM,
  maybeFail,
  firstM,
  -- * String utilities
  lowerFirst,
  upperFirst,
  -- * File utilities
  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)

-- | Splits a list at elements for which a predicate returns true.  The matching
-- elements themselves are dropped.
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]

-- | Splits a list on a specified element.
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)

-- | Drops the last item from the list, if non-empty.
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

-- | Replaces the last element in a list, if the list is non-empty.  Returns the
-- empty list when given it.
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 m x = maybe m return x@
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 s x = maybe (fail s) x@
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

-- | Runs a list of monadic actions until one returns a 'Just' value, then
-- returning that value.  Returns 'Nothing' if all actions return 'Nothing'.
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

-- | Lower cases the first character of a string, if nonempty.
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

-- | Upper cases the first character of a string, if nonempty.
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

-- | If the file specified does not exist or its contents does not match the
-- given string, then this writes the string to the file.
writeFileIfDifferent :: FilePath -> String -> IO ()
writeFileIfDifferent :: String -> String -> IO ()
writeFileIfDifferent String
path String
newContents = do
  Bool
exists <- String -> IO Bool
doesFileExist String
path
  -- We need to read the file strictly, otherwise lazy IO might try to write the
  -- file while it's still open and locked for reading.
  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