1
1
mirror of https://github.com/aelve/guide.git synced 2024-11-22 03:12:58 +03:00

Migrate to to-1.2.0 (#382)

* Migrate to to-1.1.0

* Migrate to to-1.2.0
This commit is contained in:
Artyom Kazak 2019-08-19 13:41:34 +03:00 committed by mergify[bot]
parent 29a2fb718c
commit 0d170b3e30
9 changed files with 25 additions and 36 deletions

View File

@ -18,17 +18,13 @@ module Guide.Diff
)
where
-- shared imports
import Imports
-- Vector
import Data.Vector (Vector)
import Guide.Diff.Merge (merge)
import Guide.Diff.Tokenize (tokenize)
import Guide.Utils (makeClassWithLenses)
import qualified Data.Patch as PV
import qualified Data.Vector as V
-- | Result of a diff.
data Diff = Diff {
@ -53,8 +49,8 @@ diff
-> Text -- ^ Edited text
-> Diff
diff (tokenize -> orig) (tokenize -> edit) =
trimDiff (diffL (PV.hunks diffBA (V.fromList edit')))
(diffR (PV.hunks diffAB (V.fromList orig')))
trimDiff (diffL (PV.hunks diffBA (toVector edit')))
(diffR (PV.hunks diffAB (toVector orig')))
& _diffContextAbove %~ (prefix <>)
& _diffContextBelow %~ (<> suffix)
where
@ -62,7 +58,7 @@ diff (tokenize -> orig) (tokenize -> edit) =
-- big unchanged parts in advance helps us
(prefix, (orig', edit'), suffix) = commonParts orig edit
-- 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
-- | 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 = removeExtraAdded . concatMap hunkToChunk
where
hunkToChunk (v, PV.Inserted) = [Added (tconcat v)]
hunkToChunk (v, PV.Replaced) = [Added (tconcat v)]
hunkToChunk (v, PV.Inserted) = [Added (mconcat (toList v))]
hunkToChunk (v, PV.Replaced) = [Added (mconcat (toList v))]
hunkToChunk (v, PV.Unchanged) = map Plain (toList v)
-- it's useful to report deleted things as well because then we can mark
-- 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
-- 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.
hunkToChunk (v, PV.Inserted) = [Deleted (tconcat v)]
hunkToChunk (v, PV.Replaced) = [Deleted (tconcat v)]
hunkToChunk (v, PV.Inserted) = [Deleted (mconcat (toList v))]
hunkToChunk (v, PV.Replaced) = [Deleted (mconcat (toList v))]
hunkToChunk (v, PV.Unchanged) = map Plain (toList v)
hunkToChunk (_, PV.Deleted) = [Deleted ""]
removeExtraDeleted (Deleted "" : Deleted x : xs) =
@ -132,9 +128,6 @@ trimDiff a b =
-- Utils
----------------------------------------------------------------------------
tconcat :: Vector Text -> Text
tconcat = mconcat . toList
-- | Find longest common prefix
commonPrefix :: Eq a => [a] -> [a] -> ([a], ([a], [a]))
commonPrefix = go []

View File

@ -13,7 +13,6 @@ import Guide.Diff.Tokenize
import qualified Data.Patch as PV
import qualified Data.Text as T
import qualified Data.Vector as V
-- | An implementation of a 3-way diff and merge.
@ -22,9 +21,9 @@ merge
-> Text -- ^ Variant A (preferred)
-> Text -- ^ Variant B
-> Text -- ^ Merged text
merge (V.fromList . tokenize -> orig)
(V.fromList . tokenize -> a)
(V.fromList . tokenize -> b) =
merge (toVector . tokenize -> orig)
(toVector . tokenize -> a)
(toVector . tokenize -> b) =
T.concat . toList $ PV.apply (pa <> pb') orig
where
-- 1. diff

View File

@ -30,7 +30,6 @@ import Guide.Types
import Guide.Utils
import Guide.Views
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Network.HTTP.Types.Status as HTTP
@ -102,7 +101,7 @@ setMethods = do
do (edit, _) <- dbUpdate (SetCategoryStatus catId status')
addEdit edit
do oldEnabledSections <- categoryEnabledSections <$> dbQuery (GetCategory catId)
let newEnabledSections = S.fromList . concat $
let newEnabledSections = toSet . concat $
[ [ItemProsConsSection | prosConsEnabled']
, [ItemEcosystemSection | ecosystemEnabled']
, [ItemNotesSection | notesEnabled'] ]
@ -126,7 +125,7 @@ setMethods = do
lucidIO $ renderCategoryNotes category
else do
setStatus HTTP.status409
json $ M.fromList [
json $ toMap [
("modified" :: Text, modified),
("merged" :: Text, merge original content' modified)]
-- Item info
@ -169,7 +168,7 @@ setMethods = do
lucidIO $ renderItemDescription item
else do
setStatus HTTP.status409
json $ M.fromList [
json $ toMap [
("modified" :: Text, modified),
("merged" :: Text, merge original content' modified)]
-- Item ecosystem
@ -184,7 +183,7 @@ setMethods = do
lucidIO $ renderItemEcosystem item
else do
setStatus HTTP.status409
json $ M.fromList [
json $ toMap [
("modified" :: Text, modified),
("merged" :: Text, merge original content' modified)]
-- Item notes
@ -200,7 +199,7 @@ setMethods = do
lucidIO $ renderItemNotes category item
else do
setStatus HTTP.status409
json $ M.fromList [
json $ toMap [
("modified" :: Text, modified),
("merged" :: Text, merge original content' modified)]
-- Trait
@ -216,7 +215,7 @@ setMethods = do
lucidIO $ renderTrait itemId trait
else do
setStatus HTTP.status409
json $ M.fromList [
json $ toMap [
("modified" :: Text, modified),
("merged" :: Text, merge original content' modified)]

View File

@ -71,4 +71,4 @@ match a b = common (getWords a) (getWords b)
-- | Find how many elements two lists have in common.
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))

View File

@ -346,7 +346,7 @@ addCategory catId title' group' created' = do
categoryUid = catId,
categoryTitle = title',
categoryGroup = group',
categoryEnabledSections = S.fromList [
categoryEnabledSections = toSet [
ItemProsConsSection,
ItemEcosystemSection,
ItemNotesSection ],

View File

@ -43,7 +43,6 @@ import Guide.Utils
import Guide.Database.Utils (ToPostgres (..), FromPostgres (..))
import qualified Data.Aeson as Aeson
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
@ -302,7 +301,7 @@ changelog ''Category (Past 11, Past 10)
Removed "categoryEcosystemEnabled" [t|Bool|],
Removed "categoryNotesEnabled" [t|Bool|],
Added "categoryEnabledSections" [hs|
S.fromList $ concat
toSet $ concat
[ [ItemProsConsSection | categoryProsConsEnabled]
, [ItemEcosystemSection | categoryEcosystemEnabled]
, [ItemNotesSection | categoryNotesEnabled] ] |] ]

View File

@ -92,7 +92,6 @@ import Guide.Views.Utils.Input
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as BSLC
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as M
import qualified Data.Semigroup as Semigroup
import qualified Data.Text 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 f v = do
let functions = M.fromList [
let functions = toMap [
("selectIf", \[x] -> if x == Aeson.Bool True
then return (Aeson.String "selected")
else return Aeson.Null),

View File

@ -224,12 +224,12 @@ defSelectAll s = filterElems s =<< findElems (ByXPath "//")
defFilterElems :: CanSelect a => a -> [Element] -> WD [Element]
defFilterElems s es = do
ss <- Set.fromList <$> selectAll s
ss <- toSet <$> selectAll s
return (filter (`Set.member` ss) es)
defAnyElem :: CanSelect a => a -> [Element] -> WD Bool
defAnyElem s es = do
ss <- Set.fromList <$> selectAll s
ss <- toSet <$> selectAll s
return (any (`Set.member` ss) es)
{- NOTE [staleness]
@ -273,8 +273,8 @@ instance CanSelect ComplexSelector where
(a :& b) -> do
filterElems b =<< selectAll a
(a :| b) -> do
as <- Set.fromList <$> selectAll a
bs <- Set.fromList <$> selectAll b
as <- toSet <$> selectAll a
bs <- toSet <$> selectAll b
return (Set.toList (as `Set.union` bs))
Take n a -> take n <$> selectAll a
Index n a -> toListOf (ix n) <$> selectAll a

View File

@ -23,7 +23,7 @@ extra-deps:
- webdriver-0.9.0.1
# Not on Stackage
- to-1.0.0
- to-1.2.0
# We want the newest hasql just because
- hasql-1.4