{-# LANGUAGE Rank2Types #-}
module Summoner.Tui.Validation
( ctrlD
, summonFormValidation
, formErrorMessages
, handleAutofill
, projectDescNewLine
) where
import Brick.Forms (formState, invalidFields, setFieldValid, setFormFocus)
import Lens.Micro (Lens', (%~), (.~), (^.))
import Relude.Extra.Enum (universe)
import Validation (Validation (..))
import Summoner.Text (moduleNameValid, packageNameValid, packageToModule)
import Summoner.Tui.Form (KitForm, SummonForm (..), getCurrentFocus, mkForm)
import Summoner.Tui.Kit
import qualified Data.Text as T
ctrlD :: KitForm e -> KitForm e
ctrlD :: KitForm e -> KitForm e
ctrlD =
Text
-> SummonForm -> Lens' SummonKit Text -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField "" SummonForm
UserFullName ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasFullName s a => Lens' s a
fullName)
(KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> SummonForm -> Lens' SummonKit Text -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField "" SummonForm
UserEmail ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasEmail s a => Lens' s a
email)
(KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> SummonForm -> Lens' SummonKit Text -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField "" SummonForm
ProjectName ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasRepo s a => Lens' s a
repo)
(KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> SummonForm -> Lens' SummonKit Text -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField "" SummonForm
ProjectDesc ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasDesc s a => Lens' s a
desc)
(KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> SummonForm -> Lens' SummonKit Text -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField "" SummonForm
ProjectCat ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasCategory s a => Lens' s a
category)
(KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> SummonForm -> Lens' SummonKit Text -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField "" SummonForm
CustomPreludeName ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> ProjectMeta -> f ProjectMeta)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> ProjectMeta -> f ProjectMeta
forall s a. HasPreludeName s a => Lens' s a
preludeName)
(KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> SummonForm -> Lens' SummonKit Text -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField "" SummonForm
CustomPreludeModule ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> ProjectMeta -> f ProjectMeta)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> ProjectMeta -> f ProjectMeta
forall s a. HasPreludeModule s a => Lens' s a
preludeModule)
(KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GhcVer]
-> SummonForm -> Lens' SummonKit [GhcVer] -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField [] SummonForm
Ghcs ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> (([GhcVer] -> f [GhcVer]) -> ProjectMeta -> f ProjectMeta)
-> ([GhcVer] -> f [GhcVer])
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GhcVer] -> f [GhcVer]) -> ProjectMeta -> f ProjectMeta
forall s a. HasGhcs s a => Lens' s a
ghcs)
(KitForm e -> KitForm e)
-> (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> SummonForm -> Lens' SummonKit Text -> KitForm e -> KitForm e
forall a e.
a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField "" SummonForm
UserOwner ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasOwner s a => Lens' s a
owner)
where
clearField :: a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField :: a -> SummonForm -> Lens' SummonKit a -> KitForm e -> KitForm e
clearField nil :: a
nil formField :: SummonForm
formField fieldLens :: Lens' SummonKit a
fieldLens f :: KitForm e
f =
if KitForm e -> Maybe SummonForm
forall s e n. Form s e n -> Maybe n
getCurrentFocus KitForm e
f Maybe SummonForm -> Maybe SummonForm -> Bool
forall a. Eq a => a -> a -> Bool
== SummonForm -> Maybe SummonForm
forall a. a -> Maybe a
Just SummonForm
formField
then SummonForm -> KitForm e -> KitForm e
forall n s e. Eq n => n -> Form s e n -> Form s e n
setFormFocus SummonForm
formField (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall a b. (a -> b) -> a -> b
$ SummonKit -> KitForm e
forall e. SummonKit -> KitForm e
mkForm (SummonKit -> KitForm e) -> SummonKit -> KitForm e
forall a b. (a -> b) -> a -> b
$ KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
f SummonKit -> (SummonKit -> SummonKit) -> SummonKit
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> SummonKit -> Identity SummonKit
Lens' SummonKit a
fieldLens ((a -> Identity a) -> SummonKit -> Identity SummonKit)
-> a -> SummonKit -> SummonKit
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
nil
else KitForm e
f
handleAutofill :: KitForm e -> KitForm e
handleAutofill :: KitForm e -> KitForm e
handleAutofill f :: KitForm e
f = case KitForm e -> Maybe SummonForm
forall s e n. Form s e n -> Maybe n
getCurrentFocus KitForm e
f of
Just CustomPreludeName ->
let curPreludeName :: Text
curPreludeName = KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
f SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text)
-> ProjectMeta -> Const Text ProjectMeta)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ProjectMeta -> Const Text ProjectMeta
forall s a. HasPreludeName s a => Lens' s a
preludeName
newState :: SummonKit
newState = KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
f
SummonKit -> (SummonKit -> SummonKit) -> SummonKit
forall a b. a -> (a -> b) -> b
& (ProjectMeta -> Identity ProjectMeta)
-> SummonKit -> Identity SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Identity ProjectMeta)
-> SummonKit -> Identity SummonKit)
-> ((Text -> Identity Text) -> ProjectMeta -> Identity ProjectMeta)
-> (Text -> Identity Text)
-> SummonKit
-> Identity SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text) -> ProjectMeta -> Identity ProjectMeta
forall s a. HasPreludeModule s a => Lens' s a
preludeModule ((Text -> Identity Text) -> SummonKit -> Identity SummonKit)
-> Text -> SummonKit -> SummonKit
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Text
packageToModule Text
curPreludeName
in SummonForm -> KitForm e -> KitForm e
forall n s e. Eq n => n -> Form s e n -> Form s e n
setFormFocus SummonForm
CustomPreludeName (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall a b. (a -> b) -> a -> b
$ SummonKit -> KitForm e
forall e. SummonKit -> KitForm e
mkForm SummonKit
newState
_ -> KitForm e
f
projectDescNewLine :: KitForm e -> KitForm e
projectDescNewLine :: KitForm e -> KitForm e
projectDescNewLine f :: KitForm e
f =
if KitForm e -> Maybe SummonForm
forall s e n. Form s e n -> Maybe n
getCurrentFocus KitForm e
f Maybe SummonForm -> Maybe SummonForm -> Bool
forall a. Eq a => a -> a -> Bool
== SummonForm -> Maybe SummonForm
forall a. a -> Maybe a
Just SummonForm
ProjectDesc
then SummonForm -> KitForm e -> KitForm e
forall n s e. Eq n => n -> Form s e n -> Form s e n
setFormFocus SummonForm
ProjectDesc (KitForm e -> KitForm e) -> KitForm e -> KitForm e
forall a b. (a -> b) -> a -> b
$ SummonKit -> KitForm e
forall e. SummonKit -> KitForm e
mkForm (SummonKit -> KitForm e) -> SummonKit -> KitForm e
forall a b. (a -> b) -> a -> b
$ KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
f SummonKit -> (SummonKit -> SummonKit) -> SummonKit
forall a b. a -> (a -> b) -> b
& (Project -> Identity Project) -> SummonKit -> Identity SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> Identity Project) -> SummonKit -> Identity SummonKit)
-> ((Text -> Identity Text) -> Project -> Identity Project)
-> (Text -> Identity Text)
-> SummonKit
-> Identity SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text) -> Project -> Identity Project
forall s a. HasDesc s a => Lens' s a
desc ((Text -> Identity Text) -> SummonKit -> Identity SummonKit)
-> (Text -> Text) -> SummonKit -> SummonKit
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n")
else KitForm e
f
summonFormValidation :: forall e . [FilePath] -> KitForm e -> KitForm e
summonFormValidation :: [FilePath] -> KitForm e -> KitForm e
summonFormValidation dirs :: [FilePath]
dirs kitForm :: KitForm e
kitForm = (SummonForm -> KitForm e -> KitForm e)
-> KitForm e -> [SummonForm] -> KitForm e
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SummonForm -> KitForm e -> KitForm e
setValidation KitForm e
kitForm [SummonForm]
forall a. (Bounded a, Enum a) => [a]
universe
where
kit :: SummonKit
kit :: SummonKit
kit = KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
kitForm
wrongFields :: [SummonForm]
wrongFields :: [SummonForm]
wrongFields = case [FilePath] -> SummonKit -> Validation (NonEmpty FormError) ()
validateKit [FilePath]
dirs SummonKit
kit of
Success _ -> []
Failure errors :: NonEmpty FormError
errors -> (FormError -> [SummonForm]) -> NonEmpty FormError -> [SummonForm]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty SummonForm -> [SummonForm]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty SummonForm -> [SummonForm])
-> (FormError -> NonEmpty SummonForm) -> FormError -> [SummonForm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormError -> NonEmpty SummonForm
errorToInvalidFields) NonEmpty FormError
errors
setValidation :: SummonForm -> KitForm e -> KitForm e
setValidation :: SummonForm -> KitForm e -> KitForm e
setValidation field :: SummonForm
field = Bool -> SummonForm -> KitForm e -> KitForm e
forall n s e. Eq n => Bool -> n -> Form s e n -> Form s e n
setFieldValid (SummonForm
field SummonForm -> [SummonForm] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [SummonForm]
wrongFields) SummonForm
field
data FormError
= EmptyFields (NonEmpty SummonForm)
| OneWord (NonEmpty SummonForm)
| ProjectExist
| CabalOrStack
| LibOrExe
| PreludePackageError
| PreludeModuleError
showFormError :: FormError -> String
showFormError :: FormError -> FilePath
showFormError = \case
ProjectExist -> "Directory with such name already exists"
CabalOrStack -> "Choose at least one: Cabal or Stack"
LibOrExe -> "Choose at least one: Library or Executable"
EmptyFields fields :: NonEmpty SummonForm
fields -> "These fields must not be empty: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NonEmpty SummonForm -> FilePath
joinFields NonEmpty SummonForm
fields
OneWord fields :: NonEmpty SummonForm
fields -> "These fields should contain exactly one word: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NonEmpty SummonForm -> FilePath
joinFields NonEmpty SummonForm
fields
PreludePackageError -> "Prelude package should only contain letters, numbers and hyphens"
PreludeModuleError -> "Prelude module name could only contain dot-separated capitalized letter/numeral fragments. Ex: This.Is.Valid1"
where
joinFields :: NonEmpty SummonForm -> String
joinFields :: NonEmpty SummonForm -> FilePath
joinFields = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([FilePath] -> FilePath)
-> (NonEmpty SummonForm -> [FilePath])
-> NonEmpty SummonForm
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SummonForm -> Maybe FilePath) -> [SummonForm] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SummonForm -> Maybe FilePath
showField ([SummonForm] -> [FilePath])
-> (NonEmpty SummonForm -> [SummonForm])
-> NonEmpty SummonForm
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty SummonForm -> [SummonForm]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
showField :: SummonForm -> Maybe String
showField :: SummonForm -> Maybe FilePath
showField = \case
UserOwner -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "Owner"
UserFullName -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "Full name"
UserEmail -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "Email"
ProjectName -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "Name"
ProjectDesc -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "Description"
ProjectCat -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "Category"
CustomPreludeName -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "Prelude name"
CustomPreludeModule -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "Module"
_ -> Maybe FilePath
forall a. Maybe a
Nothing
errorToInvalidFields :: FormError -> NonEmpty SummonForm
errorToInvalidFields :: FormError -> NonEmpty SummonForm
errorToInvalidFields = \case
EmptyFields fields :: NonEmpty SummonForm
fields -> NonEmpty SummonForm
fields
OneWord fields :: NonEmpty SummonForm
fields -> NonEmpty SummonForm
fields
ProjectExist -> OneItem (NonEmpty SummonForm) -> NonEmpty SummonForm
forall x. One x => OneItem x -> x
one OneItem (NonEmpty SummonForm)
SummonForm
ProjectName
CabalOrStack -> SummonForm
CabalField SummonForm -> [SummonForm] -> NonEmpty SummonForm
forall a. a -> [a] -> NonEmpty a
:| [SummonForm
StackField]
LibOrExe -> SummonForm
Lib SummonForm -> [SummonForm] -> NonEmpty SummonForm
forall a. a -> [a] -> NonEmpty a
:| [SummonForm
Exe]
PreludePackageError -> OneItem (NonEmpty SummonForm) -> NonEmpty SummonForm
forall x. One x => OneItem x -> x
one OneItem (NonEmpty SummonForm)
SummonForm
CustomPreludeName
PreludeModuleError -> OneItem (NonEmpty SummonForm) -> NonEmpty SummonForm
forall x. One x => OneItem x -> x
one OneItem (NonEmpty SummonForm)
SummonForm
CustomPreludeModule
toError :: Bool -> e -> Validation (NonEmpty e) ()
toError :: Bool -> e -> Validation (NonEmpty e) ()
toError p :: Bool
p e :: e
e = if Bool
p then NonEmpty e -> Validation (NonEmpty e) ()
forall e a. e -> Validation e a
Failure (OneItem (NonEmpty e) -> NonEmpty e
forall x. One x => OneItem x -> x
one e
OneItem (NonEmpty e)
e) else () -> Validation (NonEmpty e) ()
forall e a. a -> Validation e a
Success ()
validateKit :: [FilePath] -> SummonKit -> Validation (NonEmpty FormError) ()
validateKit :: [FilePath] -> SummonKit -> Validation (NonEmpty FormError) ()
validateKit dirs :: [FilePath]
dirs kit :: SummonKit
kit =
Validation (NonEmpty FormError) ()
validateEmpty
Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Validation (NonEmpty FormError) ()
validateOneWord
Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Validation (NonEmpty FormError) ()
validateProjectExist
Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Validation (NonEmpty FormError) ()
validateBuildTools
Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Validation (NonEmpty FormError) ()
validateLibOrExe
Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Validation (NonEmpty FormError) ()
validatePreludePackage
Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
-> Validation (NonEmpty FormError) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Validation (NonEmpty FormError) ()
validatePreludeModule
where
liftValidation
:: (e -> FormError)
-> Validation e ()
-> Validation (NonEmpty FormError) ()
liftValidation :: (e -> FormError)
-> Validation e () -> Validation (NonEmpty FormError) ()
liftValidation mkError :: e -> FormError
mkError = (e -> NonEmpty FormError)
-> Validation e () -> Validation (NonEmpty FormError) ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FormError -> NonEmpty FormError
forall x. One x => OneItem x -> x
one (FormError -> NonEmpty FormError)
-> (e -> FormError) -> e -> NonEmpty FormError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> FormError
mkError)
validateEmpty :: Validation (NonEmpty FormError) ()
validateEmpty :: Validation (NonEmpty FormError) ()
validateEmpty = (NonEmpty SummonForm -> FormError)
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty FormError) ()
forall e.
(e -> FormError)
-> Validation e () -> Validation (NonEmpty FormError) ()
liftValidation NonEmpty SummonForm -> FormError
EmptyFields Validation (NonEmpty SummonForm) ()
validateFields
where
validateFields :: Validation (NonEmpty SummonForm) ()
validateFields :: Validation (NonEmpty SummonForm) ()
validateFields =
Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasOwner s a => Lens' s a
owner) SummonForm
UserOwner
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasFullName s a => Lens' s a
fullName) SummonForm
UserFullName
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasEmail s a => Lens' s a
email) SummonForm
UserEmail
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasRepo s a => Lens' s a
repo) SummonForm
ProjectName
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasDesc s a => Lens' s a
desc) SummonForm
ProjectDesc
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> SummonForm -> Validation (NonEmpty SummonForm) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
toError Bool
isEmptyPrelude SummonForm
CustomPreludeModule
checkField :: Lens' SummonKit Text -> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField :: Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField textL :: Lens' SummonKit Text
textL = Bool -> SummonForm -> Validation (NonEmpty SummonForm) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
toError (Bool -> SummonForm -> Validation (NonEmpty SummonForm) ())
-> Bool -> SummonForm -> Validation (NonEmpty SummonForm) ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isEmpty (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ SummonKit
kit SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text SummonKit Text
Lens' SummonKit Text
textL
isEmpty :: Text -> Bool
isEmpty :: Text -> Bool
isEmpty t :: Text
t = Text -> Text
T.strip Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ""
isEmptyPrelude :: Bool
isEmptyPrelude :: Bool
isEmptyPrelude =
Bool -> Bool
not (Text -> Bool
isEmpty (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ SummonKit
kit SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text)
-> ProjectMeta -> Const Text ProjectMeta)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ProjectMeta -> Const Text ProjectMeta
forall s a. HasPreludeName s a => Lens' s a
preludeName)
Bool -> Bool -> Bool
&& Text -> Bool
isEmpty (SummonKit
kit SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text)
-> ProjectMeta -> Const Text ProjectMeta)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ProjectMeta -> Const Text ProjectMeta
forall s a. HasPreludeModule s a => Lens' s a
preludeModule)
validateOneWord :: Validation (NonEmpty FormError) ()
validateOneWord :: Validation (NonEmpty FormError) ()
validateOneWord = (NonEmpty SummonForm -> FormError)
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty FormError) ()
forall e.
(e -> FormError)
-> Validation e () -> Validation (NonEmpty FormError) ()
liftValidation NonEmpty SummonForm -> FormError
OneWord Validation (NonEmpty SummonForm) ()
validateFields
where
validateFields :: Validation (NonEmpty SummonForm) ()
validateFields :: Validation (NonEmpty SummonForm) ()
validateFields =
Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasOwner s a => Lens' s a
owner) SummonForm
UserOwner
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((User -> f User) -> SummonKit -> f SummonKit
forall s a. HasUser s a => Lens' s a
user ((User -> f User) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> User -> f User)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> User -> f User
forall s a. HasEmail s a => Lens' s a
email) SummonForm
UserEmail
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((Project -> f Project) -> SummonKit -> f SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> f Project) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> Project -> f Project)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Project -> f Project
forall s a. HasRepo s a => Lens' s a
repo) SummonForm
ProjectName
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> ProjectMeta -> f ProjectMeta)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> ProjectMeta -> f ProjectMeta
forall s a. HasPreludeName s a => Lens' s a
preludeName) SummonForm
CustomPreludeName
Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
-> Validation (NonEmpty SummonForm) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> f ProjectMeta) -> SummonKit -> f SummonKit)
-> ((Text -> f Text) -> ProjectMeta -> f ProjectMeta)
-> (Text -> f Text)
-> SummonKit
-> f SummonKit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> ProjectMeta -> f ProjectMeta
forall s a. HasPreludeModule s a => Lens' s a
preludeModule) SummonForm
CustomPreludeModule
checkField :: Lens' SummonKit Text -> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField :: Lens' SummonKit Text
-> SummonForm -> Validation (NonEmpty SummonForm) ()
checkField textL :: Lens' SummonKit Text
textL = Bool -> SummonForm -> Validation (NonEmpty SummonForm) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
toError ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
forall t. IsText t "words" => t -> [t]
words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ SummonKit
kit SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text SummonKit Text
Lens' SummonKit Text
textL) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1)
validateProjectExist :: Validation (NonEmpty FormError) ()
validateProjectExist :: Validation (NonEmpty FormError) ()
validateProjectExist = Bool -> FormError -> Validation (NonEmpty FormError) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
toError
(Text -> FilePath
forall a. ToString a => a -> FilePath
toString (SummonKit
kit SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (Project -> Const Text Project)
-> SummonKit -> Const Text SummonKit
forall s a. HasProject s a => Lens' s a
project ((Project -> Const Text Project)
-> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text) -> Project -> Const Text Project)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Project -> Const Text Project
forall s a. HasRepo s a => Lens' s a
repo) FilePath -> [FilePath] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [FilePath]
dirs)
FormError
ProjectExist
validateBuildTools :: Validation (NonEmpty FormError) ()
validateBuildTools :: Validation (NonEmpty FormError) ()
validateBuildTools = Bool -> FormError -> Validation (NonEmpty FormError) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
toError
(Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SummonKit
kit SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool SummonKit Bool
forall s a. HasCabal s a => Lens' s a
cabal Bool -> Bool -> Bool
|| SummonKit
kit SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool SummonKit Bool
forall s a. HasStack s a => Lens' s a
stack)
FormError
CabalOrStack
validateLibOrExe :: Validation (NonEmpty FormError) ()
validateLibOrExe :: Validation (NonEmpty FormError) ()
validateLibOrExe = Bool -> FormError -> Validation (NonEmpty FormError) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
toError
(Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SummonKit
kit SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Bool ProjectMeta)
-> SummonKit -> Const Bool SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Bool ProjectMeta)
-> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool)
-> ProjectMeta -> Const Bool ProjectMeta)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> ProjectMeta -> Const Bool ProjectMeta
forall s a. HasLib s a => Lens' s a
lib Bool -> Bool -> Bool
|| SummonKit
kit SummonKit -> Getting Bool SummonKit Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Bool ProjectMeta)
-> SummonKit -> Const Bool SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Bool ProjectMeta)
-> SummonKit -> Const Bool SummonKit)
-> ((Bool -> Const Bool Bool)
-> ProjectMeta -> Const Bool ProjectMeta)
-> Getting Bool SummonKit Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> ProjectMeta -> Const Bool ProjectMeta
forall s a. HasExe s a => Lens' s a
exe)
FormError
LibOrExe
validatePreludePackage :: Validation (NonEmpty FormError) ()
validatePreludePackage :: Validation (NonEmpty FormError) ()
validatePreludePackage = Bool -> FormError -> Validation (NonEmpty FormError) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
toError
(Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
packageName Bool -> Bool -> Bool
|| Text -> Bool
packageNameValid Text
packageName)
FormError
PreludePackageError
where
packageName :: Text
packageName :: Text
packageName = SummonKit
kit SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text)
-> ProjectMeta -> Const Text ProjectMeta)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ProjectMeta -> Const Text ProjectMeta
forall s a. HasPreludeName s a => Lens' s a
preludeName
validatePreludeModule :: Validation (NonEmpty FormError) ()
validatePreludeModule :: Validation (NonEmpty FormError) ()
validatePreludeModule = Bool -> FormError -> Validation (NonEmpty FormError) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
toError
(Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
moduleName Bool -> Bool -> Bool
|| Text -> Bool
moduleNameValid Text
moduleName)
FormError
PreludeModuleError
where
moduleName :: Text
moduleName :: Text
moduleName = SummonKit
kit SummonKit -> Getting Text SummonKit Text -> Text
forall s a. s -> Getting a s a -> a
^. (ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit
forall s a. HasProjectMeta s a => Lens' s a
projectMeta ((ProjectMeta -> Const Text ProjectMeta)
-> SummonKit -> Const Text SummonKit)
-> ((Text -> Const Text Text)
-> ProjectMeta -> Const Text ProjectMeta)
-> Getting Text SummonKit Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ProjectMeta -> Const Text ProjectMeta
forall s a. HasPreludeModule s a => Lens' s a
preludeModule
formErrorMessages :: [FilePath] -> KitForm e -> [String]
formErrorMessages :: [FilePath] -> KitForm e -> [FilePath]
formErrorMessages dirs :: [FilePath]
dirs kitForm :: KitForm e
kitForm = [FilePath]
validatedErrorMessages [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
ghcErrorMessage
where
validatedErrorMessages :: [String]
validatedErrorMessages :: [FilePath]
validatedErrorMessages = case [FilePath] -> SummonKit -> Validation (NonEmpty FormError) ()
validateKit [FilePath]
dirs (KitForm e -> SummonKit
forall s e n. Form s e n -> s
formState KitForm e
kitForm) of
Success _ -> []
Failure errors :: NonEmpty FormError
errors -> (FormError -> FilePath) -> [FormError] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FormError -> FilePath
showFormError ([FormError] -> [FilePath]) -> [FormError] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ NonEmpty FormError -> [FormError]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty FormError
errors
ghcErrorMessage :: [String]
ghcErrorMessage :: [FilePath]
ghcErrorMessage =
["Some GHC versions failed to parse: use space-separated valid GHC versions"
| SummonForm
Ghcs SummonForm -> [SummonForm] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` KitForm e -> [SummonForm]
forall s e n. Form s e n -> [n]
invalidFields KitForm e
kitForm
]