Compare commits
2 commits
a761e242a4
...
3cd99e3f0b
| Author | SHA1 | Date | |
|---|---|---|---|
| 3cd99e3f0b | |||
| 8b1755425c |
4 changed files with 57 additions and 7 deletions
|
|
@ -70,12 +70,12 @@
|
||||||
haskellPackages.haskell-language-server
|
haskellPackages.haskell-language-server
|
||||||
haskellPackages.fourmolu
|
haskellPackages.fourmolu
|
||||||
haskellPackages.hspec-discover
|
haskellPackages.hspec-discover
|
||||||
|
haskellPackages.doctest
|
||||||
cabal-install
|
cabal-install
|
||||||
ghcid
|
ghcid
|
||||||
nixfmt
|
nixfmt
|
||||||
hpack
|
hpack
|
||||||
hlint
|
hlint
|
||||||
haskellPackages.doctest
|
|
||||||
];
|
];
|
||||||
};
|
};
|
||||||
});
|
});
|
||||||
|
|
|
||||||
19
hcat.cabal
19
hcat.cabal
|
|
@ -50,6 +50,25 @@ executable hcat
|
||||||
, hcat
|
, hcat
|
||||||
default-language: GHC2021
|
default-language: GHC2021
|
||||||
|
|
||||||
|
test-suite doctest
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Doctest.hs
|
||||||
|
other-modules:
|
||||||
|
Paths_hcat
|
||||||
|
hs-source-dirs:
|
||||||
|
test/doctest
|
||||||
|
default-extensions:
|
||||||
|
BlockArguments
|
||||||
|
OverloadedStrings
|
||||||
|
ImportQualifiedPost
|
||||||
|
ghc-options: -Wall -fdefer-typed-holes
|
||||||
|
build-tool-depends:
|
||||||
|
doctest:doctest
|
||||||
|
build-depends:
|
||||||
|
base >=4.13 && <5
|
||||||
|
, process
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite spec
|
test-suite spec
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Spec.hs
|
main-is: Spec.hs
|
||||||
|
|
|
||||||
13
package.yaml
13
package.yaml
|
|
@ -56,9 +56,10 @@ tests:
|
||||||
build-tools: hspec-discover
|
build-tools: hspec-discover
|
||||||
verbatim:
|
verbatim:
|
||||||
default-language: GHC2021
|
default-language: GHC2021
|
||||||
# doctest:
|
doctest:
|
||||||
# main: Doctest.hs
|
main: Doctest.hs
|
||||||
# source-dirs:
|
source-dirs:
|
||||||
# - test/doctest
|
- test/doctest
|
||||||
# dependencies:
|
dependencies:
|
||||||
# - process
|
- process
|
||||||
|
build-tools: doctest
|
||||||
|
|
|
||||||
|
|
@ -4,6 +4,10 @@ module HCat.Internal where
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
|
|
||||||
|
import System.IO
|
||||||
|
import System.Info qualified as SysInfo
|
||||||
|
import System.Process qualified as P
|
||||||
|
|
||||||
-- | @parseArgs@ takes a list of strings and returns a single FilePath if there was exactly one element.
|
-- | @parseArgs@ takes a list of strings and returns a single FilePath if there was exactly one element.
|
||||||
--
|
--
|
||||||
-- >>> parseArgs ["foo"]
|
-- >>> parseArgs ["foo"]
|
||||||
|
|
@ -67,3 +71,29 @@ paginate (ScreenDimensions rows cols) =
|
||||||
|
|
||||||
type Pages = [Page]
|
type Pages = [Page]
|
||||||
type Page = Text
|
type Page = Text
|
||||||
|
|
||||||
|
getTerminalSize :: IO ScreenDimensions
|
||||||
|
getTerminalSize = case SysInfo.os of
|
||||||
|
"linux" -> tputScreenDimensions
|
||||||
|
"darwin" -> tputScreenDimensions
|
||||||
|
_ -> pure $ defaultScreenDimensions{screenRows = 25, screenColumns = 80}
|
||||||
|
|
||||||
|
defaultScreenDimensions :: ScreenDimensions
|
||||||
|
defaultScreenDimensions = ScreenDimensions{screenRows = 25, screenColumns = 80}
|
||||||
|
|
||||||
|
tputScreenDimensions :: IO ScreenDimensions
|
||||||
|
tputScreenDimensions = ScreenDimensions <$> tput "lines" <*> tput "cols"
|
||||||
|
where
|
||||||
|
tput cmd = read <$> P.readProcess "tput" [cmd] ""
|
||||||
|
|
||||||
|
data UserCommand = NextPage | Quit deriving (Show)
|
||||||
|
|
||||||
|
getUserCommand :: IO UserCommand
|
||||||
|
getUserCommand = do
|
||||||
|
hSetBuffering stdin NoBuffering
|
||||||
|
hSetEcho stdin False
|
||||||
|
input <- getChar
|
||||||
|
case input of
|
||||||
|
' ' -> pure NextPage
|
||||||
|
'q' -> pure Quit
|
||||||
|
_ -> getUserCommand
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue