diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-05-08 01:05:00 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-05-08 01:05:00 +0200 |
commit | 6ce5de5a227267e359aa3c38344e3858f035287d (patch) | |
tree | 445ee27f897324317cef51511363e8f13f010d1a /src/Utils.hs | |
parent | c69563da3ea55820af21edb7cf2af40906630e6e (diff) | |
download | 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.tar 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.tar.gz 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.tar.bz2 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.tar.xz 2017-01-16_17:13:37-6ce5de5a227267e359aa3c38344e3858f035287d.zip |
command interpretation
Diffstat (limited to 'src/Utils.hs')
-rw-r--r-- | src/Utils.hs | 23 |
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 | ||
9 | import Data.Text (Text) | 10 | import Data.Text (Text) |
@@ -20,6 +21,9 @@ import Control.Monad.Writer.Class | |||
20 | import Data.Set (Set) | 21 | import Data.Set (Set) |
21 | import qualified Data.Set as Set | 22 | import qualified Data.Set as Set |
22 | 23 | ||
24 | import Data.Sequence (Seq, ViewR(..), (|>)) | ||
25 | import qualified Data.Sequence as Seq | ||
26 | |||
23 | import Types | 27 | import Types |
24 | 28 | ||
25 | showEntity :: Entity -> Text | 29 | showEntity :: 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 | ||
30 | apply' :: (MonadState Sequence m, MonadWriter History m) => Alteration -> m () | 34 | apply' :: MonadState Context m => Alteration -> Comment -> m () |
31 | apply' alteration = do | 35 | apply' 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 | ||
36 | apply :: Alteration -> Sequence -> (Sequence, History) | 39 | apply :: Alteration -> Comment -> Sequence -> (Sequence, History) |
37 | apply alteration seq = undefined | 40 | apply alteration comment seq = undefined |
38 | 41 | ||
39 | entities :: MonadState Sequence m => m (Set Entity) | 42 | entities :: MonadState Sequence m => m (Set Entity) |
40 | entities = Set.fromList . MaxPQueue.elems <$> get | 43 | entities = Set.fromList . MaxPQueue.elems <$> get |
44 | |||
45 | takeR :: Integer -> Seq a -> Seq a | ||
46 | takeR _ (Seq.viewr -> EmptyR) = Seq.empty | ||
47 | takeR n (Seq.viewr -> (xs :> x)) | ||
48 | | n <= 0 = Seq.empty | ||
49 | | otherwise = takeR (n - 1) xs |> x | ||