{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
module Moo.CommandUtils
( apply
, confirmCreation
, interactiveAskDeps
, lookupMigration
, revert
, withBackend
, getCurrentTimestamp
) where
import Data.Text ( Text )
import qualified Data.Text as T
import Data.String.Conversions ( cs, (<>) )
import Control.Exception ( finally )
import Control.Monad ( when, forM_, unless )
import Control.Monad.Reader ( asks )
import Control.Monad.Trans ( liftIO )
import Data.List ( intercalate, sortBy, isPrefixOf )
import Data.Time.Clock (getCurrentTime)
import Data.Maybe ( fromJust, isJust )
import System.Exit ( exitWith, ExitCode(..) )
import System.IO ( stdout, hFlush, hGetBuffering
, hSetBuffering, stdin, BufferMode(..) )
import Database.Schema.Migrations ( migrationsToApply, migrationsToRevert )
import Database.Schema.Migrations.Backend (Backend(..))
import Database.Schema.Migrations.Migration ( Migration(..) )
import Database.Schema.Migrations.Store ( StoreData
, storeLookup
, storeMigrations
)
import Moo.Core
getCurrentTimestamp :: IO Text
getCurrentTimestamp :: IO Text
getCurrentTimestamp =
[Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> (UTCTime -> [Char]) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char] -> [Char]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [Char]
":" [Char]
"-" ([Char] -> [Char]) -> (UTCTime -> [Char]) -> UTCTime -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char] -> [Char]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [Char]
" " [Char]
"_" ([Char] -> [Char]) -> (UTCTime -> [Char]) -> UTCTime -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
19 ([Char] -> [Char]) -> (UTCTime -> [Char]) -> UTCTime -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> [Char]
forall a. Show a => a -> [Char]
show (UTCTime -> Text) -> IO UTCTime -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
apply :: Migration -> StoreData -> Backend -> Bool -> IO [Migration]
apply :: Migration -> StoreData -> Backend -> Bool -> IO [Migration]
apply Migration
m StoreData
storeData Backend
backend Bool
complain = do
[Migration]
toApply <- StoreData -> Backend -> Migration -> IO [Migration]
migrationsToApply StoreData
storeData Backend
backend Migration
m
if [Migration] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Migration]
toApply then
IO ()
nothingToDo IO () -> IO [Migration] -> IO [Migration]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Migration] -> IO [Migration]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else
(Migration -> IO ()) -> [Migration] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Backend -> Migration -> IO ()
applyIt Backend
backend) [Migration]
toApply IO () -> IO [Migration] -> IO [Migration]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Migration] -> IO [Migration]
forall (m :: * -> *) a. Monad m => a -> m a
return [Migration]
toApply
where
nothingToDo :: IO ()
nothingToDo =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
complain (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Nothing to do; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Migration -> Text
mId Migration
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" already installed."
applyIt :: Backend -> Migration -> IO ()
applyIt Backend
conn Migration
it = do
[Char] -> IO ()
putStr ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Applying: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Migration -> Text
mId Migration
it Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"... "
Backend -> Migration -> IO ()
applyMigration Backend
conn Migration
it
[Char] -> IO ()
putStrLn [Char]
"done."
revert :: Migration -> StoreData -> Backend -> IO [Migration]
revert :: Migration -> StoreData -> Backend -> IO [Migration]
revert Migration
m StoreData
storeData Backend
backend = do
[Migration]
toRevert <- IO [Migration] -> IO [Migration]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Migration] -> IO [Migration])
-> IO [Migration] -> IO [Migration]
forall a b. (a -> b) -> a -> b
$ StoreData -> Backend -> Migration -> IO [Migration]
migrationsToRevert StoreData
storeData Backend
backend Migration
m
if [Migration] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Migration]
toRevert then
IO ()
nothingToDo IO () -> IO [Migration] -> IO [Migration]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Migration] -> IO [Migration]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else
(Migration -> IO ()) -> [Migration] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Backend -> Migration -> IO ()
revertIt Backend
backend) [Migration]
toRevert IO () -> IO [Migration] -> IO [Migration]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Migration] -> IO [Migration]
forall (m :: * -> *) a. Monad m => a -> m a
return [Migration]
toRevert
where
nothingToDo :: IO ()
nothingToDo =
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Nothing to do; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Migration -> Text
mId Migration
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" not installed."
revertIt :: Backend -> Migration -> IO ()
revertIt Backend
conn Migration
it = do
[Char] -> IO ()
putStr ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Reverting: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Migration -> Text
mId Migration
it Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"... "
Backend -> Migration -> IO ()
revertMigration Backend
conn Migration
it
[Char] -> IO ()
putStrLn [Char]
"done."
lookupMigration :: StoreData -> Text -> IO Migration
lookupMigration :: StoreData -> Text -> IO Migration
lookupMigration StoreData
storeData Text
name = do
let theMigration :: Maybe Migration
theMigration = StoreData -> Text -> Maybe Migration
storeLookup StoreData
storeData Text
name
case Maybe Migration
theMigration of
Maybe Migration
Nothing -> do
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"No such migration: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
ExitCode -> IO Migration
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Just Migration
m' -> Migration -> IO Migration
forall (m :: * -> *) a. Monad m => a -> m a
return Migration
m'
withBackend :: (Backend -> IO a) -> AppT a
withBackend :: (Backend -> IO a) -> AppT a
withBackend Backend -> IO a
act = do
Backend
backend <- (AppState -> Backend) -> ReaderT AppState IO Backend
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks AppState -> Backend
_appBackend
IO a -> AppT a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> AppT a) -> IO a -> AppT a
forall a b. (a -> b) -> a -> b
$ (Backend -> IO a
act Backend
backend) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` (Backend -> IO ()
disconnectBackend Backend
backend)
confirmCreation :: Text -> [Text] -> IO Bool
confirmCreation :: Text -> [Text] -> IO Bool
confirmCreation Text
migrationId [Text]
deps = do
[Char] -> IO ()
putStrLn [Char]
""
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Confirm: create migration '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
migrationId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
deps then [Char] -> IO ()
putStrLn [Char]
" (No dependencies)"
else [Char] -> IO ()
putStrLn [Char]
"with dependencies:"
[Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
deps ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
d -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d
[Char] -> PromptChoices Bool -> IO Bool
forall a. Eq a => [Char] -> PromptChoices a -> IO a
prompt [Char]
"Are you sure?" [ (Char
'y', (Bool
True, Maybe [Char]
forall a. Maybe a
Nothing))
, (Char
'n', (Bool
False, Maybe [Char]
forall a. Maybe a
Nothing))
]
prompt :: (Eq a) => String -> PromptChoices a -> IO a
prompt :: [Char] -> PromptChoices a -> IO a
prompt [Char]
_ [] = [Char] -> IO a
forall a. HasCallStack => [Char] -> a
error [Char]
"prompt requires a list of choices"
prompt [Char]
message PromptChoices a
choiceMap = do
[Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
message [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
choiceStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
helpChar [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"): "
Handle -> IO ()
hFlush Handle
stdout
Char
c <- IO Char
unbufferedGetChar
case Char -> PromptChoices a -> Maybe (a, Maybe [Char])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c PromptChoices a
choiceMap of
Maybe (a, Maybe [Char])
Nothing -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
""
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'h') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ PromptChoices a -> [Char]
forall a. PromptChoices a -> [Char]
mkPromptHelp PromptChoices a
choiceMapWithHelp
IO a
retry
Just (a
val, Maybe [Char]
_) -> [Char] -> IO ()
putStrLn [Char]
"" IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
where
retry :: IO a
retry = [Char] -> PromptChoices a -> IO a
forall a. Eq a => [Char] -> PromptChoices a -> IO a
prompt [Char]
message PromptChoices a
choiceMap
choiceStr :: [Char]
choiceStr = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Char, (a, Maybe [Char])) -> [Char])
-> PromptChoices a -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> [Char])
-> ((Char, (a, Maybe [Char])) -> Char)
-> (Char, (a, Maybe [Char]))
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, (a, Maybe [Char])) -> Char
forall a b. (a, b) -> a
fst) PromptChoices a
choiceMap
helpChar :: [Char]
helpChar = if PromptChoices a -> Bool
forall a. PromptChoices a -> Bool
hasHelp PromptChoices a
choiceMap then [Char]
"h" else [Char]
""
choiceMapWithHelp :: PromptChoices a
choiceMapWithHelp = PromptChoices a
choiceMap PromptChoices a -> PromptChoices a -> PromptChoices a
forall a. [a] -> [a] -> [a]
++ [(Char
'h', (a
forall a. HasCallStack => a
undefined, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"this help"))]
mkPromptHelp :: PromptChoices a -> String
mkPromptHelp :: PromptChoices a -> [Char]
mkPromptHelp PromptChoices a
choices =
[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"" [ [Char
c] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" |
(Char
c, (a
_, Maybe [Char]
msg)) <- PromptChoices a
choices, Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [Char]
msg ]
hasHelp :: PromptChoices a -> Bool
hasHelp :: PromptChoices a -> Bool
hasHelp = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool)
-> (PromptChoices a -> Int) -> PromptChoices a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PromptChoices a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PromptChoices a -> Int)
-> (PromptChoices a -> PromptChoices a) -> PromptChoices a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, (a, Maybe [Char])) -> Bool)
-> PromptChoices a -> PromptChoices a
forall a. (a -> Bool) -> [a] -> [a]
filter (Char, (a, Maybe [Char])) -> Bool
forall a a a. (a, (a, Maybe a)) -> Bool
hasMsg
where hasMsg :: (a, (a, Maybe a)) -> Bool
hasMsg (a
_, (a
_, Maybe a
m)) = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
m
type PromptChoices a = [(Char, (a, Maybe String))]
unbufferedGetChar :: IO Char
unbufferedGetChar :: IO Char
unbufferedGetChar = do
BufferMode
bufferingMode <- Handle -> IO BufferMode
hGetBuffering Handle
stdin
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
Char
c <- IO Char
getChar
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
bufferingMode
Char -> IO Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
data AskDepsChoice = Yes | No | View | Done | Quit
deriving (AskDepsChoice -> AskDepsChoice -> Bool
(AskDepsChoice -> AskDepsChoice -> Bool)
-> (AskDepsChoice -> AskDepsChoice -> Bool) -> Eq AskDepsChoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AskDepsChoice -> AskDepsChoice -> Bool
$c/= :: AskDepsChoice -> AskDepsChoice -> Bool
== :: AskDepsChoice -> AskDepsChoice -> Bool
$c== :: AskDepsChoice -> AskDepsChoice -> Bool
Eq)
interactiveAskDeps :: StoreData -> IO [Text]
interactiveAskDeps :: StoreData -> IO [Text]
interactiveAskDeps StoreData
storeData = do
let sorted :: [Migration]
sorted = (Migration -> Migration -> Ordering) -> [Migration] -> [Migration]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Migration -> Migration -> Ordering
compareTimestamps ([Migration] -> [Migration]) -> [Migration] -> [Migration]
forall a b. (a -> b) -> a -> b
$ StoreData -> [Migration]
storeMigrations StoreData
storeData
StoreData -> [Text] -> IO [Text]
interactiveAskDeps' StoreData
storeData ((Migration -> Text) -> [Migration] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Migration -> Text
mId [Migration]
sorted)
where
compareTimestamps :: Migration -> Migration -> Ordering
compareTimestamps Migration
m1 Migration
m2 = Maybe UTCTime -> Maybe UTCTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Migration -> Maybe UTCTime
mTimestamp Migration
m2) (Migration -> Maybe UTCTime
mTimestamp Migration
m1)
interactiveAskDeps' :: StoreData -> [Text] -> IO [Text]
interactiveAskDeps' :: StoreData -> [Text] -> IO [Text]
interactiveAskDeps' StoreData
_ [] = [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
interactiveAskDeps' StoreData
storeData (Text
name:[Text]
rest) = do
AskDepsChoice
result <- [Char] -> PromptChoices AskDepsChoice -> IO AskDepsChoice
forall a. Eq a => [Char] -> PromptChoices a -> IO a
prompt ([Char]
"Depend on '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'?") PromptChoices AskDepsChoice
askDepsChoices
if AskDepsChoice
result AskDepsChoice -> AskDepsChoice -> Bool
forall a. Eq a => a -> a -> Bool
== AskDepsChoice
Done then [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else
case AskDepsChoice
result of
AskDepsChoice
Yes -> do
[Text]
next <- StoreData -> [Text] -> IO [Text]
interactiveAskDeps' StoreData
storeData [Text]
rest
[Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ Text
nameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
next
AskDepsChoice
No -> StoreData -> [Text] -> IO [Text]
interactiveAskDeps' StoreData
storeData [Text]
rest
AskDepsChoice
View -> do
let Just Migration
m = StoreData -> Text -> Maybe Migration
storeLookup StoreData
storeData Text
name
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ Migration -> Maybe Text
mDesc Migration
m)
([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
" Description: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Migration -> Maybe Text
mDesc Migration
m))
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" Created: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe UTCTime -> [Char]
forall a. Show a => a -> [Char]
show (Migration -> Maybe UTCTime
mTimestamp Migration
m)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Migration -> [Text]
mDeps Migration
m)
([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
" Deps: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate Text
"\n " (Migration -> [Text]
mDeps Migration
m))
StoreData -> [Text] -> IO [Text]
interactiveAskDeps' StoreData
storeData (Text
nameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
rest)
AskDepsChoice
Quit -> do
[Char] -> IO ()
putStrLn [Char]
"cancelled."
ExitCode -> IO [Text]
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
AskDepsChoice
Done -> [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
askDepsChoices :: PromptChoices AskDepsChoice
askDepsChoices :: PromptChoices AskDepsChoice
askDepsChoices = [ (Char
'y', (AskDepsChoice
Yes, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"yes, depend on this migration"))
, (Char
'n', (AskDepsChoice
No, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"no, do not depend on this migration"))
, (Char
'v', (AskDepsChoice
View, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"view migration details"))
, (Char
'd', (AskDepsChoice
Done, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"done, do not ask me about more dependencies"))
, (Char
'q', (AskDepsChoice
Quit, [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"cancel this operation and quit"))
]
spanList :: ([a] -> Bool) -> [a] -> ([a], [a])
spanList :: ([a] -> Bool) -> [a] -> ([a], [a])
spanList [a] -> Bool
_ [] = ([],[])
spanList [a] -> Bool
func list :: [a]
list@(a
x:[a]
xs) =
if [a] -> Bool
func [a]
list
then (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys,[a]
zs)
else ([],[a]
list)
where ([a]
ys,[a]
zs) = ([a] -> Bool) -> [a] -> ([a], [a])
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
spanList [a] -> Bool
func [a]
xs
breakList :: ([a] -> Bool) -> [a] -> ([a], [a])
breakList :: ([a] -> Bool) -> [a] -> ([a], [a])
breakList [a] -> Bool
func = ([a] -> Bool) -> [a] -> ([a], [a])
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
spanList (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
func)
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace :: [a] -> [a] -> [a] -> [a]
replace [a]
old [a]
new = [a] -> [[a]] -> [a]
forall a. [a] -> [[a]] -> [a]
intercalate [a]
new ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [[a]]
forall a. Eq a => [a] -> [a] -> [[a]]
split [a]
old
split :: Eq a => [a] -> [a] -> [[a]]
split :: [a] -> [a] -> [[a]]
split [a]
_ [] = []
split [a]
delim [a]
str =
let ([a]
firstline, [a]
remainder) = ([a] -> Bool) -> [a] -> ([a], [a])
forall a. ([a] -> Bool) -> [a] -> ([a], [a])
breakList ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
delim) [a]
str
in [a]
firstline [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: case [a]
remainder of
[] -> []
[a]
x -> if [a]
x [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
delim
then [[]]
else [a] -> [a] -> [[a]]
forall a. Eq a => [a] -> [a] -> [[a]]
split [a]
delim (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
delim) [a]
x)