fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

weird fix build

Browse Source
This commit is contained in:
Steffen Jost 2019-03-24 13:07:23 +01:00
parent 291064c03b
commit 179cb735a2
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Handler/Utils/Form/MassInput.hs
View File

@ -33,7 +33,7 @@ import Control.Monad.Fix
data BoxDimension x = forall n. (Enum n, Num n) => BoxDimension (Lens' x n) data BoxDimension x = forall n. (Enum n, Num n) => BoxDimension (Lens' x n)
class (PathPiece x, ToJSONKey x, FromJSONKey x, Eq x, Ord x) => IsBoxCoord x where class (PathPiece x, ToJSONKey x, FromJSONKey x, Eq x, Ord x) => IsBoxCoord x where
boxDimensions :: [BoxDimension x] boxDimensions :: [BoxDimension x]
boxOrigin :: x boxOrigin :: x
@ -47,7 +47,7 @@ boxDimension n
-- zeroDimension :: IsBoxCoord x => Natural -> x -> x -- zeroDimension :: IsBoxCoord x => Natural -> x -> x
-- zeroDimension (boxDimension -> BoxDimension dim) = set dim $ boxOrigin ^. dim -- zeroDimension (boxDimension -> BoxDimension dim) = set dim $ boxOrigin ^. dim
class (IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveliness a where class (IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveliness a where
type BoxCoord a :: * type BoxCoord a :: *
liveCoords :: Prism' (Set (BoxCoord a)) a liveCoords :: Prism' (Set (BoxCoord a)) a
@ -213,7 +213,7 @@ massInput :: forall handler cellData cellResult liveliness.
-> (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX)) -> (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX))
massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
let initialShape = fmap fst <$> initialResult let initialShape = fmap fst <$> initialResult
miName <- maybe newFormIdent return fsName miName <- maybe newFormIdent return fsName
let let
shapeName :: MassInputFieldName (BoxCoord liveliness) shapeName :: MassInputFieldName (BoxCoord liveliness)
@ -268,7 +268,7 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX) delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX)
delForm miCoord = do delForm miCoord = do
(delRes, delView) <- lift $ mpreq (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..}) Nothing (delRes, delView) <- lift $ mpreq (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..}) Nothing
-- $logDebugS "delForm" . tshow $ fmap toPathPiece delRes -- dollar comment causes build error somehow $ logDebugS "delForm" . tshow $ fmap toPathPiece delRes
shapeUpdate <- miDelete addedLiveliness miCoord shapeUpdate <- miDelete addedLiveliness miCoord
guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness) guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness)
return (shapeUpdate <$ delRes, delView) return (shapeUpdate <$ delRes, delView)
@ -284,8 +284,8 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
let shapeChanged = Fold.any (isn't _FormMissing . view _1) addResults || Fold.any (is _FormSuccess . view _1) delResults let shapeChanged = Fold.any (isn't _FormMissing . view _1) addResults || Fold.any (is _FormSuccess . view _1) delResults
shape <- if shape <- if
| Just s <- addShape -> return s | Just s <- addShape -> return s
| Just s <- delShape -> return s | Just s <- delShape -> return s
| otherwise -> return sentShape' | otherwise -> return sentShape'
liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
@ -332,7 +332,7 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
cells cells
| [] <- remDims = do | [] <- remDims = do
coord <- coords coord <- coords
Just (_data, (_cellRes, cellWdgt)) <- return $ Map.lookup coord cellResults Just (_data, (_cellRes, cellWdgt)) <- return $ Map.lookup coord cellResults
let deleteButton = snd <$> Map.lookup coord delResults let deleteButton = snd <$> Map.lookup coord delResults
return (coord, $(widgetFile "widgets/massinput/cell")) return (coord, $(widgetFile "widgets/massinput/cell"))
| otherwise = | otherwise =
@ -344,7 +344,7 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
fvId <- maybe newIdent return fsId fvId <- maybe newIdent return fsId
let let
fvLabel = toHtml $ mr fsLabel fvLabel = toHtml $ mr fsLabel
fvTooltip = toHtml . mr <$> fsTooltip fvTooltip = toHtml . mr <$> fsTooltip