Move code to Internal module and add tests

This commit is contained in:
Alexander Kobjolke 2023-08-15 19:47:37 +02:00
parent 2ac76cb650
commit ace38dcebc
6 changed files with 89 additions and 15 deletions

View file

@ -6,7 +6,7 @@ cabal-version: 1.12
name: hcat name: hcat
version: 0.0.1.0 version: 0.0.1.0
description: Hcat example from the book 'Effective Haskell' description: HCat example from the book 'Effective Haskell'
author: Alexander Kobjolke author: Alexander Kobjolke
maintainer: alex@jakalx.net maintainer: alex@jakalx.net
copyright: Alexander Kobjolke 2023 copyright: Alexander Kobjolke 2023
@ -18,11 +18,16 @@ extra-source-files:
library library
exposed-modules: exposed-modules:
HCat HCat
HCat.Internal
other-modules: other-modules:
Paths_hcat Paths_hcat
hs-source-dirs: hs-source-dirs:
src src
ghc-options: -Wall -Wunused-packages default-extensions:
GHC2021
BlockArguments
OverloadedStrings
ghc-options: -Wall -Wunused-packages -fdefer-typed-holes
build-depends: build-depends:
base >=4.13 && <5 base >=4.13 && <5
, text , text
@ -34,9 +39,39 @@ executable hcat
Paths_hcat Paths_hcat
hs-source-dirs: hs-source-dirs:
app app
ghc-options: -Wall -Wunused-packages default-extensions:
GHC2021
BlockArguments
OverloadedStrings
ghc-options: -Wall -Wunused-packages -fdefer-typed-holes
build-depends: build-depends:
base >=4.13 && <5 base >=4.13 && <5
, hcat , hcat
, text , text
default-language: GHC2021 default-language: GHC2021
test-suite spec
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
HCatSpec
Paths_hcat
hs-source-dirs:
test
default-extensions:
GHC2021
BlockArguments
OverloadedStrings
ghc-options: -Wall -Wunused-packages -fdefer-typed-holes
cpp-options: -DTEST
build-tool-depends:
hspec-discover:hspec-discover
build-depends:
QuickCheck
, base >=4.13 && <5
, hcat
, hspec
, quickcheck-instances
, quickcheck-text
, text
default-language: Haskell2010

View file

@ -4,7 +4,7 @@ license: MIT
author: "Alexander Kobjolke" author: "Alexander Kobjolke"
maintainer: "alex@jakalx.net" maintainer: "alex@jakalx.net"
copyright: "Alexander Kobjolke 2023" copyright: "Alexander Kobjolke 2023"
description: "Hcat example from the book 'Effective Haskell'" description: "HCat example from the book 'Effective Haskell'"
extra-source-files: extra-source-files:
- README.org - README.org
@ -20,6 +20,12 @@ dependencies:
ghc-options: ghc-options:
- -Wall - -Wall
- -Wunused-packages - -Wunused-packages
- -fdefer-typed-holes
default-extensions:
- GHC2021
- BlockArguments
- OverloadedStrings
library: library:
source-dirs: src source-dirs: src
@ -34,3 +40,17 @@ executables:
- hcat - hcat
verbatim: verbatim:
default-language: GHC2021 default-language: GHC2021
tests:
spec:
cpp-options: -DTEST
main: Spec.hs
source-dirs:
- test
dependencies:
- hcat
- hspec
- QuickCheck
- quickcheck-instances
- quickcheck-text
build-tools: hspec-discover

View file

@ -9,27 +9,22 @@ import System.IO (hPutStrLn, stderr)
import Control.Exception qualified as Exception import Control.Exception qualified as Exception
import System.IO.Error qualified as IOError import System.IO.Error qualified as IOError
import Data.Text qualified as Text
import Data.Text.IO qualified as TextIO import Data.Text.IO qualified as TextIO
parseArgs :: [String] -> Either String FilePath import HCat.Internal (parseArgs)
parseArgs args = case args of
[] -> Left "No filename given!"
[arg] -> Right arg
_ -> Left "Only a single file is supported"
runHCat :: IO () runHCat :: IO ()
runHCat = do runHCat = do
fileNameOrError <- parseArgs <$> Env.getArgs fileNameOrError <- parseArgs <$> Env.getArgs
fileName <- eitherToError fileNameOrError fileName <- eitherToError fileNameOrError
TextIO.readFile fileName >>= TextIO.putStr TextIO.readFile fileName >>= TextIO.putStr
eitherToError :: Show a => Either a b -> IO b eitherToError :: Show a => Either a b -> IO b
eitherToError = either (Exception.throwIO . IOError.userError . show) return eitherToError = either (Exception.throwIO . IOError.userError . show) return
handleError :: IOError -> IO () handleError :: IOError -> IO ()
handleError e = do handleError e = do
hPutStrLn stderr $ "I ran into an issue: " <> show e hPutStrLn stderr $ "I ran into an issue: " <> show e
defaultMain :: IO () defaultMain :: IO ()
defaultMain = Exception.catch runHCat handleError defaultMain = Exception.catch runHCat handleError

8
src/HCat/Internal.hs Normal file
View file

@ -0,0 +1,8 @@
-- | Internal module in order to facilitate testability.
module HCat.Internal where
parseArgs :: [String] -> Either String FilePath
parseArgs args = case args of
[] -> Left "No filename given!"
[arg] -> Right arg
_ -> Left "Only a single file is supported"

15
test/HCatSpec.hs Normal file
View file

@ -0,0 +1,15 @@
{-# LANGUAGE GHC2021 #-}
module HCatSpec (spec) where
import HCat.Internal (parseArgs)
import Test.Hspec
spec :: Spec
spec = do
describe "parseArgs" do
it "returns the filename if given a single argument" do
parseArgs ["foo"] `shouldBe` Right "foo"
parseArgs [] `shouldBe` Left "No filename given!"
parseArgs ["foo", "bar"] `shouldBe` Left "Only a single file is supported"

1
test/Spec.hs Normal file
View file

@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}