├── .codeclimate.yml ├── .gitignore ├── .travis.yml ├── LICENSE.md ├── README.md ├── Setup.hs ├── Vihs.cabal ├── app └── Main.hs ├── appveyor.yml ├── circle.yml ├── examples └── test.txt ├── src ├── CmdParser.hs ├── Delete.hs ├── Ed.hs ├── HiddenChar │ └── HiddenChar.hs ├── Insert.hs ├── ParseCmd.hs ├── ReadWrite.hs ├── TUI.hs ├── Vihs.hs ├── test.txt ├── test1.txt └── test2.txt ├── stack.yaml ├── test.txt └── test ├── InsertSpec.hs ├── ParseCmdSpec.hs └── Spec.hs /.codeclimate.yml: -------------------------------------------------------------------------------- 1 | engines: 2 | hlint: 3 | enabled: true 4 | ratings: 5 | paths: 6 | - "**.hs" 7 | 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | dist 3 | dist-* 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | .hpc 12 | .hsenv 13 | .cabal-sandbox/ 14 | cabal.sandbox.config 15 | *.prof 16 | *.aux 17 | *.hp 18 | *.eventlog 19 | .stack-work/ 20 | cabal.project.local 21 | .HTF/ 22 | .html/ 23 | .*.swp 24 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This is the simple Travis configuration, which is intended for use 2 | # on applications which do not require cross-platform and 3 | # multiple-GHC-version support. For more information and other 4 | # options, see: 5 | # 6 | # https://docs.haskellstack.org/en/stable/travis_ci/ 7 | # 8 | # Copy these contents into the root directory of your Github project in a file 9 | # named .travis.yml 10 | 11 | # Use new container infrastructure to enable caching 12 | sudo: false 13 | 14 | # Do not choose a language; we provide our own build tools. 15 | language: generic 16 | 17 | # Caching so the next build will be fast too. 18 | cache: 19 | directories: 20 | - $HOME/.stack 21 | 22 | # Ensure necessary system libraries are present 23 | addons: 24 | apt: 25 | packages: 26 | - libgmp-dev 27 | 28 | before_install: 29 | # Download and unpack the stack executable 30 | - mkdir -p ~/.local/bin 31 | - export PATH=$HOME/.local/bin:$PATH 32 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 33 | 34 | install: 35 | # Build dependencies 36 | - stack --install-ghc install --only-dependencies 37 | - stack --install-ghc test --only-dependencies 38 | 39 | script: 40 | # Build the package, its tests, and its docs and run the tests 41 | - stack --no-terminal test --haddock --no-haddock-deps 42 | - stack clean 43 | - stack test --coverage 44 | 45 | after_script: 46 | - travis_retry curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.4.0/shc-linux-x64-8.0.1.tar.bz2 | tar -xj 47 | - ./shc Vihs Vihs-test 48 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/Tatsuki-I/Vihs.svg?branch=master)](https://travis-ci.org/Tatsuki-I/Vihs) 2 | [![Build status](https://ci.appveyor.com/api/projects/status/1furioph5w7o3fr3?svg=true)](https://ci.appveyor.com/project/Tatsuki-I/vihs) 3 | [![CircleCI](https://circleci.com/gh/Tatsuki-I/Vihs.svg?style=svg)](https://circleci.com/gh/Tatsuki-I/Vihs) 4 | [![Coverage Status](https://coveralls.io/repos/github/Tatsuki-I/Vihs/badge.svg?branch=master)](https://coveralls.io/github/Tatsuki-I/Vihs?branch=master) 5 | [![Code Climate](https://codeclimate.com/github/Tatsuki-I/Vihs/badges/gpa.svg)](https://codeclimate.com/github/codeclimate/codeclimate) 6 | [![Issue Count](https://codeclimate.com/github/Tatsuki-I/Vihs/badges/issue_count.svg)](https://codeclimate.com/github/codeclimate/codeclimate) 7 | 8 | # Vihs 9 | Vim like Text editor by Haskell. 10 | 11 | ## How to run 12 | `stack build` to build Vihs. 13 | `stack exec vihs` to run Vihs. 14 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /Vihs.cabal: -------------------------------------------------------------------------------- 1 | name: Vihs 2 | version: 0.1.0.0 3 | synopsis: Vim like Text editor by Haskell. 4 | description: Vim like Text editor by Haskell. 5 | homepage: https://github.com/Tatsuki-I/Vihs#readme 6 | license: Apache-2.0 7 | license-file: LICENSE.md 8 | author: Tatsuki-I 9 | maintainer: Tatsuki-I 10 | copyright: 2017 Tatsuki-I 11 | category: Editor 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Ed 19 | , Vihs 20 | , Insert 21 | , ReadWrite 22 | , Delete 23 | , ParseCmd 24 | , CmdParser 25 | , HiddenChar.HiddenChar 26 | build-depends: base >= 4.7 && < 5 27 | , parsec 28 | , haskeline 29 | , safe 30 | , mtl 31 | , process 32 | , brick 33 | , lens 34 | default-language: Haskell2010 35 | 36 | executable vihs 37 | hs-source-dirs: app 38 | main-is: Main.hs 39 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror -optc-O3 -O2 40 | build-depends: base 41 | , Vihs 42 | default-language: Haskell2010 43 | 44 | test-suite Vihs-test 45 | type: exitcode-stdio-1.0 46 | hs-source-dirs: test 47 | main-is: Spec.hs 48 | other-modules: InsertSpec 49 | , ParseCmdSpec 50 | build-depends: base 51 | , Vihs 52 | , hspec 53 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 54 | default-language: Haskell2010 55 | 56 | source-repository head 57 | type: git 58 | location: https://github.com/Tatsuki-I/Vihs 59 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Vihs 4 | import Control.Monad 5 | 6 | main :: IO () 7 | main = Control.Monad.void vihsTestRun 8 | {- 9 | import System.Environment (getArgs) 10 | 11 | main :: IO VihsState 12 | main = do args <- getArgs 13 | buff <- readFile $ args !! 0 14 | vihsRun $ vihsInit (args !! 0) $ lines buff 15 | -} 16 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # Disabled cache in hope of improving reliability of AppVeyor builds 2 | #cache: 3 | #- "c:\\sr" # stack root, short paths == fewer problems 4 | 5 | build: off 6 | 7 | before_test: 8 | # http://help.appveyor.com/discussions/problems/6312-curl-command-not-found 9 | - set PATH=C:\Program Files\Git\mingw64\bin;%PATH% 10 | 11 | - curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-i386 12 | - 7z x stack.zip stack.exe 13 | 14 | clone_folder: "c:\\stack" 15 | environment: 16 | global: 17 | STACK_ROOT: "c:\\sr" 18 | 19 | test_script: 20 | - stack setup > nul 21 | # The ugly echo "" hack is to avoid complaints about 0 being an invalid file 22 | # descriptor 23 | - echo "" | stack --no-terminal test --jobs 1 24 | -------------------------------------------------------------------------------- /circle.yml: -------------------------------------------------------------------------------- 1 | machine: 2 | ghc: 3 | version: 7.8.3 4 | -------------------------------------------------------------------------------- /examples/test.txt: -------------------------------------------------------------------------------- 1 | hello 2 | hello world 3 | -------------------------------------------------------------------------------- /src/CmdParser.hs: -------------------------------------------------------------------------------- 1 | module CmdParser where 2 | 3 | import Text.Parsec 4 | 5 | import Control.Arrow 6 | import Data.Char 7 | import Text.Read 8 | 9 | test :: Parsec String u String 10 | test = many (digit <|> letter) 11 | 12 | parseCmd' :: String -> (Maybe Int, String) 13 | parseCmd' = first readMaybe . span isDigit 14 | -------------------------------------------------------------------------------- /src/Delete.hs: -------------------------------------------------------------------------------- 1 | module Delete where 2 | 3 | deleteLine :: [String] -> Int -> Int ->[String] 4 | deleteLine str line times | line <= length str 5 | && line >= 0 6 | && line - 1 <= length str = take (line - 1) str ++ 7 | (reverse . take 8 | (length str - line - times + 1) 9 | $ reverse str) 10 | | otherwise = str 11 | {- 12 | deleteLine str line n | line <= length str && line >= 0 && line + n - 1 <= length str = (take line str) ++ (reverse $ take ((length str) - line - n) $ reverse str) 13 | -} 14 | 15 | {- 16 | main = do 17 | print $ deleteLine str 1 1 18 | where 19 | str = ["aaa", "bbb", "ccc"] 20 | -} 21 | -------------------------------------------------------------------------------- /src/Ed.hs: -------------------------------------------------------------------------------- 1 | module Ed where 2 | 3 | import Control.Monad (unless) 4 | import Data.Maybe 5 | import Delete 6 | import ParseCmd 7 | import ReadWrite 8 | import Safe (headMay) 9 | import System.Console.Haskeline 10 | import Text.Parsec 11 | 12 | data EdArgs = EdArgs { fileName :: String 13 | , buff :: [String] 14 | , crrLine :: Int 15 | , saved :: Bool 16 | } deriving (Show) 17 | 18 | fixAddr :: EdArgs -> AddrVal -> Int 19 | fixAddr _ (AddrLine l) = l 20 | fixAddr e (AddrCrr dl) = crrLine e + dl 21 | fixAddr e AddrEOF = length $ buff e 22 | 23 | addr1 :: Command -> EdArgs -> Maybe Int 24 | addr1 cmd edArgs = ((fixAddr edArgs . takeAddr1) <$>) (addr cmd) 25 | where 26 | takeAddr1 (AddrSingle v) = v 27 | takeAddr1 (AddrPair v _) = v 28 | 29 | addr2 :: Command -> EdArgs-> Maybe Int 30 | addr2 cmd edArgs = ((fixAddr edArgs . takeAddr2) <$>) (addr cmd) 31 | where 32 | takeAddr2 (AddrPair _ v) = v 33 | 34 | ed :: [String] -> IO () 35 | ed args = do 36 | x <- if null args 37 | then return [] 38 | else createBuffer $ fromMaybe "" $ headMay args 39 | inputCmd >>= (`ed'` EdArgs (if null args 40 | then [] 41 | else fromMaybe "" $ headMay args) x 1 True) 42 | 43 | ed' :: Command -> EdArgs -> IO () 44 | ed' cmd edArgs = case cmdName cmd of 45 | 'q' -> unless (saved edArgs) $ do 46 | putStrLn "?" 47 | newCmd <- inputCmd 48 | ed' newCmd edArgs {saved = cmdName newCmd == 'q'} 49 | 'a' -> insert >>= (\x -> inputCmd >>= 50 | (`ed'` edArgs {buff = iCmd (buff edArgs) x $ fromMaybe (crrLine edArgs) (addr1 cmd edArgs) + 1, saved = False})) 51 | 'i' -> insert >>= (\x -> inputCmd >>= 52 | (`ed'` edArgs {buff = iCmd (buff edArgs) x $ fromMaybe (crrLine edArgs) $ addr1 cmd edArgs, saved = False})) 53 | 'd' -> inputCmd >>= 54 | (`ed'` edArgs {buff = deleteLine (buff edArgs) (fromMaybe (crrLine edArgs) $ addr1 cmd edArgs) (fromMaybe 1 $ addr2 cmd edArgs), saved = False}) 55 | 'l' -> do 56 | printBuff cmd edArgs $ addDll $ buff edArgs 57 | inputCmd >>= (`ed'` edArgs) 58 | 'n' -> do 59 | let infNo = map show (take (length $ buff edArgs) [1, 2..]) 60 | printBuff cmd edArgs $ zipWith (++) (map (take 8 . (++ repeat ' ')) infNo) (addDll $ buff edArgs) 61 | inputCmd >>= (`ed'` edArgs) 62 | 'w' -> if isNothing $ param cmd 63 | then putStrLn "?" >> 64 | inputCmd >>= 65 | (`ed'` edArgs) 66 | else buffToFile (fromJust (param cmd)) (buff edArgs) >> 67 | (print (length (unlines $ buff edArgs)) >> 68 | inputCmd >>= (`ed'` edArgs {saved = True})) 69 | _ -> putStrLn "?" >> inputCmd >>= (`ed'` edArgs) 70 | 71 | inputCmd :: IO Command 72 | inputCmd = setCmd . fromMaybe "" <$> runInputT defaultSettings (getInputLine "") 73 | 74 | addDll :: [String] -> [String] 75 | addDll = map (++"$") 76 | 77 | printBuff :: Command -> EdArgs -> [String] -> IO () 78 | printBuff cmd edArgs allLines = putStr 79 | $ unlines 80 | $ drop (fromMaybe (crrLine edArgs) 81 | (addr1 cmd edArgs) - 1) 82 | (reverse (drop (length allLines - (fromMaybe (crrLine edArgs) (addr1 cmd edArgs) + fromMaybe 1 (addr2 cmd edArgs) - 1)) $ reverse allLines)) 83 | 84 | iCmd :: [String] -> [String] -> Int -> [String] 85 | iCmd buff buff2 line = take (line - 1) buff ++ 86 | buff2 ++ 87 | reverse (take (length buff - line + 1) (reverse buff)) 88 | 89 | insert :: IO [String] 90 | insert = insert' [] False 91 | where 92 | insert' :: [String] -> Bool -> IO [String] 93 | insert' buff done | done = return buff 94 | | otherwise = do str <- getLine 95 | if str == "." 96 | then insert' buff True 97 | else insert' (buff ++ [str]) False 98 | -------------------------------------------------------------------------------- /src/HiddenChar/HiddenChar.hs: -------------------------------------------------------------------------------- 1 | -- copied from https://github.com/hsjoihs/camphorscript/blob/master/HiddenChar/HiddenChar.hs 2 | 3 | {-# LANGUAGE ForeignFunctionInterface, CPP #-} 4 | module HiddenChar.HiddenChar 5 | (getHiddenChar 6 | )where 7 | import Data.Char 8 | import Foreign.C.Types 9 | import System.IO 10 | 11 | 12 | getHiddenChar :: IO Char 13 | 14 | #if defined(__GLASGOW_HASKELL__) && ( defined(VERSION_Win32) || defined(VERSION_Win64) ) 15 | 16 | getHiddenChar = fmap (chr.fromEnum) c_getch 17 | foreign import ccall unsafe "conio.h getch" 18 | c_getch :: IO CInt 19 | -- copied from http://stackoverflow.com/questions/2983974/haskell-read-input-character-from-console-immediately-not-after-newline 20 | 21 | #else 22 | 23 | getHiddenChar = do 24 | hSetBuffering stdin NoBuffering 25 | getChar 26 | 27 | #endif 28 | -------------------------------------------------------------------------------- /src/Insert.hs: -------------------------------------------------------------------------------- 1 | module Insert where 2 | 3 | insert :: String -> String -> Int -> String 4 | insert buff c x = take x buff ++ c ++ reverse (take (length buff - x) (reverse buff)) 5 | 6 | insertBuff :: [String] -> String -> Int -> Int -> [String] 7 | insertBuff buff c x y = take y buff ++ [insert (buff !! y) c x] ++ reverse (take (length buff - y - 1) (reverse buff)) 8 | 9 | main :: IO () 10 | main = do 11 | print $ take 1 str 12 | print $ insertBuff str "b" 1 2 13 | where 14 | str = ["AAA", "BBB", "CCC"] 15 | -------------------------------------------------------------------------------- /src/ParseCmd.hs: -------------------------------------------------------------------------------- 1 | module ParseCmd where 2 | 3 | import Control.Applicative 4 | import qualified Text.Parsec as P 5 | import Text.Parsec.String 6 | 7 | data Command = Command { addr :: Maybe Addr 8 | , cmdName :: Char 9 | , param :: Maybe String 10 | } deriving (Show, Eq) 11 | 12 | data Addr = AddrSingle AddrVal 13 | | AddrPair AddrVal AddrVal 14 | deriving (Show, Eq) 15 | 16 | data AddrVal = AddrLine Int 17 | | AddrCrr Int 18 | | AddrEOF 19 | deriving (Show, Eq) 20 | 21 | addrCrrLine :: AddrVal 22 | addrCrrLine = AddrCrr 0 23 | 24 | setCmd :: String -> Command 25 | setCmd str = case P.parse parseCmd "" str of 26 | Right cmd -> cmd 27 | Left err -> Command Nothing ' ' Nothing 28 | --putStrLn ("No match: " ++ show err) 29 | 30 | parseCmd :: Parser Command 31 | parseCmd = Command <$> parseAddr 32 | <*> parseCmdName 33 | <*> parseParam 34 | 35 | parseAddr :: Parser (Maybe Addr) 36 | parseAddr = optional parseAddr' 37 | where 38 | parseAddr' = parseHeadToEOF 39 | <|> parseCrrToEOF 40 | <|> parseAddrs 41 | 42 | parseHeadToEOF = P.char ',' 43 | *> pure (AddrPair (AddrLine 1) AddrEOF) 44 | 45 | parseCrrToEOF = P.char ';' 46 | *> pure (AddrPair addrCrrLine AddrEOF) 47 | 48 | parseAddrs = do (x:xs) <- parseIntList 49 | return $ if null xs 50 | then AddrSingle $ AddrLine x 51 | else AddrPair (AddrLine x) (AddrLine $ last xs) 52 | 53 | parseCmdName :: Parser Char 54 | parseCmdName = P.letter 55 | 56 | parseParam :: Parser (Maybe String) 57 | parseParam = P.spaces 58 | *> (listToMaybeList <$> P.many P.anyChar) 59 | where 60 | listToMaybeList [] = Nothing 61 | listToMaybeList xs = Just xs 62 | 63 | parseIntList :: Parser [Int] 64 | parseIntList = parseInt `P.sepBy1` P.char ',' 65 | 66 | parseInt :: Parser Int 67 | parseInt = do value <- P.many1 P.digit 68 | return (read value) 69 | -------------------------------------------------------------------------------- /src/ReadWrite.hs: -------------------------------------------------------------------------------- 1 | module ReadWrite where 2 | 3 | createBuffer :: String -> IO [String] 4 | createBuffer path = readFile path >>= \x -> return $ lines x 5 | 6 | buffToFile :: String -> [String] -> IO () 7 | buffToFile path str = writeFile path $ unlines str 8 | -------------------------------------------------------------------------------- /src/TUI.hs: -------------------------------------------------------------------------------- 1 | --module TUI where 2 | 3 | import Graphics.Vty 4 | 5 | main = do vty <- standardIOConfig >>= mkVty 6 | update vty . picForImage $ string (defAttr `withForeColor` green) "Hello vty" 7 | e <- nextEvent vty 8 | shutdown vty 9 | print e 10 | 11 | -------------------------------------------------------------------------------- /src/Vihs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Vihs 4 | ( VihsState 5 | , vihsRun 6 | , vihsTestRun 7 | , vihsInit 8 | , vihsDefault 9 | ) where 10 | 11 | import Control.Monad.State 12 | import Control.Lens 13 | import System.Console.Haskeline 14 | import Data.Maybe 15 | import System.Process 16 | import HiddenChar.HiddenChar 17 | import CmdParser 18 | 19 | data VihsState = VihsState { _mode :: Mode 20 | , _row :: Row 21 | , _column :: Column 22 | , _yanked :: String 23 | , _quited :: Bool 24 | , _number :: Bool 25 | } deriving (Show) 26 | 27 | data FileState = FileState { _path :: FilePath 28 | , _buff :: Text 29 | , _saved :: Bool 30 | } deriving (Show) 31 | 32 | data Cmd = Move Direction Count 33 | | Insert Char 34 | | Delete Count 35 | | DelLine Count 36 | | Replace Count 37 | | Change Mode 38 | | None String 39 | deriving (Show) 40 | 41 | data Direction = DOWN 42 | | UP 43 | | LEFT 44 | | RIGHT 45 | deriving (Show) 46 | 47 | data Mode = NORMAL 48 | | INSERT Char 49 | | VISUAL 50 | | EX 51 | | REPLACE 52 | deriving (Show) 53 | 54 | data ExCmd = Write FilePath 55 | | Quit 56 | | To Mode 57 | | Term 58 | | Git Option 59 | | Stack Option 60 | | Number Bool 61 | deriving (Show) 62 | 63 | type EditorState = (VihsState, [FileState]) 64 | type Line = String 65 | type Text = [Line] 66 | type Row = Int 67 | type Column = Int 68 | type Count = Int 69 | type Option = String 70 | 71 | makeLenses ''VihsState 72 | makeLenses ''FileState 73 | 74 | vihsInit :: VihsState 75 | vihsInit = VihsState { _mode = NORMAL 76 | , _row = 0 77 | , _column = 0 78 | , _yanked = "" 79 | , _quited = False 80 | , _number = False } 81 | 82 | fileInit :: FilePath -> Text -> FileState 83 | fileInit path buff = FileState { _path = path 84 | , _buff = buff 85 | , _saved = True } 86 | 87 | editorInit :: VihsState -> FileState -> EditorState 88 | editorInit vs fs = (vs, [fs]) 89 | 90 | vihsDefault :: EditorState 91 | vihsDefault = (vihsInit, [fileInit "vihstest.txt" 92 | [ "Hello Vihs!" 93 | , "I'm 2nd line" 94 | , "I'm 3rd line" ]]) 95 | 96 | vihsTestRun :: IO EditorState 97 | vihsTestRun = vihsRun vihsDefault 98 | 99 | currline :: EditorState -> Line 100 | currline (vs, (fs : _)) = (fs ^. buff) !! (vs ^. row) 101 | 102 | filelength :: FileState -> Int 103 | filelength fs = length $ fs ^. buff 104 | 105 | parseCmd :: String -> EditorState -> IO Cmd 106 | parseCmd str st = do str' <- stream' str 107 | let (c, cmd) = parseCmd' str' 108 | putStrLn "" 109 | print $ parseCmd' str' 110 | case cmd of 111 | "j" -> return . Move DOWN $ fromMaybe 1 c 112 | "k" -> return . Move UP $ fromMaybe 1 c 113 | "h" -> return . Move LEFT $ fromMaybe 1 c 114 | "l" -> return . Move RIGHT $ fromMaybe 1 c 115 | "x" -> return . Delete $ fromMaybe 1 c 116 | "r" -> return $ Change REPLACE 117 | "R" -> return $ Replace 1 118 | "i" -> return $ Insert 'i' 119 | "I" -> return $ Insert 'I' 120 | "a" -> return $ Insert 'a' 121 | "A" -> return $ Insert 'A' 122 | "o" -> return $ Insert 'o' 123 | "O" -> return $ Insert 'O' 124 | ":" -> return $ Change EX 125 | "dd" -> return . DelLine $ fromMaybe 1 c 126 | _ -> do print str' 127 | vihsPrint False st 128 | parseCmd str' st 129 | 130 | switcher :: String -> Char -> String 131 | switcher str ch = case ch of 132 | '\DEL' -> if null str 133 | then "" 134 | else init str 135 | '\ESC' -> "" 136 | _ -> str ++ [ch] 137 | 138 | stream' :: String -> IO String 139 | stream' str = do ch <- getHiddenChar 140 | return $ switcher str ch 141 | 142 | parseExCmd :: String -> ExCmd 143 | parseExCmd cmd = case head (words cmd) of 144 | cmd | cmd == "w" 145 | , cmd == "write" 146 | -> Write $ words cmd !! 1 147 | cmd | cmd == "q" 148 | , cmd == "quit" 149 | -> Quit 150 | "set" -> Number $ case words cmd !! 1 of 151 | "number" -> True 152 | "nonumber" -> False 153 | "terminal" -> Term 154 | "git" -> Git . unwords . drop 1 $ words cmd 155 | "stack" -> Stack . unwords . drop 1 $ words cmd 156 | ch | ch == "BS" 157 | , ch == "\b" 158 | -> To NORMAL 159 | _ -> undefined 160 | 161 | vihsRun :: EditorState -> IO EditorState 162 | vihsRun st@(vs, _) = do vihsPrint False st 163 | if vs ^. quited 164 | then return st 165 | else case vs ^. mode of 166 | NORMAL -> normalRun st 167 | EX -> exRun st 168 | INSERT ch -> insert ch st 169 | REPLACE -> replace st 170 | 171 | normalRun :: EditorState -> IO EditorState 172 | normalRun st = do cmd <- parseCmd "" st 173 | print cmd 174 | normal cmd `execStateT` st >>= vihsRun 175 | 176 | normal :: Cmd -> StateT EditorState IO () 177 | normal cmd = case cmd of 178 | Move DOWN c -> modify $ move (+ c) id 179 | Move UP c -> modify $ move (subtract c) id 180 | Move LEFT c -> modify $ move id (subtract c) 181 | Move RIGHT c -> modify $ move id (+ c) 182 | Delete c -> modify $ delete c 183 | DelLine c -> modify $ delLine c 184 | Insert ch -> get >>= (lift . insert ch) >>= put 185 | Replace 1 -> get >>= (lift . replace) >>= put 186 | Change mode -> modify $ toMode mode 187 | None str -> get >>= (lift . nocmd str) 188 | 189 | exRun :: EditorState -> IO EditorState 190 | exRun st = do cmd <- fromMaybe "" 191 | <$> runInputT defaultSettings (getInputLine ":") 192 | putStrLn "" 193 | (nvs, nfs) <- ex (parseExCmd cmd) `execStateT` st >>= vihsRun 194 | return (nvs & mode .~ NORMAL, nfs) 195 | 196 | ex :: ExCmd -> StateT EditorState IO () 197 | ex cmd = case cmd of 198 | Write path -> get >>= (lift . write path . toMode NORMAL) >>= put 199 | Quit -> modify $ quit . toMode NORMAL 200 | Term -> get >>= (lift . term . toMode NORMAL) 201 | Git opt -> get >>= (lift . git opt . toMode NORMAL) 202 | Stack opt -> get >>= (lift . stack opt . toMode NORMAL) 203 | Number b -> modify $ setnum b . toMode NORMAL 204 | To NORMAL -> modify $ toMode NORMAL 205 | 206 | move :: (Row -> Row) -> (Column -> Column) -> 207 | EditorState -> EditorState 208 | move f1 f2 st@(vs, fsl@(fs : _)) = (vs & pos .~ (newRow, newColumn), fsl) 209 | where newRow :: Row 210 | newRow | f1 (vs ^. row) < 0 = 0 211 | | f1 (vs ^. row) 212 | >= filelength fs = filelength fs - 1 213 | | otherwise = f1 $ vs ^. row 214 | newColumn | (f2 (vs ^. column) < 0) 215 | || (f2 (vs ^. column) 216 | >= length (currline st)) 217 | || (f1 (vs ^. row) < 0) 218 | || (f1 (vs ^. row) 219 | >= filelength fs) 220 | = vs ^. column 221 | | length ((fs ^. buff) !! f1 (vs ^. row)) 222 | < length (currline st) 223 | && length ((fs ^. buff) !! f1 (vs ^. row)) 224 | <= vs ^. column 225 | = length ((fs ^. buff) !! f1 (vs ^. row)) - 1 226 | | otherwise = f2 $ vs ^. column 227 | pos :: Lens VihsState VihsState (Int, Int) (Int, Int) 228 | pos = lens (\s -> (s ^. row, s ^. column)) (\s (r, c) -> s & row .~ r & column .~ c) 229 | 230 | vihsPrint :: Bool -> EditorState -> IO () 231 | vihsPrint isIns 232 | st@(vs, fsl@(fs : _)) = do print st 233 | (putStrLn . unlines) (( 234 | if vs ^. number 235 | then zipWith (++) 236 | (map ((++ "\t") . show) 237 | [1 ..]) 238 | else id) (fst ++ [putCursor isIns st] 239 | ++ tail snd)) 240 | where (fst, snd) = splitAt (vs ^. row) (fs ^. buff) 241 | 242 | putCursor :: Bool -> EditorState -> String 243 | putCursor isIns st@(vs, _) = fst ++ (if isIns 244 | then '|' 245 | else '[') 246 | : (if null snd 247 | then [']'] 248 | else head snd : (if isIns 249 | then [] 250 | else [']']) 251 | ++ tail snd) 252 | where (fst, snd) = splitAt (vs ^. column) (currline st) 253 | 254 | addLine :: Row -> Text -> Text 255 | addLine r buff = take (r + 1) buff ++ [""] ++ drop (r + 1) buff 256 | 257 | edit :: String -> EditorState -> EditorState 258 | edit str st@(vs, fsl@(fs : _)) = (vs & column .~ newColumn 259 | ,fs { _buff = fst ++ str : [] ++ tail snd 260 | , _saved = False } : fsl) 261 | where (fst, snd) = splitAt (vs ^. row) (fs ^. buff) 262 | newColumn :: Int 263 | newColumn | length str 264 | < length (currline st) 265 | && length str - 1 266 | < vs ^. column 267 | = length str - 1 268 | | length str 269 | < length (currline st) 270 | = vs ^. column 271 | | otherwise = vs ^. column 272 | + length str 273 | - length (currline st) 274 | 275 | delete :: Count -> EditorState -> EditorState 276 | delete c st@(vs, fsl@(fs : _)) = f (vs & yanked .~ take c snd, fsl) 277 | where (fst, snd) = splitAt (vs ^. column) (currline st) 278 | f :: (EditorState -> EditorState) 279 | f | (null . currline) st 280 | = id 281 | | otherwise = edit $ fst ++ drop c snd 282 | 283 | delLine :: Count -> EditorState -> EditorState 284 | delLine c (vs, fsl@(fs : _)) = newSt 285 | where (fst, snd) = splitAt (vs ^. row) (fs ^. buff) 286 | newSt :: EditorState 287 | newSt | length (fs ^. buff) <= 1 288 | = (vs, (fs & buff .~ [""]) : fsl) 289 | | length (fs ^. buff) - 1 < vs ^. row 290 | = (vs { _row = length (fs ^. buff) - 1 291 | , _yanked = unlines $ take c snd } 292 | ,(fs & buff .~ fst ++ drop c snd) : fsl) 293 | | otherwise = (vs { _row = vs ^. row 294 | , _yanked = unlines $ take c snd } 295 | ,(fs & buff .~ fst ++ drop c snd) : fsl) 296 | 297 | replace :: EditorState -> IO EditorState 298 | replace st@(vs, fsl@(fs : _)) = do str <- replace' (vs ^. column) (currline st) 299 | (vihsRun . edit str) (toMode NORMAL st) 300 | 301 | replace' :: Column -> String -> IO String 302 | replace' c buff = do putStr "REPLACE>> " 303 | ch <- getHiddenChar 304 | return $ fst ++ [ch] ++ tail snd 305 | where (fst, snd) = splitAt c buff 306 | 307 | insRun :: EditorState -> IO EditorState 308 | insRun st@(vs, fsl@(fs : _)) = do vihsPrint True st 309 | ch <- getHiddenChar 310 | putStrLn "" 311 | case ch of 312 | '\ESC' -> return esc 313 | ch | ch == '\DEL' 314 | , ch == '\b' 315 | -> do print ch 316 | insRun $ if null fst 317 | then st 318 | else edit (init fst ++ snd) 319 | ((vs & column .~ (vs ^. column - 1)), fsl) 320 | _ -> do print ch 321 | insRun $ edit (fst ++ [ch] ++ snd) st 322 | where (fst, snd) = splitAt (vs ^. column) (currline st) 323 | (fstb, sndb) = splitAt (vs ^. row) (fs ^. buff) 324 | esc :: EditorState 325 | esc = (vs { _row = (if last (currline st) 326 | == '\n' 327 | then id 328 | else subtract 329 | (if head (currline st) 330 | == '\n' 331 | then 2 332 | else 1)) 333 | (vs ^. row 334 | + length (lines $ currline st)) 335 | , _column = vs ^. column 336 | - (length 337 | . unlines 338 | . init 339 | . lines $ currline st) } 340 | ,(fs & buff .~ (fstb 341 | ++ (if last (currline st) 342 | == '\n' 343 | then (++ [""]) 344 | else (++ [])) 345 | (lines (currline st)) 346 | ++ tail sndb)) : fsl) 347 | 348 | insert :: Char -> EditorState -> IO EditorState 349 | insert ch st@(vs, fsl@(fs : _)) = do vihsPrint True st' 350 | st'' <- insRun st' 351 | return $ toMode NORMAL st'' 352 | where (fstb, sndb) = splitAt (vs ^. row) (fs ^. buff) 353 | st' :: EditorState 354 | st' = case ch of 355 | 'i' -> (vs, fsl) 356 | 'a' -> (vs & column .~ (vs ^. column + 1), fsl) 357 | 'I' -> (vs & column .~ 0, fsl) 358 | 'A' -> (vs & column .~ length (currline st), fsl) 359 | 'o' -> (vs { _row = vs ^. row 360 | , _column = length (currline st) + 1 } 361 | ,(fs & buff .~ (fstb 362 | ++ [currline st ++ "\n"] 363 | ++ tail sndb)) : fsl) 364 | 'O' -> (vs { _row = vs ^. row 365 | , _column = 0 } 366 | ,(fs & buff .~ (fstb 367 | ++ ["\n" ++ currline st] 368 | ++ tail sndb)) : fsl) 369 | 370 | insert' :: Column -> Line -> Line -> Line 371 | insert' c str line = splitAt c line ^. _1 ++ str ++ splitAt c line ^. _2 372 | 373 | quit :: EditorState -> EditorState 374 | quit (vs, fsl) = (vs & quited .~ True, fsl) 375 | 376 | write :: FilePath -> EditorState -> IO EditorState 377 | write path (vs, fsl@(fs : _)) = do writeFile path . unlines $ fs ^. buff 378 | return (vs, fs { _path = path 379 | , _saved = True } : fsl) 380 | 381 | toMode :: Mode -> EditorState -> EditorState 382 | toMode m (vs, fs) = (vs & mode .~ m, fs) 383 | 384 | setnum :: Bool -> EditorState -> EditorState 385 | setnum b (vs, fs) = (vs & number .~ b, fs) 386 | 387 | term :: EditorState -> IO () 388 | term _ = system "$SHELL" >>= print 389 | 390 | git :: Option -> EditorState -> IO () 391 | git opt _ = system ("git " ++ opt) >>= print 392 | 393 | stack :: Option -> EditorState -> IO () 394 | stack opt _ = system ("stack " ++ opt) >>= print 395 | 396 | nocmd :: String -> EditorState -> IO () 397 | nocmd str _ = putStrLn $ "No such command: \'" 398 | ++ str ++ "\'" 399 | -------------------------------------------------------------------------------- /src/test.txt: -------------------------------------------------------------------------------- 1 | 1 2 | 2 3 | 3 4 | 4 5 | 5 6 | 6 7 | 7 8 | 8 9 | 9 10 | 10 11 | 11 12 | 12 13 | 13 14 | 14 15 | 15 16 | 16 17 | 17 18 | 18 19 | 19 20 | 20 21 | 21 22 | 22 23 | 23 24 | 24 25 | 25 26 | 26 27 | 27 28 | 28 29 | 29 30 | 30 31 | 31 32 | 32 33 | 33 34 | 34 35 | 35 36 | 36 37 | 37 38 | 38 39 | 39 40 | 40 41 | 41 42 | 42 43 | 43 44 | 44 45 | 45 46 | 46 47 | 47 48 | 48 49 | 49 50 | 50 51 | 51 52 | 52 53 | 53 54 | 54 55 | 55 56 | 56 57 | 57 58 | 58 59 | 59 60 | 60 61 | -------------------------------------------------------------------------------- /src/test1.txt: -------------------------------------------------------------------------------- 1 | hello world 2 | -------------------------------------------------------------------------------- /src/test2.txt: -------------------------------------------------------------------------------- 1 | 1 2 | 4 3 | 5 4 | 6 5 | 7 6 | 8 7 | 9 8 | 10 9 | 11 10 | 12 11 | 13 12 | 14 13 | 15 14 | 16 15 | 17 16 | 18 17 | 19 18 | 20 19 | 21 20 | 22 21 | 23 22 | 24 23 | 25 24 | 26 25 | 27 26 | 28 27 | 29 28 | 30 29 | 31 30 | 32 31 | 33 32 | 34 33 | 35 34 | 36 35 | 37 36 | 38 37 | 39 38 | 40 39 | 41 40 | 42 41 | 43 42 | 44 43 | 45 44 | 46 45 | 47 46 | 48 47 | 49 48 | 50 49 | 51 50 | 52 51 | 53 52 | 54 53 | 55 54 | 56 55 | 57 56 | 58 57 | 59 58 | 60 59 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' # 2 | # Some commonly used options have been documented as comments in this file. 3 | # For advanced use and comprehensive documentation of the format, please see: 4 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 5 | 6 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 7 | # A snapshot resolver dictates the compiler version and the set of packages 8 | # to be used for project dependencies. For example: 9 | # 10 | # resolver: lts-3.5 11 | # resolver: nightly-2015-09-21 12 | # resolver: ghc-7.10.2 13 | # resolver: ghcjs-0.1.0_ghc-7.10.2 14 | # resolver: 15 | # name: custom-snapshot 16 | # location: "./custom-snapshot.yaml" 17 | resolver: lts-9.0 18 | resolver: nightly-2017-07-31 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - '.' 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: 43 | - brick-0.20.1 44 | - data-clist-0.1.2.0 45 | - text-zipper-0.10 46 | - word-wrap-0.1 47 | 48 | 49 | # Override default flag values for local packages and extra-deps 50 | flags: {} 51 | 52 | # Extra package databases containing global packages 53 | extra-package-dbs: [] 54 | 55 | # Control whether we use the GHC we find on the path 56 | # system-ghc: true 57 | # 58 | # Require a specific version of stack, using version ranges 59 | # require-stack-version: -any # Default 60 | # require-stack-version: ">=1.4" 61 | # 62 | # Override the architecture used by stack, especially useful on Windows 63 | # arch: i386 64 | # arch: x86_64 65 | # 66 | # Extra directories used by stack for building 67 | # extra-include-dirs: [/path/to/dir] 68 | # extra-lib-dirs: [/path/to/dir] 69 | # 70 | # Allow a newer minor version of GHC than the snapshot specifies 71 | # compiler-check: newer-minor 72 | #compiler: ghc-8.2.1 73 | compiler-check: match-exact 74 | 75 | allow-newer: true 76 | -------------------------------------------------------------------------------- /test.txt: -------------------------------------------------------------------------------- 1 | Hello Vihs! 2 | I'm 3rd line 3 | -------------------------------------------------------------------------------- /test/InsertSpec.hs: -------------------------------------------------------------------------------- 1 | module InsertSpec (spec) where 2 | 3 | import Insert 4 | import Test.Hspec 5 | 6 | spec :: Spec 7 | spec = 8 | describe "insert" $ do 9 | it "standard" $ 10 | insert "aaa" "b" 2 `shouldBe` "aaba" 11 | it "standard" $ 12 | insertBuff ["AAA", "BBB", "CCC"] "b" 1 2 `shouldBe` ["AAA", "BBB", "CbCC"] 13 | -------------------------------------------------------------------------------- /test/ParseCmdSpec.hs: -------------------------------------------------------------------------------- 1 | module ParseCmdSpec (spec) where 2 | 3 | import ParseCmd 4 | import Test.Hspec 5 | 6 | spec :: Spec 7 | spec = 8 | describe "setCmd" $ do 9 | it "standard" $ 10 | setCmd "w test.txt" `shouldBe` Command {addr = Nothing, cmdName = 'w', param = Just "test.txt"} 11 | it "standard" $ 12 | setCmd "1,2a" `shouldBe` Command {addr = Just (AddrPair (AddrLine 1) (AddrLine 2)), cmdName = 'a', param = Nothing} 13 | it "standard" $ 14 | setCmd ",d" `shouldBe` Command {addr = Just (AddrPair (AddrLine 1) AddrEOF), cmdName = 'd', param = Nothing} 15 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | --------------------------------------------------------------------------------