summaryrefslogtreecommitdiff
path: root/src/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Utils.hs')
-rw-r--r--src/Utils.hs23
1 files changed, 16 insertions, 7 deletions
diff --git a/src/Utils.hs b/src/Utils.hs
index 6c8f0c1..cac88ac 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -4,6 +4,7 @@ module Utils
4 ( showEntity 4 ( showEntity
5 , apply, apply' 5 , apply, apply'
6 , entities 6 , entities
7 , takeR
7 ) where 8 ) where
8 9
9import Data.Text (Text) 10import Data.Text (Text)
@@ -20,6 +21,9 @@ import Control.Monad.Writer.Class
20import Data.Set (Set) 21import Data.Set (Set)
21import qualified Data.Set as Set 22import qualified Data.Set as Set
22 23
24import Data.Sequence (Seq, ViewR(..), (|>))
25import qualified Data.Sequence as Seq
26
23import Types 27import Types
24 28
25showEntity :: Entity -> Text 29showEntity :: Entity -> Text
@@ -27,14 +31,19 @@ showEntity (Entity name number)
27 | (Just (show -> n)) <- number = name <> " № " <> Text.pack n 31 | (Just (show -> n)) <- number = name <> " № " <> Text.pack n
28 | otherwise = name 32 | otherwise = name
29 33
30apply' :: (MonadState Sequence m, MonadWriter History m) => Alteration -> m () 34apply' :: MonadState Context m => Alteration -> Comment -> m ()
31apply' alteration = do 35apply' alteration comment = modify $ onCtx (apply alteration comment)
32 (newSt, hist) <- apply alteration <$> get 36 where
33 tell hist 37 onCtx f ctx = let (sequence', history') = f $ ctxSequence ctx in ctx { ctxSequence = sequence', ctxHistory = ctxHistory ctx <> history' }
34 put newSt
35 38
36apply :: Alteration -> Sequence -> (Sequence, History) 39apply :: Alteration -> Comment -> Sequence -> (Sequence, History)
37apply alteration seq = undefined 40apply alteration comment seq = undefined
38 41
39entities :: MonadState Sequence m => m (Set Entity) 42entities :: MonadState Sequence m => m (Set Entity)
40entities = Set.fromList . MaxPQueue.elems <$> get 43entities = Set.fromList . MaxPQueue.elems <$> get
44
45takeR :: Integer -> Seq a -> Seq a
46takeR _ (Seq.viewr -> EmptyR) = Seq.empty
47takeR n (Seq.viewr -> (xs :> x))
48 | n <= 0 = Seq.empty
49 | otherwise = takeR (n - 1) xs |> x