Merge branch 'master' into sshpassword

This commit is contained in:
Joey Hess 2014-05-14 12:43:34 -04:00
commit db8590791f
254 changed files with 21262 additions and 17210 deletions

View file

@ -0,0 +1,284 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-- | Helper functions for creating forms when using Bootstrap v3.
-- This is a copy of the Yesod.Form.Bootstrap3 module that has been slightly
-- modified to be compatible with Yesod 1.0.1
module Assistant.WebApp.Bootstrap3
( -- * Rendering forms
renderBootstrap3
, BootstrapFormLayout(..)
, BootstrapGridOptions(..)
-- * Field settings
, bfs
, withPlaceholder
, withAutofocus
, withLargeInput
, withSmallInput
-- * Submit button
, bootstrapSubmit
, mbootstrapSubmit
, BootstrapSubmit(..)
) where
import Control.Arrow (second)
import Control.Monad (liftM)
import Data.Text (Text)
import Data.String (IsString(..))
import Yesod.Core
import qualified Data.Text as T
import Yesod.Form.Types
import Yesod.Form.Functions
-- | Create a new 'FieldSettings' with the classes that are
-- required by Bootstrap v3.
--
-- Since: yesod-form 1.3.8
bfs :: RenderMessage site msg => msg -> FieldSettings site
bfs msg =
FieldSettings (SomeMessage msg) Nothing Nothing Nothing [("class", "form-control")]
-- | Add a placeholder attribute to a field. If you need i18n
-- for the placeholder, currently you\'ll need to do a hack and
-- use 'getMessageRender' manually.
--
-- Since: yesod-form 1.3.8
withPlaceholder :: Text -> FieldSettings site -> FieldSettings site
withPlaceholder placeholder fs = fs { fsAttrs = newAttrs }
where newAttrs = ("placeholder", placeholder) : fsAttrs fs
-- | Add an autofocus attribute to a field.
--
-- Since: yesod-form 1.3.8
withAutofocus :: FieldSettings site -> FieldSettings site
withAutofocus fs = fs { fsAttrs = newAttrs }
where newAttrs = ("autofocus", "autofocus") : fsAttrs fs
-- | Add the @input-lg@ CSS class to a field.
--
-- Since: yesod-form 1.3.8
withLargeInput :: FieldSettings site -> FieldSettings site
withLargeInput fs = fs { fsAttrs = newAttrs }
where newAttrs = addClass "input-lg" (fsAttrs fs)
-- | Add the @input-sm@ CSS class to a field.
--
-- Since: yesod-form 1.3.8
withSmallInput :: FieldSettings site -> FieldSettings site
withSmallInput fs = fs { fsAttrs = newAttrs }
where newAttrs = addClass "input-sm" (fsAttrs fs)
addClass :: Text -> [(Text, Text)] -> [(Text, Text)]
addClass klass [] = [("class", klass)]
addClass klass (("class", old):rest) = ("class", T.concat [old, " ", klass]) : rest
addClass klass (other :rest) = other : addClass klass rest
-- | How many bootstrap grid columns should be taken (see
-- 'BootstrapFormLayout').
--
-- Since: yesod-form 1.3.8
data BootstrapGridOptions =
ColXs !Int
| ColSm !Int
| ColMd !Int
| ColLg !Int
deriving (Eq, Ord, Show)
toColumn :: BootstrapGridOptions -> String
toColumn (ColXs 0) = ""
toColumn (ColSm 0) = ""
toColumn (ColMd 0) = ""
toColumn (ColLg 0) = ""
toColumn (ColXs columns) = "col-xs-" ++ show columns
toColumn (ColSm columns) = "col-sm-" ++ show columns
toColumn (ColMd columns) = "col-md-" ++ show columns
toColumn (ColLg columns) = "col-lg-" ++ show columns
toOffset :: BootstrapGridOptions -> String
toOffset (ColXs 0) = ""
toOffset (ColSm 0) = ""
toOffset (ColMd 0) = ""
toOffset (ColLg 0) = ""
toOffset (ColXs columns) = "col-xs-offset-" ++ show columns
toOffset (ColSm columns) = "col-sm-offset-" ++ show columns
toOffset (ColMd columns) = "col-md-offset-" ++ show columns
toOffset (ColLg columns) = "col-lg-offset-" ++ show columns
addGO :: BootstrapGridOptions -> BootstrapGridOptions -> BootstrapGridOptions
addGO (ColXs a) (ColXs b) = ColXs (a+b)
addGO (ColSm a) (ColSm b) = ColSm (a+b)
addGO (ColMd a) (ColMd b) = ColMd (a+b)
addGO (ColLg a) (ColLg b) = ColLg (a+b)
addGO a b | a > b = addGO b a
addGO (ColXs a) other = addGO (ColSm a) other
addGO (ColSm a) other = addGO (ColMd a) other
addGO (ColMd a) other = addGO (ColLg a) other
addGO (ColLg _) _ = error "Yesod.Form.Bootstrap.addGO: never here"
-- | The layout used for the bootstrap form.
--
-- Since: yesod-form 1.3.8
data BootstrapFormLayout =
BootstrapBasicForm
| BootstrapInlineForm
| BootstrapHorizontalForm
{ bflLabelOffset :: !BootstrapGridOptions
, bflLabelSize :: !BootstrapGridOptions
, bflInputOffset :: !BootstrapGridOptions
, bflInputSize :: !BootstrapGridOptions
}
deriving (Show)
-- | Render the given form using Bootstrap v3 conventions.
--
-- Sample Hamlet for 'BootstrapHorizontalForm':
--
-- > <form .form-horizontal role=form method=post action=@{ActionR} enctype=#{formEnctype}>
-- > ^{formWidget}
-- > ^{bootstrapSubmit MsgSubmit}
--
-- Since: yesod-form 1.3.8
#if MIN_VERSION_yesod(1,2,0)
renderBootstrap3 :: Monad m => BootstrapFormLayout -> FormRender m a
#else
renderBootstrap3 :: BootstrapFormLayout -> FormRender sub master a
#endif
renderBootstrap3 formLayout aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
has (Just _) = True
has Nothing = False
widget = [whamlet|
#if MIN_VERSION_yesod(1,2,0)
$newline never
#endif
#{fragment}
$forall view <- views
<div .form-group :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.has-error>
$case formLayout
$of BootstrapBasicForm
$if nequals (fvId view) bootstrapSubmitId
<label for=#{fvId view}>#{fvLabel view}
^{fvInput view}
^{helpWidget view}
$of BootstrapInlineForm
$if nequals (fvId view) bootstrapSubmitId
<label .sr-only for=#{fvId view}>#{fvLabel view}
^{fvInput view}
^{helpWidget view}
$of f@(BootstrapHorizontalForm _ _ _ _)
$if nequals (fvId view) bootstrapSubmitId
<label .control-label .#{toOffset (bflLabelOffset f)} .#{toColumn (bflLabelSize f)} for=#{fvId view}>#{fvLabel view}
<div .#{toOffset (bflInputOffset f)} .#{toColumn (bflInputSize f)}>
^{fvInput view}
^{helpWidget view}
$else
<div .#{toOffset (addGO (bflInputOffset f) (addGO (bflLabelOffset f) (bflLabelSize f)))} .#{toColumn (bflInputSize f)}>
^{fvInput view}
^{helpWidget view}
|]
return (res, widget)
where
nequals a b = a /= b -- work around older hamlet versions not liking /=
-- | (Internal) Render a help widget for tooltips and errors.
#if MIN_VERSION_yesod(1,2,0)
helpWidget :: FieldView site -> WidgetT site IO ()
#else
helpWidget :: FieldView sub master -> GWidget sub master ()
#endif
helpWidget view = [whamlet|
$maybe tt <- fvTooltip view
<span .help-block>#{tt}
$maybe err <- fvErrors view
<span .help-block>#{err}
|]
-- | How the 'bootstrapSubmit' button should be rendered.
--
-- Since: yesod-form 1.3.8
data BootstrapSubmit msg =
BootstrapSubmit
{ bsValue :: msg
-- ^ The text of the submit button.
, bsClasses :: Text
-- ^ Classes added to the @<button>@.
, bsAttrs :: [(Text, Text)]
-- ^ Attributes added to the @<button>@.
} deriving (Show)
instance IsString msg => IsString (BootstrapSubmit msg) where
fromString msg = BootstrapSubmit (fromString msg) " btn-default " []
-- | A Bootstrap v3 submit button disguised as a field for
-- convenience. For example, if your form currently is:
--
-- > Person <$> areq textField "Name" Nothing
-- > <*> areq textField "Surname" Nothing
--
-- Then just change it to:
--
-- > Person <$> areq textField "Name" Nothing
-- > <*> areq textField "Surname" Nothing
-- > <* bootstrapSubmit "Register"
--
-- (Note that @<*@ is not a typo.)
--
-- Alternatively, you may also just create the submit button
-- manually as well in order to have more control over its
-- layout.
--
-- Since: yesod-form 1.3.8
#if MIN_VERSION_yesod(1,2,0)
bootstrapSubmit
:: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
=> BootstrapSubmit msg -> AForm m ()
#else
bootstrapSubmit :: (RenderMessage master msg) => BootstrapSubmit msg -> AForm sub master ()
#endif
bootstrapSubmit = formToAForm . liftM (second return) . mbootstrapSubmit
-- | Same as 'bootstrapSubmit' but for monadic forms. This isn't
-- as useful since you're not going to use 'renderBootstrap3'
-- anyway.
--
-- Since: yesod-form 1.3.8
#if MIN_VERSION_yesod(1,2,0)
mbootstrapSubmit
:: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
=> BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
#else
mbootstrapSubmit :: (RenderMessage master msg) => BootstrapSubmit msg -> MForm sub master (FormResult (), FieldView sub master)
#endif
mbootstrapSubmit (BootstrapSubmit msg classes attrs) =
let res = FormSuccess ()
widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|]
fv = FieldView { fvLabel = ""
, fvTooltip = Nothing
, fvId = bootstrapSubmitId
, fvInput = widget
, fvErrors = Nothing
, fvRequired = False }
in return (res, fv)
-- | A royal hack. Magic id used to identify whether a field
-- should have no label. A valid HTML4 id which is probably not
-- going to clash with any other id should someone use
-- 'bootstrapSubmit' outside 'renderBootstrap3'.
bootstrapSubmitId :: Text
bootstrapSubmitId = "b:ootstrap___unique__:::::::::::::::::submit-id"

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Assistant.WebApp.Common (module X) where module Assistant.WebApp.Common (module X) where
import Assistant.Common as X import Assistant.Common as X
@ -13,6 +15,9 @@ import Assistant.WebApp.Page as X
import Assistant.WebApp.Form as X import Assistant.WebApp.Form as X
import Assistant.WebApp.Types as X import Assistant.WebApp.Types as X
import Assistant.WebApp.RepoId as X import Assistant.WebApp.RepoId as X
#if MIN_VERSION_yesod(1,2,0)
import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option) import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option)
#else
import Utility.Yesod as X hiding (textField, passwordField, selectField, selectFieldList, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option)
#endif
import Data.Text as X (Text) import Data.Text as X (Text)

View file

@ -68,8 +68,8 @@ s3InputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds) <$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds) <*> secretAccessKeyField (T.pack . snd <$> defcreds)
<*> datacenterField AWS.S3 <*> datacenterField AWS.S3
<*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy) <*> areq (selectFieldList storageclasses) (bfs "Storage class") (Just StandardRedundancy)
<*> areq textField "Repository name" (Just "S3") <*> areq textField (bfs "Repository name") (Just "S3")
<*> enableEncryptionField <*> enableEncryptionField
where where
storageclasses :: [(Text, StorageClass)] storageclasses :: [(Text, StorageClass)]
@ -84,7 +84,7 @@ glacierInputAForm defcreds = AWSInput
<*> secretAccessKeyField (T.pack . snd <$> defcreds) <*> secretAccessKeyField (T.pack . snd <$> defcreds)
<*> datacenterField AWS.Glacier <*> datacenterField AWS.Glacier
<*> pure StandardRedundancy <*> pure StandardRedundancy
<*> areq textField "Repository name" (Just "glacier") <*> areq textField (bfs "Repository name") (Just "glacier")
<*> enableEncryptionField <*> enableEncryptionField
awsCredsAForm :: Maybe CredPair -> MkAForm AWSCreds awsCredsAForm :: Maybe CredPair -> MkAForm AWSCreds
@ -93,7 +93,7 @@ awsCredsAForm defcreds = AWSCreds
<*> secretAccessKeyField (T.pack . snd <$> defcreds) <*> secretAccessKeyField (T.pack . snd <$> defcreds)
accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text
accessKeyIDField help = areq (textField `withNote` help) "Access Key ID" accessKeyIDField help = areq (textField `withNote` help) (bfs "Access Key ID")
accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
accessKeyIDFieldWithHelp = accessKeyIDField help accessKeyIDFieldWithHelp = accessKeyIDField help
@ -104,10 +104,10 @@ accessKeyIDFieldWithHelp = accessKeyIDField help
|] |]
secretAccessKeyField :: Maybe Text -> MkAForm Text secretAccessKeyField :: Maybe Text -> MkAForm Text
secretAccessKeyField = areq passwordField "Secret Access Key" secretAccessKeyField = areq passwordField (bfs "Secret Access Key")
datacenterField :: AWS.Service -> MkAForm Text datacenterField :: AWS.Service -> MkAForm Text
datacenterField service = areq (selectFieldList list) "Datacenter" defregion datacenterField service = areq (selectFieldList list) (bfs "Datacenter") defregion
where where
list = M.toList $ AWS.regionMap service list = M.toList $ AWS.regionMap service
defregion = Just $ AWS.defaultRegion service defregion = Just $ AWS.defaultRegion service
@ -120,7 +120,7 @@ postAddS3R :: Handler Html
postAddS3R = awsConfigurator $ do postAddS3R = awsConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ s3InputAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ s3InputAForm defcreds
case result of case result of
FormSuccess input -> liftH $ do FormSuccess input -> liftH $ do
let name = T.unpack $ repoName input let name = T.unpack $ repoName input
@ -143,7 +143,7 @@ postAddGlacierR :: Handler Html
postAddGlacierR = glacierConfigurator $ do postAddGlacierR = glacierConfigurator $ do
defcreds <- liftAnnex previouslyUsedAWSCreds defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ glacierInputAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ glacierInputAForm defcreds
case result of case result of
FormSuccess input -> liftH $ do FormSuccess input -> liftH $ do
let name = T.unpack $ repoName input let name = T.unpack $ repoName input
@ -186,7 +186,7 @@ enableAWSRemote :: RemoteType -> UUID -> Widget
enableAWSRemote remotetype uuid = do enableAWSRemote remotetype uuid = do
defcreds <- liftAnnex previouslyUsedAWSCreds defcreds <- liftAnnex previouslyUsedAWSCreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ awsCredsAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ awsCredsAForm defcreds
case result of case result of
FormSuccess creds -> liftH $ do FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog m <- liftAnnex readRemoteLog

View file

@ -89,8 +89,8 @@ deleteCurrentRepository = dangerPage $ do
havegitremotes <- haveremotes syncGitRemotes havegitremotes <- haveremotes syncGitRemotes
havedataremotes <- haveremotes syncDataRemotes havedataremotes <- haveremotes syncDataRemotes
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sanityVerifierAForm $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
SanityVerifier magicphrase sanityVerifierAForm $ SanityVerifier magicphrase
case result of case result of
FormSuccess _ -> liftH $ do FormSuccess _ -> liftH $ do
dir <- liftAnnex $ fromRepo Git.repoPath dir <- liftAnnex $ fromRepo Git.repoPath
@ -122,7 +122,7 @@ data SanityVerifier = SanityVerifier T.Text
sanityVerifierAForm :: SanityVerifier -> MkAForm SanityVerifier sanityVerifierAForm :: SanityVerifier -> MkAForm SanityVerifier
sanityVerifierAForm template = SanityVerifier sanityVerifierAForm template = SanityVerifier
<$> areq checksanity "Confirm deletion?" Nothing <$> areq checksanity (bfs "Confirm deletion?") Nothing
where where
checksanity = checkBool (\input -> SanityVerifier input == template) checksanity = checkBool (\input -> SanityVerifier input == template)
insane textField insane textField

View file

@ -142,9 +142,9 @@ setRepoConfig uuid mremote oldc newc = do
editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig
editRepositoryAForm mremote def = RepoConfig editRepositoryAForm mremote def = RepoConfig
<$> areq (if ishere then readonlyTextField else textField) <$> areq (if ishere then readonlyTextField else textField)
"Name" (Just $ repoName def) (bfs "Name") (Just $ repoName def)
<*> aopt textField "Description" (Just $ repoDescription def) <*> aopt textField (bfs "Description") (Just $ repoDescription def)
<*> areq (selectFieldList groups `withNote` help) "Repository group" (Just $ repoGroup def) <*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup def)
<*> associateddirectory <*> associateddirectory
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def) <*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
where where
@ -166,7 +166,7 @@ editRepositoryAForm mremote def = RepoConfig
associateddirectory = case repoAssociatedDirectory def of associateddirectory = case repoAssociatedDirectory def of
Nothing -> aopt hiddenField "" Nothing Nothing -> aopt hiddenField "" Nothing
Just d -> aopt textField "Associated directory" (Just $ Just d) Just d -> aopt textField (bfs "Associated directory") (Just $ Just d)
getEditRepositoryR :: RepoId -> Handler Html getEditRepositoryR :: RepoId -> Handler Html
getEditRepositoryR = postEditRepositoryR getEditRepositoryR = postEditRepositoryR
@ -195,7 +195,7 @@ editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do
curr <- liftAnnex $ getRepoConfig uuid mremote curr <- liftAnnex $ getRepoConfig uuid mremote
liftAnnex $ checkAssociatedDirectory curr mremote liftAnnex $ checkAssociatedDirectory curr mremote
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ editRepositoryAForm mremote curr runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ editRepositoryAForm mremote curr
case result of case result of
FormSuccess input -> liftH $ do FormSuccess input -> liftH $ do
setRepoConfig uuid mremote curr input setRepoConfig uuid mremote curr input

View file

@ -64,10 +64,10 @@ runFsckForm new activity = case activity of
u <- liftAnnex getUUID u <- liftAnnex getUUID
repolist <- liftAssistant (getrepolist ru) repolist <- liftAssistant (getrepolist ru)
runFormPostNoToken $ \msg -> do runFormPostNoToken $ \msg -> do
(reposRes, reposView) <- mreq (selectFieldList repolist) "" (Just ru) (reposRes, reposView) <- mreq (selectFieldList repolist) (bfs "") (Just ru)
(durationRes, durationView) <- mreq intField "" (Just $ durationSeconds d `quot` 60 ) (durationRes, durationView) <- mreq intField (bfs "") (Just $ durationSeconds d `quot` 60 )
(timeRes, timeView) <- mreq (selectFieldList times) "" (Just t) (timeRes, timeView) <- mreq (selectFieldList times) (bfs "") (Just t)
(recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) "" (Just r) (recurranceRes, recurranceView) <- mreq (selectFieldList recurrances) (bfs "") (Just r)
let form = do let form = do
webAppFormAuthToken webAppFormAuthToken
$(widgetFile "configurators/fsck/formcontent") $(widgetFile "configurators/fsck/formcontent")
@ -175,7 +175,8 @@ fsckPreferencesAForm def = FsckPreferences
runFsckPreferencesForm :: Handler ((FormResult FsckPreferences, Widget), Enctype) runFsckPreferencesForm :: Handler ((FormResult FsckPreferences, Widget), Enctype)
runFsckPreferencesForm = do runFsckPreferencesForm = do
prefs <- liftAnnex getFsckPreferences prefs <- liftAnnex getFsckPreferences
runFormPostNoToken $ renderBootstrap $ fsckPreferencesAForm prefs runFormPostNoToken $ renderBootstrap3 formLayout $ fsckPreferencesAForm prefs
where formLayout = BootstrapHorizontalForm (ColSm 0) (ColSm 2) (ColSm 0) (ColSm 10)
showFsckPreferencesForm :: Widget showFsckPreferencesForm :: Widget
showFsckPreferencesForm = do showFsckPreferencesForm = do

View file

@ -83,8 +83,8 @@ iaInputAForm :: Maybe CredPair -> MkAForm IAInput
iaInputAForm defcreds = IAInput iaInputAForm defcreds = IAInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds) <$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds) <*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
<*> areq (selectFieldList mediatypes) "Media Type" (Just MediaOmitted) <*> areq (selectFieldList mediatypes) (bfs "Media Type") (Just MediaOmitted)
<*> areq (textField `withExpandableNote` ("Help", itemNameHelp)) "Item Name" Nothing <*> areq (textField `withExpandableNote` ("Help", itemNameHelp)) (bfs "Item Name") Nothing
where where
mediatypes :: [(Text, MediaType)] mediatypes :: [(Text, MediaType)]
mediatypes = map (\t -> (T.pack $ showMediaType t, t)) [minBound..] mediatypes = map (\t -> (T.pack $ showMediaType t, t)) [minBound..]
@ -126,7 +126,7 @@ postAddIAR :: Handler Html
postAddIAR = iaConfigurator $ do postAddIAR = iaConfigurator $ do
defcreds <- liftAnnex previouslyUsedIACreds defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ iaInputAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaInputAForm defcreds
case result of case result of
FormSuccess input -> liftH $ do FormSuccess input -> liftH $ do
let name = escapeBucket $ T.unpack $ itemName input let name = escapeBucket $ T.unpack $ itemName input
@ -165,7 +165,7 @@ enableIARemote :: UUID -> Widget
enableIARemote uuid = do enableIARemote uuid = do
defcreds <- liftAnnex previouslyUsedIACreds defcreds <- liftAnnex previouslyUsedIACreds
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ iaCredsAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ iaCredsAForm defcreds
case result of case result of
FormSuccess creds -> liftH $ do FormSuccess creds -> liftH $ do
m <- liftAnnex readRemoteLog m <- liftAnnex readRemoteLog

View file

@ -143,7 +143,7 @@ defaultRepositoryPath firstrun = do
newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath
newRepositoryForm defpath msg = do newRepositoryForm defpath msg = do
(pathRes, pathView) <- mreq (repositoryPathField True) "" (pathRes, pathView) <- mreq (repositoryPathField True) (bfs "")
(Just $ T.pack $ addTrailingPathSeparator defpath) (Just $ T.pack $ addTrailingPathSeparator defpath)
let (err, errmsg) = case pathRes of let (err, errmsg) = case pathRes of
FormMissing -> (False, "") FormMissing -> (False, "")
@ -217,10 +217,10 @@ getCombineRepositoryR newrepopath newrepouuid = do
remotename = takeFileName newrepopath remotename = takeFileName newrepopath
selectDriveForm :: [RemovableDrive] -> Hamlet.Html -> MkMForm RemovableDrive selectDriveForm :: [RemovableDrive] -> Hamlet.Html -> MkMForm RemovableDrive
selectDriveForm drives = renderBootstrap $ RemovableDrive selectDriveForm drives = renderBootstrap3 bootstrapFormLayout $ RemovableDrive
<$> pure Nothing <$> pure Nothing
<*> areq (selectFieldList pairs `withNote` onlywritable) "Select drive:" Nothing <*> areq (selectFieldList pairs `withNote` onlywritable) (bfs "Select drive:") Nothing
<*> areq textField "Use this directory on the drive:" <*> areq textField (bfs "Use this directory on the drive:")
(Just $ T.pack gitAnnexAssistantDefaultDir) (Just $ T.pack gitAnnexAssistantDefaultDir)
where where
pairs = zip (map describe drives) (map mountPoint drives) pairs = zip (map describe drives) (map mountPoint drives)

View file

@ -265,8 +265,8 @@ data InputSecret = InputSecret { secretText :: Maybe Text }
promptSecret :: Maybe PairMsg -> (Text -> Secret -> Widget) -> Handler Html promptSecret :: Maybe PairMsg -> (Text -> Secret -> Widget) -> Handler Html
promptSecret msg cont = pairPage $ do promptSecret msg cont = pairPage $ do
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
InputSecret <$> aopt textField "Secret phrase" Nothing InputSecret <$> aopt textField (bfs "Secret phrase") Nothing
case result of case result of
FormSuccess v -> do FormSuccess v -> do
let rawsecret = fromMaybe "" $ secretText v let rawsecret = fromMaybe "" $ secretText v

View file

@ -36,13 +36,13 @@ data PrefsForm = PrefsForm
prefsAForm :: PrefsForm -> MkAForm PrefsForm prefsAForm :: PrefsForm -> MkAForm PrefsForm
prefsAForm def = PrefsForm prefsAForm def = PrefsForm
<$> areq (storageField `withNote` diskreservenote) <$> areq (storageField `withNote` diskreservenote)
"Disk reserve" (Just $ diskReserve def) (bfs "Disk reserve") (Just $ diskReserve def)
<*> areq (positiveIntField `withNote` numcopiesnote) <*> areq (positiveIntField `withNote` numcopiesnote)
"Number of copies" (Just $ numCopies def) (bfs "Number of copies") (Just $ numCopies def)
<*> areq (checkBoxField `withNote` autostartnote) <*> areq (checkBoxField `withNote` autostartnote)
"Auto start" (Just $ autoStart def) "Auto start" (Just $ autoStart def)
<*> areq (selectFieldList autoUpgradeChoices) <*> areq (selectFieldList autoUpgradeChoices)
autoUpgradeLabel (Just $ autoUpgrade def) (bfs autoUpgradeLabel) (Just $ autoUpgrade def)
<*> areq (checkBoxField `withNote` debugnote) <*> areq (checkBoxField `withNote` debugnote)
"Enable debug logging" (Just $ debugEnabled def) "Enable debug logging" (Just $ debugEnabled def)
where where
@ -109,7 +109,7 @@ postPreferencesR :: Handler Html
postPreferencesR = page "Preferences" (Just Configuration) $ do postPreferencesR = page "Preferences" (Just Configuration) $ do
((result, form), enctype) <- liftH $ do ((result, form), enctype) <- liftH $ do
current <- liftAnnex getPrefs current <- liftAnnex getPrefs
runFormPostNoToken $ renderBootstrap $ prefsAForm current runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ prefsAForm current
case result of case result of
FormSuccess new -> liftH $ do FormSuccess new -> liftH $ do
liftAnnex $ storePrefs new liftAnnex $ storePrefs new

View file

@ -76,10 +76,10 @@ sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput
sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput
#endif #endif
sshInputAForm hostnamefield def = SshInput sshInputAForm hostnamefield def = SshInput
<$> aopt check_hostname "Host name" (Just $ inputHostname def) <$> aopt check_hostname (bfs "Host name") (Just $ inputHostname def)
<*> aopt check_username "User name" (Just $ inputUsername def) <*> aopt check_username (bfs "User name") (Just $ inputUsername def)
<*> aopt textField "Directory" (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def) <*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def)
<*> areq intField "Port" (Just $ inputPort def) <*> areq intField (bfs "Port") (Just $ inputPort def)
where where
check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack) check_username = checkBool (all (`notElem` "/:@ \t") . T.unpack)
bad_username textField bad_username textField
@ -121,7 +121,7 @@ postAddSshR :: Handler Html
postAddSshR = sshConfigurator $ do postAddSshR = sshConfigurator $ do
username <- liftIO $ T.pack <$> myUserName username <- liftIO $ T.pack <$> myUserName
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sshInputAForm textField $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm textField $
SshInput Nothing (Just username) Nothing 22 SshInput Nothing (Just username) Nothing 22
case result of case result of
FormSuccess sshinput -> do FormSuccess sshinput -> do
@ -174,7 +174,7 @@ enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do
case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of
(Just sshinput, Just reponame) -> sshConfigurator $ do (Just sshinput, Just reponame) -> sshConfigurator $ do
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ sshInputAForm textField sshinput runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm textField sshinput
case result of case result of
FormSuccess sshinput' FormSuccess sshinput'
| isRsyncNet (inputHostname sshinput') -> | isRsyncNet (inputHostname sshinput') ->
@ -456,7 +456,7 @@ getAddRsyncNetR = postAddRsyncNetR
postAddRsyncNetR :: Handler Html postAddRsyncNetR :: Handler Html
postAddRsyncNetR = do postAddRsyncNetR = do
((result, form), enctype) <- runFormPostNoToken $ ((result, form), enctype) <- runFormPostNoToken $
renderBootstrap $ sshInputAForm hostnamefield $ renderBootstrap3 bootstrapFormLayout $ sshInputAForm hostnamefield $
SshInput Nothing Nothing Nothing 22 SshInput Nothing Nothing Nothing 22
let showform status = inpage $ let showform status = inpage $
$(widgetFile "configurators/rsync.net/add") $(widgetFile "configurators/rsync.net/add")

View file

@ -27,9 +27,9 @@ data UnusedForm = UnusedForm
unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm
unusedForm def msg = do unusedForm def msg = do
(enableRes, enableView) <- mreq (selectFieldList enabledisable) "" (enableRes, enableView) <- mreq (selectFieldList enabledisable) (bfs "")
(Just $ enableExpire def) (Just $ enableExpire def)
(whenRes, whenView) <- mreq intField "" (whenRes, whenView) <- mreq intField (bfs "")
(Just $ expireWhen def) (Just $ expireWhen def)
let form = do let form = do
webAppFormAuthToken webAppFormAuthToken

View file

@ -45,16 +45,16 @@ toCredPair input = (T.unpack $ user input, T.unpack $ password input)
boxComAForm :: Maybe CredPair -> MkAForm WebDAVInput boxComAForm :: Maybe CredPair -> MkAForm WebDAVInput
boxComAForm defcreds = WebDAVInput boxComAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds) <$> areq textField (bfs "Username or Email") (T.pack . fst <$> defcreds)
<*> areq passwordField "Box.com Password" (T.pack . snd <$> defcreds) <*> areq passwordField (bfs "Box.com Password") (T.pack . snd <$> defcreds)
<*> areq checkBoxField "Share this account with other devices and friends?" (Just True) <*> areq checkBoxField "Share this account with other devices and friends?" (Just True)
<*> areq textField "Directory" (Just "annex") <*> areq textField (bfs "Directory") (Just "annex")
<*> enableEncryptionField <*> enableEncryptionField
webDAVCredsAForm :: Maybe CredPair -> MkAForm WebDAVInput webDAVCredsAForm :: Maybe CredPair -> MkAForm WebDAVInput
webDAVCredsAForm defcreds = WebDAVInput webDAVCredsAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds) <$> areq textField (bfs "Username or Email") (T.pack . fst <$> defcreds)
<*> areq passwordField "Password" (T.pack . snd <$> defcreds) <*> areq passwordField (bfs "Password") (T.pack . snd <$> defcreds)
<*> pure False <*> pure False
<*> pure T.empty <*> pure T.empty
<*> pure NoEncryption -- not used! <*> pure NoEncryption -- not used!
@ -66,7 +66,8 @@ postAddBoxComR :: Handler Html
postAddBoxComR = boxConfigurator $ do postAddBoxComR = boxConfigurator $ do
defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com" defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com"
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ boxComAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout
$ boxComAForm defcreds
case result of case result of
FormSuccess input -> liftH $ FormSuccess input -> liftH $
makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList
@ -109,7 +110,8 @@ postEnableWebDAVR uuid = do
maybe (pure Nothing) previouslyUsedWebDAVCreds $ maybe (pure Nothing) previouslyUsedWebDAVCreds $
urlHost url urlHost url
((result, form), enctype) <- liftH $ ((result, form), enctype) <- liftH $
runFormPostNoToken $ renderBootstrap $ webDAVCredsAForm defcreds runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
webDAVCredsAForm defcreds
case result of case result of
FormSuccess input -> liftH $ FormSuccess input -> liftH $
makeWebDavRemote enableSpecialRemote name (toCredPair input) M.empty makeWebDavRemote enableSpecialRemote name (toCredPair input) M.empty

View file

@ -99,7 +99,7 @@ xmppform :: Route WebApp -> Handler Html
xmppform next = xmppPage $ do xmppform next = xmppPage $ do
((result, form), enctype) <- liftH $ do ((result, form), enctype) <- liftH $ do
oldcreds <- liftAnnex getXMPPCreds oldcreds <- liftAnnex getXMPPCreds
runFormPostNoToken $ renderBootstrap $ xmppAForm $ runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ xmppAForm $
creds2Form <$> oldcreds creds2Form <$> oldcreds
let showform problem = $(widgetFile "configurators/xmpp") let showform problem = $(widgetFile "configurators/xmpp")
case result of case result of
@ -162,8 +162,8 @@ creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm
xmppAForm def = XMPPForm xmppAForm def = XMPPForm
<$> areq jidField "Jabber address" (formJID <$> def) <$> areq jidField (bfs "Jabber address") (formJID <$> def)
<*> areq passwordField "Password" Nothing <*> areq passwordField (bfs "Password") Nothing
jidField :: MkField Text jidField :: MkField Text
jidField = checkBool (isJust . parseJID) bad textField jidField = checkBool (isJust . parseJID) bad textField

View file

@ -15,10 +15,20 @@ module Assistant.WebApp.Form where
import Assistant.WebApp.Types import Assistant.WebApp.Types
import Assistant.Gpg import Assistant.Gpg
#if MIN_VERSION_yesod(1,2,0)
import Yesod hiding (textField, passwordField) import Yesod hiding (textField, passwordField)
import Yesod.Form.Fields as F import Yesod.Form.Fields as F
#else
import Yesod hiding (textField, passwordField, selectField, selectFieldList)
import Yesod.Form.Fields as F hiding (selectField, selectFieldList)
#endif
import Assistant.WebApp.Bootstrap3 hiding (bfs)
import Data.String (IsString (..))
import Data.Text (Text) import Data.Text (Text)
import Control.Monad (unless)
import Data.Maybe (listToMaybe)
{- Yesod's textField sets the required attribute for required fields. {- Yesod's textField sets the required attribute for required fields.
- We don't want this, because many of the forms used in this webapp - We don't want this, because many of the forms used in this webapp
- display a modal dialog when submitted, which interacts badly with - display a modal dialog when submitted, which interacts badly with
@ -48,6 +58,54 @@ passwordField = F.passwordField
|] |]
} }
{- In older Yesod versions attrs is written into the <option> tag instead of the
- surrounding <select>. This breaks the Bootstrap 3 layout of select fields as
- it requires the "form-control" class on the <select> tag.
- We need to change that to behave the same way as in newer versions.
-}
#if ! MIN_VERSION_yesod(1,2,0)
selectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master a
selectFieldList = selectField . optionsPairs
selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
selectField = selectFieldHelper
(\theId name attrs inside -> [whamlet|<select ##{theId} name=#{name} *{attrs}>^{inside}|]) -- outside
(\_theId _name isSel -> [whamlet|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
(\_theId _name _attrs value isSel text -> [whamlet|<option value=#{value} :isSel:selected>#{text}|]) -- inside
selectFieldHelper :: (Eq a, RenderMessage master FormMessage)
=> (Text -> Text -> [(Text, Text)] -> GWidget sub master () -> GWidget sub master ())
-> (Text -> Text -> Bool -> GWidget sub master ())
-> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> GWidget sub master ())
-> GHandler sub master (OptionList a) -> Field sub master a
selectFieldHelper outside onOpt inside opts' = Field
{ fieldParse = \x -> do
opts <- opts'
return $ selectParser opts x
, fieldView = \theId name attrs val isReq -> do
opts <- fmap olOptions $ lift opts'
outside theId name attrs $ do
unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts
flip mapM_ opts $ \opt -> inside
theId
name
((if isReq then (("required", "required"):) else id) attrs)
(optionExternalValue opt)
((render opts val) == optionExternalValue opt)
(optionDisplay opt)
}
where
render _ (Left _) = ""
render opts (Right a) = maybe "" optionExternalValue $ listToMaybe $ filter ((== a) . optionInternalValue) opts
selectParser _ [] = Right Nothing
selectParser opts (s:_) = case s of
"" -> Right Nothing
"none" -> Right Nothing
x -> case olReadExternal opts x of
Nothing -> Left $ SomeMessage $ MsgInvalidEntry x
Just y -> Right $ Just y
#endif
{- Makes a note widget be displayed after a field. -} {- Makes a note widget be displayed after a field. -}
#if MIN_VERSION_yesod(1,2,0) #if MIN_VERSION_yesod(1,2,0)
withNote :: (Monad m, ToWidget (HandlerSite m) a) => Field m v -> a -> Field m v withNote :: (Monad m, ToWidget (HandlerSite m) a) => Field m v -> a -> Field m v
@ -67,7 +125,7 @@ withExpandableNote :: (Monad m, ToWidget (HandlerSite m) w) => Field m v -> (Str
withExpandableNote :: Field sub master v -> (String, GWidget sub master ()) -> Field sub master v withExpandableNote :: Field sub master v -> (String, GWidget sub master ()) -> Field sub master v
#endif #endif
withExpandableNote field (toggle, note) = withNote field $ [whamlet| withExpandableNote field (toggle, note) = withNote field $ [whamlet|
<a .btn data-toggle="collapse" data-target="##{ident}">#{toggle}</a> <a .btn .btn-default data-toggle="collapse" data-target="##{ident}">#{toggle}</a>
<div ##{ident} .collapse> <div ##{ident} .collapse>
^{note} ^{note}
|] |]
@ -80,10 +138,27 @@ enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerT sit
#else #else
enableEncryptionField :: RenderMessage master FormMessage => AForm sub master EnableEncryption enableEncryptionField :: RenderMessage master FormMessage => AForm sub master EnableEncryption
#endif #endif
enableEncryptionField = areq (selectFieldList choices) "Encryption" (Just SharedEncryption) enableEncryptionField = areq (selectFieldList choices) (bfs "Encryption") (Just SharedEncryption)
where where
choices :: [(Text, EnableEncryption)] choices :: [(Text, EnableEncryption)]
choices = choices =
[ ("Encrypt all data", SharedEncryption) [ ("Encrypt all data", SharedEncryption)
, ("Disable encryption", NoEncryption) , ("Disable encryption", NoEncryption)
] ]
{- Defines the layout used by the Bootstrap3 form helper -}
bootstrapFormLayout :: BootstrapFormLayout
bootstrapFormLayout = BootstrapHorizontalForm (ColSm 0) (ColSm 2) (ColSm 0) (ColSm 10)
{- Adds the form-control class used by Bootstrap3 for layout to a field
- This is the same as Yesod.Form.Bootstrap3.bfs except it takes just a Text
- parameter as I couldn't get the original bfs to compile due to type ambiguities.
-}
bfs :: Text -> FieldSettings master
bfs msg = FieldSettings
{ fsLabel = SomeMessage msg
, fsName = Nothing
, fsId = Nothing
, fsAttrs = [("class", "form-control")]
, fsTooltip = Nothing
}

View file

@ -27,11 +27,12 @@ import qualified Data.Map as M
gpgKeyDisplay :: KeyId -> Maybe UserId -> Widget gpgKeyDisplay :: KeyId -> Maybe UserId -> Widget
gpgKeyDisplay keyid userid = [whamlet| gpgKeyDisplay keyid userid = [whamlet|
<span title="key id #{keyid}"> <span title="key id #{keyid}">
<i .icon-user></i> # <span .glyphicon .glyphicon-user>
$maybe name <- userid \
#{name} $maybe name <- userid
$nothing #{name}
key id #{keyid} $nothing
key id #{keyid}
|] |]
genKeyModal :: Widget genKeyModal :: Widget

View file

@ -59,14 +59,12 @@ customPage' with_longpolling navbaritem content = do
Nothing -> do Nothing -> do
navbar <- map navdetails <$> selectNavBar navbar <- map navdetails <$> selectNavBar
pageinfo <- widgetToPageContent $ do pageinfo <- widgetToPageContent $ do
addStylesheet $ StaticR bootstrap_css addStylesheet $ StaticR css_bootstrap_css
addStylesheet $ StaticR bootstrap_responsive_css addStylesheet $ StaticR css_bootstrap_theme_css
addScript $ StaticR jquery_full_js addScript $ StaticR js_jquery_full_js
addScript $ StaticR bootstrap_dropdown_js addScript $ StaticR js_bootstrap_js
addScript $ StaticR bootstrap_modal_js
addScript $ StaticR bootstrap_collapse_js
when with_longpolling $ when with_longpolling $
addScript $ StaticR longpolling_js addScript $ StaticR js_longpolling_js
$(widgetFile "page") $(widgetFile "page")
giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap") giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap")
Just msg -> error msg Just msg -> error msg

View file

@ -113,10 +113,10 @@ cloudRepoList = repoListDisplay RepoSelector
repoListDisplay :: RepoSelector -> Widget repoListDisplay :: RepoSelector -> Widget
repoListDisplay reposelector = do repoListDisplay reposelector = do
autoUpdate ident (NotifierRepoListR reposelector) (10 :: Int) (10 :: Int) autoUpdate ident (NotifierRepoListR reposelector) (10 :: Int) (10 :: Int)
addScript $ StaticR jquery_ui_core_js addScript $ StaticR js_jquery_ui_core_js
addScript $ StaticR jquery_ui_widget_js addScript $ StaticR js_jquery_ui_widget_js
addScript $ StaticR jquery_ui_mouse_js addScript $ StaticR js_jquery_ui_mouse_js
addScript $ StaticR jquery_ui_sortable_js addScript $ StaticR js_jquery_ui_sortable_js
repolist <- liftH $ repoList reposelector repolist <- liftH $ repoList reposelector
let addmore = nudgeAddMore reposelector let addmore = nudgeAddMore reposelector

View file

@ -38,7 +38,7 @@ sideBarDisplay = do
bootstrapclass :: AlertClass -> Text bootstrapclass :: AlertClass -> Text
bootstrapclass Activity = "alert-info" bootstrapclass Activity = "alert-info"
bootstrapclass Warning = "alert" bootstrapclass Warning = "alert"
bootstrapclass Error = "alert-error" bootstrapclass Error = "alert-danger"
bootstrapclass Success = "alert-success" bootstrapclass Success = "alert-success"
bootstrapclass Message = "alert-info" bootstrapclass Message = "alert-info"
@ -106,4 +106,4 @@ htmlIcon UpgradeIcon = bootstrapIcon "arrow-up"
htmlIcon ConnectionIcon = bootstrapIcon "signal" htmlIcon ConnectionIcon = bootstrapIcon "signal"
bootstrapIcon :: Text -> Widget bootstrapIcon :: Text -> Widget
bootstrapIcon name = [whamlet|<i .icon-#{name}></i>|] bootstrapIcon name = [whamlet|<span .glyphicon .glyphicon-#{name}>|]

View file

@ -73,8 +73,10 @@ instance Yesod WebApp where
defaultLayout content = do defaultLayout content = do
webapp <- getYesod webapp <- getYesod
pageinfo <- widgetToPageContent $ do pageinfo <- widgetToPageContent $ do
addStylesheet $ StaticR bootstrap_css addStylesheet $ StaticR css_bootstrap_css
addStylesheet $ StaticR bootstrap_responsive_css addStylesheet $ StaticR css_bootstrap_theme_css
addScript $ StaticR js_jquery_full_js
addScript $ StaticR js_bootstrap_js
$(widgetFile "error") $(widgetFile "error")
giveUrlRenderer $(hamletFile $ hamletTemplate "bootstrap") giveUrlRenderer $(hamletFile $ hamletTemplate "bootstrap")

View file

@ -460,6 +460,11 @@ mangleCode = flip_colon
- -
- Nothing - Nothing
- -> foo - -> foo
-
- -- This is not yet handled!
- ComplexConstructor var var
- var var
- -> foo
-} -}
case_layout_multiline = parsecAndReplace $ do case_layout_multiline = parsecAndReplace $ do
void newline void newline

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Applicative where module Utility.Applicative where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2011 Joey Hess <joey@kitenet.net> - Copyright 2011 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Base64 (toB64, fromB64Maybe, fromB64) where module Utility.Base64 (toB64, fromB64Maybe, fromB64) where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -3,7 +3,7 @@
- -
- Copyright 2012-2013 Joey Hess <joey@kitenet.net> - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010-2013 Joey Hess <joey@kitenet.net> - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012-2014 Joey Hess <joey@kitenet.net> - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Data where module Utility.Data where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2011 Joey Hess <joey@kitenet.net> - Copyright 2011 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
- -
- -
- And now a rant: - And now a rant:

View file

@ -6,7 +6,7 @@
- -
- Copyright 2012-2013 Joey Hess <joey@kitenet.net> - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.DirWatcher.FSEvents where module Utility.DirWatcher.FSEvents where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.DirWatcher.INotify where module Utility.DirWatcher.INotify where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.DirWatcher.Types where module Utility.DirWatcher.Types where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.DirWatcher.Win32Notify where module Utility.DirWatcher.Win32Notify where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2011-2014 Joey Hess <joey@kitenet.net> - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012, 2014 Joey Hess <joey@kitenet.net> - Copyright 2012, 2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE ForeignFunctionInterface, CPP #-} {-# LANGUAGE ForeignFunctionInterface, CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010 Joey Hess <joey@kitenet.net> - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Dot where -- import qualified module Utility.Dot where -- import qualified

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2011-2012 Joey Hess <joey@kitenet.net> - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}

View file

@ -5,7 +5,7 @@
- -
- Copyright 2011-2013 Joey Hess <joey@kitenet.net> - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.ExternalSHA (externalSHA) where module Utility.ExternalSHA (externalSHA) where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010-2012 Joey Hess <joey@kitenet.net> - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012-2014 Joey Hess <joey@kitenet.net> - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010, 2011 Joey Hess <joey@kitenet.net> - Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Format ( module Utility.Format (

View file

@ -7,7 +7,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.FreeDesktop ( module Utility.FreeDesktop (

View file

@ -5,7 +5,7 @@
- -
- Copyright 2014 Joey Hess <joey@kitenet.net> - Copyright 2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012-2013 Joey Hess <joey@kitenet.net> - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.HumanNumber where module Utility.HumanNumber where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012-2013 Joey Hess <joey@kitenet.net> - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.HumanTime ( module Utility.HumanTime (

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.InodeCache where module Utility.InodeCache where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2011 Joey Hess <joey@kitenet.net> - Copyright 2011 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.JSONStream ( module Utility.JSONStream (

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.LinuxMkLibs where module Utility.LinuxMkLibs where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -12,7 +12,7 @@
- -
- Copyright 2011-2013 Joey Hess <joey@kitenet.net> - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE Rank2Types, KindSignatures #-} {-# LANGUAGE Rank2Types, KindSignatures #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012, 2013 Joey Hess <joey@kitenet.net> - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010-2011 Joey Hess <joey@kitenet.net> - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010-2012 Joey Hess <joey@kitenet.net> - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Monad where module Utility.Monad where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Network where module Utility.Network where

View file

@ -8,7 +8,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.NotificationBroadcaster ( module Utility.NotificationBroadcaster (

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.OSX where module Utility.OSX where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2014 Joey Hess <joey@kitenet.net> - Copyright 2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Parallel where module Utility.Parallel where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010-2014 Joey Hess <joey@kitenet.net> - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE PackageImports, CPP #-} {-# LANGUAGE PackageImports, CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Percentage ( module Utility.Percentage (

View file

@ -4,7 +4,7 @@
- -
- Copyright 2014 Joey Hess <joey@kitenet.net> - Copyright 2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -3,7 +3,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP, Rank2Types #-} {-# LANGUAGE CPP, Rank2Types #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012-2014 Joey Hess <joey@kitenet.net> - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010-2013 Joey Hess <joey@kitenet.net> - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Rsync where module Utility.Rsync where

View file

@ -5,7 +5,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010-2013 Joey Hess <joey@kitenet.net> - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.SafeCommand where module Utility.SafeCommand where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013-2014 Joey Hess <joey@kitenet.net> - Copyright 2013-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Scheduled ( module Utility.Scheduled (

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013-2014 Joey Hess <joey@kitenet.net> - Copyright 2013-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.SimpleProtocol ( module Utility.SimpleProtocol (

View file

@ -2,7 +2,7 @@
- -
- Copyright 2013 Joey Hess <joey@kitenet.net> - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.SshConfig where module Utility.SshConfig where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.ThreadLock where module Utility.ThreadLock where

View file

@ -3,7 +3,7 @@
- Copyright 2012, 2013 Joey Hess <joey@kitenet.net> - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
- Copyright 2011 Bas van Dijk & Roel van Dijk - Copyright 2011 Bas van Dijk & Roel van Dijk
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2010-2013 Joey Hess <joey@kitenet.net> - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2011 Joey Hess <joey@kitenet.net> - Copyright 2011 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2014 Joey Hess <joey@kitenet.net> - Copyright 2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2011,2013 Joey Hess <joey@kitenet.net> - Copyright 2011,2013 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012 Joey Hess <joey@kitenet.net> - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.Verifiable where module Utility.Verifiable where

View file

@ -2,7 +2,7 @@
- -
- Copyright 2012-2014 Joey Hess <joey@kitenet.net> - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE OverloadedStrings, CPP, RankNTypes #-} {-# LANGUAGE OverloadedStrings, CPP, RankNTypes #-}

View file

@ -2,7 +2,7 @@
- -
- Copyright 2014 Joey Hess <joey@kitenet.net> - Copyright 2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
module Utility.WinLock ( module Utility.WinLock (

View file

@ -2,7 +2,7 @@
- -
- Copyright 2014 Joey Hess <joey@kitenet.net> - Copyright 2014 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - License: BSD-2-clause
-} -}
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}

View file

@ -28,6 +28,7 @@ import Yesod as Y
#else #else
import Yesod as Y hiding (Html) import Yesod as Y hiding (Html)
#endif #endif
import Assistant.WebApp.Bootstrap3 as Y hiding (bfs)
#ifndef __NO_TH__ #ifndef __NO_TH__
import Yesod.Default.Util import Yesod.Default.Util
import Language.Haskell.TH.Syntax (Q, Exp) import Language.Haskell.TH.Syntax (Q, Exp)

View file

@ -2,7 +2,7 @@
* *
* Copyright 2012, 2014 Joey Hess <joey@kitenet.net> * Copyright 2012, 2014 Joey Hess <joey@kitenet.net>
* *
* Licensed under the GNU GPL version 3 or higher. * License: BSD-2-clause
*/ */
/* Include appropriate headers for the OS, and define what will be used to /* Include appropriate headers for the OS, and define what will be used to

View file

@ -2,7 +2,7 @@
* *
* Copyright 2012 Joey Hess <joey@kitenet.net> * Copyright 2012 Joey Hess <joey@kitenet.net>
* *
* Licensed under the GNU GPL version 3 or higher. * License: BSD-2-clause
*/ */
#include <stdio.h> #include <stdio.h>

4
debian/changelog vendored
View file

@ -1,11 +1,13 @@
git-annex (5.20140422) UNRELEASED; urgency=medium git-annex (5.20140422) UNRELEASED; urgency=medium
* webapp: Switched to bootstrap 3.
Thanks, Sören Brunk.
* Standalone builds now check gpg signatures before upgrading. * Standalone builds now check gpg signatures before upgrading.
* Simplified repository description line format. The remote name, * Simplified repository description line format. The remote name,
if any, is always in square brackets after the description. if any, is always in square brackets after the description.
* assistant: Clean up stale tmp files on startup. * assistant: Clean up stale tmp files on startup.
-- Joey Hess <joeyh@debian.org> Wed, 23 Apr 2014 12:43:39 -0400 -- Joey Hess <joeyh@debian.org> Fri, 02 May 2014 15:28:53 -0300
git-annex (5.20140421) unstable; urgency=medium git-annex (5.20140421) unstable; urgency=medium

72
debian/copyright vendored
View file

@ -7,11 +7,20 @@ License: GPL-3+
Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/* Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/*
Copyright: © 2012-2014 Joey Hess <joey@kitenet.net> Copyright: © 2012-2014 Joey Hess <joey@kitenet.net>
© 2014 Sören Brunk
License: AGPL-3+ License: AGPL-3+
Files: Utility/ThreadScheduler.hs Files: Utility/ThreadScheduler.hs
Copyright: 2011 Bas van Dijk & Roel van Dijk Copyright: 2011 Bas van Dijk & Roel van Dijk
2012 Joey Hess <joey@kitenet.net> 2012, 2013 Joey Hess <joey@kitenet.net>
License: BSD-2-clause
Files: Utility/*
Copyright: 2012-2014 Joey Hess <joey@kitenet.net>
License: BSD-2-clause
Files: Utility/Gpg.hs Utility/DirWatcher*
Copyright: © 2010-2014 Joey Hess <joey@kitenet.net>
License: GPL-3+ License: GPL-3+
Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/* Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/*
@ -88,23 +97,28 @@ License: MIT or GPL-2
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Files: static/bootstrap* static/glyphicons-halflings* Files: static/*/bootstrap* static/*/glyphicons-halflings*
Copyright: 2012 Twitter, Inc. Copyright: 2012-2014 Twitter, Inc.
License: Apache-2.0 License: MIT
Licensed under the Apache License, Version 2.0 (the "License"); Copyright (c) 2011-2014 Twitter, Inc
you may not use this file except in compliance with the License. .
You may obtain a copy of the License at Permission is hereby granted, free of charge, to any person obtaining a copy
. of this software and associated documentation files (the "Software"), to deal
http://www.apache.org/licenses/LICENSE-2.0 in the Software without restriction, including without limitation the rights
. to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
Unless required by applicable law or agreed to in writing, software copies of the Software, and to permit persons to whom the Software is
distributed under the License is distributed on an "AS IS" BASIS, furnished to do so, subject to the following conditions:
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. .
See the License for the specific language governing permissions and The above copyright notice and this permission notice shall be included in
limitations under the License. all copies or substantial portions of the Software.
. .
The complete text of the Apache License is distributed in THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
/usr/share/common-licenses/Apache-2.0 on Debian systems. IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
License: GPL-3+ License: GPL-3+
The full text of version 3 of the GPL is distributed as doc/license/GPL in The full text of version 3 of the GPL is distributed as doc/license/GPL in
@ -116,6 +130,28 @@ License: LGPL-2.1+
in this package's source, or in /usr/share/common-licenses/LGPL-2.1 in this package's source, or in /usr/share/common-licenses/LGPL-2.1
on Debian systems. on Debian systems.
License: BSD-2-clause
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
.
THIS SOFTWARE IS PROVIDED BY AUTHORS AND CONTRIBUTORS ``AS IS'' AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
SUCH DAMAGE.
License: AGPL-3+ License: AGPL-3+
GNU AFFERO GENERAL PUBLIC LICENSE GNU AFFERO GENERAL PUBLIC LICENSE
Version 3, 19 November 2007 Version 3, 19 November 2007

View file

@ -0,0 +1,22 @@
[[!comment format=mdwn
username="https://www.google.com/accounts/o8/id?id=AItOawkAUMhKOSkh9JaBA6xst3XxQIIsDEq5Zd4"
nickname="Ovidiu"
subject="Still having this problem"
date="2014-05-09T12:53:02Z"
content="""
[2014-05-09 07:37:42 SAST] Transferrer: Uploaded 1-564 Erk..08_04.pdf
ok
(Recording state in git...)
(Recording state in git...)
(Recording state in git...)
git-annex: /etc/resolv.conf: openFile: does not exist (No such file or directory)
[2014-05-09 08:39:53 SAST] NetWatcherFallback: Syncing with box.com, gitannexbackup
I saw it in the log file but I have no idea what triggered it.
Using the .dmg install for Mac OsX
Version: 5.20140420-ga25b8bb
Build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash
on Mac OSX 10.9.2
"""]]

View file

@ -0,0 +1,8 @@
[[!comment format=mdwn
username="http://johan.kiviniemi.name/"
nickname="Johan"
subject="comment 10"
date="2014-05-01T01:33:10Z"
content="""
Note to self: I experienced this bug with the standalone tarball release (5.20140421) as well, so its not caused by something that is different on my system wrt. git-annexs dependencies etc.
"""]]

View file

@ -0,0 +1,14 @@
[[!comment format=mdwn
username="http://xlogon.net/yminus"
nickname="http://xlogon.net/yminus"
subject="comment 4"
date="2014-05-08T21:12:49Z"
content="""
When will this issue be fixed? Currently my Jabber account is on jabber.ccc.de.
This is the error message:
Unable to connect to the Jabber server. Maybe you entered the wrong password? (Error message: host jabberd.jabber.ccc.de.:5222 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"bad-protocol\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}); host jabberd.jabber.ccc.de.:80 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"bad-protocol\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}))
Can you advise me another trustworthy non-profit and free (free as in free beer\" as well as \"free as in free speech\") jabber server?
"""]]

View file

@ -0,0 +1,29 @@
### Please describe the problem.
Every time git-annex launches (after a reboot). It prompts me to finish upgrade, even though the binary is not updated. (All my repos are set to not auto update and this happens on all my repos).
### What steps will reproduce the problem?
Relaunching git-annex.
### What version of git-annex are you using? On what operating system?
OS X 10.9
git-annex version: 5.20140419-g477c0c0
build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash
key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL
remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external
### Please provide any additional information below.
[[!format sh """
# If you can, paste a complete transcript of the problem occurring here.
# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log
# End of transcript or log.
"""]]

View file

@ -0,0 +1,20 @@
### Please describe the problem.
When starting git-annex Version: 5.20140420-ga25b8bb Build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash on My MBP running OSX 10.9.2 I get a notification about: An upgrade of git-annex is available. (version 5.20140421)
I then click UPGRADE and then get this message: Internal Server Error Cannot find old distribution bundle; not upgrading.
### What steps will reproduce the problem?
See problem description above, not sure what else to say.
### What version of git-annex are you using? On what operating system?
See problem description above, not sure what else to say.
### Please provide any additional information below.
[[!format sh """
# If you can, paste a complete transcript of the problem occurring here.
# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log
# End of transcript or log.
"""]]

View file

@ -0,0 +1,13 @@
[[!comment format=mdwn
username="https://www.google.com/accounts/o8/id?id=AItOawkAUMhKOSkh9JaBA6xst3XxQIIsDEq5Zd4"
nickname="Ovidiu"
subject="fixed"
date="2014-05-09T13:12:59Z"
content="""
re-downloaded the old version, re-isntalled and now it actually starts downlaoding the new version => http://screencast.com/t/id2Ng57Z9
NOT sure though, why it now uploads the new version to all repositories? i.e. box.com? IS there a reason for this?
Transfers
git-annex.dmg (for upgrade)→box.com 42% of 22.52 MiB
"""]]

View file

@ -0,0 +1,24 @@
[[!comment format=mdwn
username="https://www.google.com/accounts/o8/id?id=AItOawkAUMhKOSkh9JaBA6xst3XxQIIsDEq5Zd4"
nickname="Ovidiu"
subject="spoke too soon"
date="2014-05-09T13:23:52Z"
content="""
Stuck in a loop, now with every restart of git-annex it downloads the update and then uploads it to all my repositories again:
http://screencast.com/t/Ow7SlPVaS68
And then it says:
Finished upgrading git-annex to version 5.20140420-ga25b8bb
BUT that is the OLD version not the new one :-/
NEXT TRY:
killed all processes of git and git-annex, restart.
Was greeted by:
An upgrade of git-annex is available.
(version 5.20140421)
Klicked the Upgrade button.
Nothing happens, except that the upgrade notice disappeared :-/
"""]]

Some files were not shown because too many files have changed in this diff Show more