mirror of
https://github.com/aelve/guide.git
synced 2024-11-22 03:12:58 +03:00
parent
29a2fb718c
commit
0d170b3e30
@ -18,17 +18,13 @@ module Guide.Diff
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
-- shared imports
|
|
||||||
import Imports
|
import Imports
|
||||||
-- Vector
|
|
||||||
import Data.Vector (Vector)
|
|
||||||
|
|
||||||
import Guide.Diff.Merge (merge)
|
import Guide.Diff.Merge (merge)
|
||||||
import Guide.Diff.Tokenize (tokenize)
|
import Guide.Diff.Tokenize (tokenize)
|
||||||
import Guide.Utils (makeClassWithLenses)
|
import Guide.Utils (makeClassWithLenses)
|
||||||
|
|
||||||
import qualified Data.Patch as PV
|
import qualified Data.Patch as PV
|
||||||
import qualified Data.Vector as V
|
|
||||||
|
|
||||||
-- | Result of a diff.
|
-- | Result of a diff.
|
||||||
data Diff = Diff {
|
data Diff = Diff {
|
||||||
@ -53,8 +49,8 @@ diff
|
|||||||
-> Text -- ^ Edited text
|
-> Text -- ^ Edited text
|
||||||
-> Diff
|
-> Diff
|
||||||
diff (tokenize -> orig) (tokenize -> edit) =
|
diff (tokenize -> orig) (tokenize -> edit) =
|
||||||
trimDiff (diffL (PV.hunks diffBA (V.fromList edit')))
|
trimDiff (diffL (PV.hunks diffBA (toVector edit')))
|
||||||
(diffR (PV.hunks diffAB (V.fromList orig')))
|
(diffR (PV.hunks diffAB (toVector orig')))
|
||||||
& _diffContextAbove %~ (prefix <>)
|
& _diffContextAbove %~ (prefix <>)
|
||||||
& _diffContextBelow %~ (<> suffix)
|
& _diffContextBelow %~ (<> suffix)
|
||||||
where
|
where
|
||||||
@ -62,7 +58,7 @@ diff (tokenize -> orig) (tokenize -> edit) =
|
|||||||
-- big unchanged parts in advance helps us
|
-- big unchanged parts in advance helps us
|
||||||
(prefix, (orig', edit'), suffix) = commonParts orig edit
|
(prefix, (orig', edit'), suffix) = commonParts orig edit
|
||||||
-- then we compute orig→edit and edit→orig diffs
|
-- then we compute orig→edit and edit→orig diffs
|
||||||
diffAB = PV.diff (V.fromList orig') (V.fromList edit')
|
diffAB = PV.diff (toVector orig') (toVector edit')
|
||||||
diffBA = PV.inverse diffAB
|
diffBA = PV.inverse diffAB
|
||||||
|
|
||||||
-- | Create a diff for the right (edited) part. We only want to highlight
|
-- | Create a diff for the right (edited) part. We only want to highlight
|
||||||
@ -70,8 +66,8 @@ diff (tokenize -> orig) (tokenize -> edit) =
|
|||||||
diffR :: PV.Hunks Text -> [DiffChunk]
|
diffR :: PV.Hunks Text -> [DiffChunk]
|
||||||
diffR = removeExtraAdded . concatMap hunkToChunk
|
diffR = removeExtraAdded . concatMap hunkToChunk
|
||||||
where
|
where
|
||||||
hunkToChunk (v, PV.Inserted) = [Added (tconcat v)]
|
hunkToChunk (v, PV.Inserted) = [Added (mconcat (toList v))]
|
||||||
hunkToChunk (v, PV.Replaced) = [Added (tconcat v)]
|
hunkToChunk (v, PV.Replaced) = [Added (mconcat (toList v))]
|
||||||
hunkToChunk (v, PV.Unchanged) = map Plain (toList v)
|
hunkToChunk (v, PV.Unchanged) = map Plain (toList v)
|
||||||
-- it's useful to report deleted things as well because then we can mark
|
-- it's useful to report deleted things as well because then we can mark
|
||||||
-- them with tiny rectangles like “insert here”
|
-- them with tiny rectangles like “insert here”
|
||||||
@ -97,8 +93,8 @@ diffL = removeExtraDeleted . concatMap hunkToChunk
|
|||||||
-- first. When something was “inserted” to original text when going
|
-- first. When something was “inserted” to original text when going
|
||||||
-- edit→orig, it actually means that it was deleted from the original
|
-- edit→orig, it actually means that it was deleted from the original
|
||||||
-- text when going orig→edit, and thus we want to render it as deleted.
|
-- text when going orig→edit, and thus we want to render it as deleted.
|
||||||
hunkToChunk (v, PV.Inserted) = [Deleted (tconcat v)]
|
hunkToChunk (v, PV.Inserted) = [Deleted (mconcat (toList v))]
|
||||||
hunkToChunk (v, PV.Replaced) = [Deleted (tconcat v)]
|
hunkToChunk (v, PV.Replaced) = [Deleted (mconcat (toList v))]
|
||||||
hunkToChunk (v, PV.Unchanged) = map Plain (toList v)
|
hunkToChunk (v, PV.Unchanged) = map Plain (toList v)
|
||||||
hunkToChunk (_, PV.Deleted) = [Deleted ""]
|
hunkToChunk (_, PV.Deleted) = [Deleted ""]
|
||||||
removeExtraDeleted (Deleted "" : Deleted x : xs) =
|
removeExtraDeleted (Deleted "" : Deleted x : xs) =
|
||||||
@ -132,9 +128,6 @@ trimDiff a b =
|
|||||||
-- Utils
|
-- Utils
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
|
|
||||||
tconcat :: Vector Text -> Text
|
|
||||||
tconcat = mconcat . toList
|
|
||||||
|
|
||||||
-- | Find longest common prefix
|
-- | Find longest common prefix
|
||||||
commonPrefix :: Eq a => [a] -> [a] -> ([a], ([a], [a]))
|
commonPrefix :: Eq a => [a] -> [a] -> ([a], ([a], [a]))
|
||||||
commonPrefix = go []
|
commonPrefix = go []
|
||||||
|
@ -13,7 +13,6 @@ import Guide.Diff.Tokenize
|
|||||||
|
|
||||||
import qualified Data.Patch as PV
|
import qualified Data.Patch as PV
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Vector as V
|
|
||||||
|
|
||||||
|
|
||||||
-- | An implementation of a 3-way diff and merge.
|
-- | An implementation of a 3-way diff and merge.
|
||||||
@ -22,9 +21,9 @@ merge
|
|||||||
-> Text -- ^ Variant A (preferred)
|
-> Text -- ^ Variant A (preferred)
|
||||||
-> Text -- ^ Variant B
|
-> Text -- ^ Variant B
|
||||||
-> Text -- ^ Merged text
|
-> Text -- ^ Merged text
|
||||||
merge (V.fromList . tokenize -> orig)
|
merge (toVector . tokenize -> orig)
|
||||||
(V.fromList . tokenize -> a)
|
(toVector . tokenize -> a)
|
||||||
(V.fromList . tokenize -> b) =
|
(toVector . tokenize -> b) =
|
||||||
T.concat . toList $ PV.apply (pa <> pb') orig
|
T.concat . toList $ PV.apply (pa <> pb') orig
|
||||||
where
|
where
|
||||||
-- 1. diff
|
-- 1. diff
|
||||||
|
@ -30,7 +30,6 @@ import Guide.Types
|
|||||||
import Guide.Utils
|
import Guide.Utils
|
||||||
import Guide.Views
|
import Guide.Views
|
||||||
|
|
||||||
import qualified Data.Map as M
|
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Network.HTTP.Types.Status as HTTP
|
import qualified Network.HTTP.Types.Status as HTTP
|
||||||
@ -102,7 +101,7 @@ setMethods = do
|
|||||||
do (edit, _) <- dbUpdate (SetCategoryStatus catId status')
|
do (edit, _) <- dbUpdate (SetCategoryStatus catId status')
|
||||||
addEdit edit
|
addEdit edit
|
||||||
do oldEnabledSections <- categoryEnabledSections <$> dbQuery (GetCategory catId)
|
do oldEnabledSections <- categoryEnabledSections <$> dbQuery (GetCategory catId)
|
||||||
let newEnabledSections = S.fromList . concat $
|
let newEnabledSections = toSet . concat $
|
||||||
[ [ItemProsConsSection | prosConsEnabled']
|
[ [ItemProsConsSection | prosConsEnabled']
|
||||||
, [ItemEcosystemSection | ecosystemEnabled']
|
, [ItemEcosystemSection | ecosystemEnabled']
|
||||||
, [ItemNotesSection | notesEnabled'] ]
|
, [ItemNotesSection | notesEnabled'] ]
|
||||||
@ -126,7 +125,7 @@ setMethods = do
|
|||||||
lucidIO $ renderCategoryNotes category
|
lucidIO $ renderCategoryNotes category
|
||||||
else do
|
else do
|
||||||
setStatus HTTP.status409
|
setStatus HTTP.status409
|
||||||
json $ M.fromList [
|
json $ toMap [
|
||||||
("modified" :: Text, modified),
|
("modified" :: Text, modified),
|
||||||
("merged" :: Text, merge original content' modified)]
|
("merged" :: Text, merge original content' modified)]
|
||||||
-- Item info
|
-- Item info
|
||||||
@ -169,7 +168,7 @@ setMethods = do
|
|||||||
lucidIO $ renderItemDescription item
|
lucidIO $ renderItemDescription item
|
||||||
else do
|
else do
|
||||||
setStatus HTTP.status409
|
setStatus HTTP.status409
|
||||||
json $ M.fromList [
|
json $ toMap [
|
||||||
("modified" :: Text, modified),
|
("modified" :: Text, modified),
|
||||||
("merged" :: Text, merge original content' modified)]
|
("merged" :: Text, merge original content' modified)]
|
||||||
-- Item ecosystem
|
-- Item ecosystem
|
||||||
@ -184,7 +183,7 @@ setMethods = do
|
|||||||
lucidIO $ renderItemEcosystem item
|
lucidIO $ renderItemEcosystem item
|
||||||
else do
|
else do
|
||||||
setStatus HTTP.status409
|
setStatus HTTP.status409
|
||||||
json $ M.fromList [
|
json $ toMap [
|
||||||
("modified" :: Text, modified),
|
("modified" :: Text, modified),
|
||||||
("merged" :: Text, merge original content' modified)]
|
("merged" :: Text, merge original content' modified)]
|
||||||
-- Item notes
|
-- Item notes
|
||||||
@ -200,7 +199,7 @@ setMethods = do
|
|||||||
lucidIO $ renderItemNotes category item
|
lucidIO $ renderItemNotes category item
|
||||||
else do
|
else do
|
||||||
setStatus HTTP.status409
|
setStatus HTTP.status409
|
||||||
json $ M.fromList [
|
json $ toMap [
|
||||||
("modified" :: Text, modified),
|
("modified" :: Text, modified),
|
||||||
("merged" :: Text, merge original content' modified)]
|
("merged" :: Text, merge original content' modified)]
|
||||||
-- Trait
|
-- Trait
|
||||||
@ -216,7 +215,7 @@ setMethods = do
|
|||||||
lucidIO $ renderTrait itemId trait
|
lucidIO $ renderTrait itemId trait
|
||||||
else do
|
else do
|
||||||
setStatus HTTP.status409
|
setStatus HTTP.status409
|
||||||
json $ M.fromList [
|
json $ toMap [
|
||||||
("modified" :: Text, modified),
|
("modified" :: Text, modified),
|
||||||
("merged" :: Text, merge original content' modified)]
|
("merged" :: Text, merge original content' modified)]
|
||||||
|
|
||||||
|
@ -71,4 +71,4 @@ match a b = common (getWords a) (getWords b)
|
|||||||
|
|
||||||
-- | Find how many elements two lists have in common.
|
-- | Find how many elements two lists have in common.
|
||||||
common :: Ord a => [a] -> [a] -> Int
|
common :: Ord a => [a] -> [a] -> Int
|
||||||
common a b = S.size (S.intersection (S.fromList a) (S.fromList b))
|
common a b = S.size (S.intersection (toSet a) (toSet b))
|
||||||
|
@ -346,7 +346,7 @@ addCategory catId title' group' created' = do
|
|||||||
categoryUid = catId,
|
categoryUid = catId,
|
||||||
categoryTitle = title',
|
categoryTitle = title',
|
||||||
categoryGroup = group',
|
categoryGroup = group',
|
||||||
categoryEnabledSections = S.fromList [
|
categoryEnabledSections = toSet [
|
||||||
ItemProsConsSection,
|
ItemProsConsSection,
|
||||||
ItemEcosystemSection,
|
ItemEcosystemSection,
|
||||||
ItemNotesSection ],
|
ItemNotesSection ],
|
||||||
|
@ -43,7 +43,6 @@ import Guide.Utils
|
|||||||
import Guide.Database.Utils (ToPostgres (..), FromPostgres (..))
|
import Guide.Database.Utils (ToPostgres (..), FromPostgres (..))
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import qualified Data.Set as S
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Hasql.Decoders as HD
|
import qualified Hasql.Decoders as HD
|
||||||
import qualified Hasql.Encoders as HE
|
import qualified Hasql.Encoders as HE
|
||||||
@ -302,7 +301,7 @@ changelog ''Category (Past 11, Past 10)
|
|||||||
Removed "categoryEcosystemEnabled" [t|Bool|],
|
Removed "categoryEcosystemEnabled" [t|Bool|],
|
||||||
Removed "categoryNotesEnabled" [t|Bool|],
|
Removed "categoryNotesEnabled" [t|Bool|],
|
||||||
Added "categoryEnabledSections" [hs|
|
Added "categoryEnabledSections" [hs|
|
||||||
S.fromList $ concat
|
toSet $ concat
|
||||||
[ [ItemProsConsSection | categoryProsConsEnabled]
|
[ [ItemProsConsSection | categoryProsConsEnabled]
|
||||||
, [ItemEcosystemSection | categoryEcosystemEnabled]
|
, [ItemEcosystemSection | categoryEcosystemEnabled]
|
||||||
, [ItemNotesSection | categoryNotesEnabled] ] |] ]
|
, [ItemNotesSection | categoryNotesEnabled] ] |] ]
|
||||||
|
@ -92,7 +92,6 @@ import Guide.Views.Utils.Input
|
|||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
import qualified Data.ByteString.Lazy.Char8 as BSLC
|
import qualified Data.ByteString.Lazy.Char8 as BSLC
|
||||||
import qualified Data.List.NonEmpty as NonEmpty
|
import qualified Data.List.NonEmpty as NonEmpty
|
||||||
import qualified Data.Map as M
|
|
||||||
import qualified Data.Semigroup as Semigroup
|
import qualified Data.Semigroup as Semigroup
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
@ -282,7 +281,7 @@ up. Write @foo({{{%js bar}}})@ instead.
|
|||||||
-}
|
-}
|
||||||
mustache :: MonadIO m => PName -> Aeson.Value -> HtmlT m ()
|
mustache :: MonadIO m => PName -> Aeson.Value -> HtmlT m ()
|
||||||
mustache f v = do
|
mustache f v = do
|
||||||
let functions = M.fromList [
|
let functions = toMap [
|
||||||
("selectIf", \[x] -> if x == Aeson.Bool True
|
("selectIf", \[x] -> if x == Aeson.Bool True
|
||||||
then return (Aeson.String "selected")
|
then return (Aeson.String "selected")
|
||||||
else return Aeson.Null),
|
else return Aeson.Null),
|
||||||
|
@ -224,12 +224,12 @@ defSelectAll s = filterElems s =<< findElems (ByXPath "//")
|
|||||||
|
|
||||||
defFilterElems :: CanSelect a => a -> [Element] -> WD [Element]
|
defFilterElems :: CanSelect a => a -> [Element] -> WD [Element]
|
||||||
defFilterElems s es = do
|
defFilterElems s es = do
|
||||||
ss <- Set.fromList <$> selectAll s
|
ss <- toSet <$> selectAll s
|
||||||
return (filter (`Set.member` ss) es)
|
return (filter (`Set.member` ss) es)
|
||||||
|
|
||||||
defAnyElem :: CanSelect a => a -> [Element] -> WD Bool
|
defAnyElem :: CanSelect a => a -> [Element] -> WD Bool
|
||||||
defAnyElem s es = do
|
defAnyElem s es = do
|
||||||
ss <- Set.fromList <$> selectAll s
|
ss <- toSet <$> selectAll s
|
||||||
return (any (`Set.member` ss) es)
|
return (any (`Set.member` ss) es)
|
||||||
|
|
||||||
{- NOTE [staleness]
|
{- NOTE [staleness]
|
||||||
@ -273,8 +273,8 @@ instance CanSelect ComplexSelector where
|
|||||||
(a :& b) -> do
|
(a :& b) -> do
|
||||||
filterElems b =<< selectAll a
|
filterElems b =<< selectAll a
|
||||||
(a :| b) -> do
|
(a :| b) -> do
|
||||||
as <- Set.fromList <$> selectAll a
|
as <- toSet <$> selectAll a
|
||||||
bs <- Set.fromList <$> selectAll b
|
bs <- toSet <$> selectAll b
|
||||||
return (Set.toList (as `Set.union` bs))
|
return (Set.toList (as `Set.union` bs))
|
||||||
Take n a -> take n <$> selectAll a
|
Take n a -> take n <$> selectAll a
|
||||||
Index n a -> toListOf (ix n) <$> selectAll a
|
Index n a -> toListOf (ix n) <$> selectAll a
|
||||||
|
@ -23,7 +23,7 @@ extra-deps:
|
|||||||
- webdriver-0.9.0.1
|
- webdriver-0.9.0.1
|
||||||
|
|
||||||
# Not on Stackage
|
# Not on Stackage
|
||||||
- to-1.0.0
|
- to-1.2.0
|
||||||
|
|
||||||
# We want the newest hasql just because
|
# We want the newest hasql just because
|
||||||
- hasql-1.4
|
- hasql-1.4
|
||||||
|
Loading…
Reference in New Issue
Block a user