{-# 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
  -- Get the list of migrations to apply
  [Migration]
toApply <- StoreData -> Backend -> Migration -> IO [Migration]
migrationsToApply StoreData
storeData Backend
backend Migration
m

  -- Apply them
  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
  -- Get the list of migrations to revert
  [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

  -- Revert them
  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'

-- Given an action that needs a database connection, connect to the
-- database using the backend and invoke the action
-- with the connection. Return its result.
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)

-- Given a migration name and selected dependencies, get the user's
-- confirmation that a migration should be created.
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 the user for a choice, given a prompt and a list of possible
-- choices.  Let the user get help for the available choices, and loop
-- until the user makes a valid choice.
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"))]

-- Given a PromptChoices, build a multi-line help string for those
-- choices using the description information in the choice list.
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 ]

-- Does the specified prompt choice list have any help messages in it?
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

-- A general type for a set of choices that the user can make at a
-- prompt.
type PromptChoices a = [(Char, (a, Maybe String))]

-- Get an input character in non-buffered mode, then restore the
-- original buffering setting.
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

-- The types for choices the user can make when being prompted for
-- dependencies.
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)

-- Interactively ask the user about which dependencies should be used
-- when creating a new migration.
interactiveAskDeps :: StoreData -> IO [Text]
interactiveAskDeps :: StoreData -> IO [Text]
interactiveAskDeps StoreData
storeData = do
  -- For each migration in the store, starting with the most recently
  -- added, ask the user if it should be added to a dependency list
  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)

-- Recursive function to prompt the user for dependencies and let the
-- user view information about potential dependencies.  Returns a list
-- of migration names which were selected.
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
            -- load migration
            let Just Migration
m = StoreData -> Text -> Maybe Migration
storeLookup StoreData
storeData Text
name
            -- print out description, timestamp, deps
            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))
            -- ask again
            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 []

-- The choices the user can make when being prompted for dependencies.
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"))
                 ]

-- The following code is vendored from MissingH Data.List.Utils:

{- | Similar to Data.List.span, but performs the test on the entire remaining
list instead of just one element.

@spanList p xs@ is the same as @(takeWhileList p xs, dropWhileList p xs)@
-}
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

{- | Similar to Data.List.break, but performs the test on the entire remaining
list instead of just one element.
-}
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)