~yoctocell/flaskell

630eafd96d721e1fd7627b749ae53ee9f4fa0d91 — yoctocell 1 year, 9 months ago f921198
Use Parsec instead of regex
4 files changed, 86 insertions(+), 69 deletions(-)

M flaskell.cabal
M src/Flaskell/Cli.hs
M src/Flaskell/Parser.hs
M src/Flaskell/Ui.hs
M flaskell.cabal => flaskell.cabal +4 -4
@@ 22,11 22,11 @@ library
                   , Flaskell.Ui
  other-modules:   Paths_flaskell
  hs-source-dirs:  src
  build-depends:   base >=4.7 && <5
  build-depends:   base >= 4.7 && <5
                 -- , bytestring >= 0.10.10.0
                 , optparse-applicative >= 0.15.0.0
                 , regex >=1.1.0.0
                 , bytestring >=0.10.10.0
                 -- , ansi-terminal >=0.11
                 , parsec >= 3.1.13.0
                 -- , text >= 1.2.4.0
  default-language: Haskell2010

executable flaskell

M src/Flaskell/Cli.hs => src/Flaskell/Cli.hs +28 -27
@@ 1,6 1,6 @@
module Flaskell.Cli
  -- ( getContent
  ( cli
  -- ( getContent
  )
where



@@ 8,9 8,16 @@ import           Flaskell.Parser
import           Flaskell.Ui

import           Options.Applicative
import           System.Environment  (getArgs, getProgName)
-- import qualified Data.ByteString               as B
-- import qualified Data.Text                     as T
-- import           Data.Text.IO                   ( readFile )
import           System.Environment             ( getArgs
                                                , getProgName
                                                )
import           System.Exit
import           System.IO           (getContents, getLine)
import           System.IO                      ( getContents
                                                , getLine
                                                )

-- | Type of input
data Input = FileInput FilePath | StdInput


@@ 25,32 32,25 @@ versionNumber = "0.1.0.0"

fileInput :: Parser Input
fileInput = FileInput <$> strOption
  (  long "file"
  <> short 'f'
  <> metavar "FILE"
  <> help "Input file" )
  (long "file" <> short 'f' <> metavar "FILE" <> help "Input file")

stdInput :: Parser Input
stdInput = flag' StdInput
  (  long "stdin"
  <> short 'i'
  <> help "Read from stdin" )
stdInput = flag' StdInput (long "stdin" <> short 'i' <> help "Read from stdin")

cliArgs :: Parser Options
cliArgs = Options
          <$> switch
          (long "version"
          <> short 'v'
          <> help "Print the version number")
          <*> fileInput
cliArgs =
  Options
    <$> switch (long "version" <> short 'v' <> help "Print the version number")
    <*> fileInput
          -- <*> (fileInput <|> stdInput)

-- | Parse CLI arguments
parseCliArgs :: Options -> IO ()
parseCliArgs options = case options of
  (Options True _) -> putStrLn versionNumber
  (Options True  _               ) -> putStrLn versionNumber
  (Options False (FileInput file)) -> do
    contents <- readFile file
    -- print $ getCards contents
    feedCards . getCards $ contents
    -- FIXME hGetLine closed handle error
  (Options False (StdInput)) -> do


@@ 63,16 63,17 @@ parseCliArgs options = case options of
-- | Take contents of a file and return a list of Flashcard
getCards :: String -> [Flashcard]
getCards contents =
  let hints = getHint <$> (lines contents)
      answers = getAnswer <$> (lines contents)
  in
    zip hints answers
  let result = parseFlashcard contents
  in  case result of
        Left  _   -> []
        Right res -> res

cli :: IO ()
cli = do
  parseCliArgs =<< execParser args
  where
    args = info (cliArgs <**> helper)
      ( fullDesc
        <> progDesc "Generate flashcards from FILE"
        <> header "Flaskell - CLI flashcard program" )
 where
  args = info
    (cliArgs <**> helper)
    (fullDesc <> progDesc "Generate flashcards from FILE" <> header
      "Flaskell - CLI flashcard program"
    )

M src/Flaskell/Parser.hs => src/Flaskell/Parser.hs +47 -12
@@ 1,17 1,52 @@
{-# LANGUAGE QuasiQuotes #-}

module Flaskell.Parser where

import           Text.RE.Replace
import           Text.RE.TDFA.String

-- Capture hints and answers
-- - Hint a - Answer a
getHint :: String -> String
getHint h = captureText [cp|1|] $ h ?=~ [re|s*- $(.*) -.*|]
import           Text.Parsec.Char               ( noneOf
                                                , oneOf
                                                , endOfLine
                                                )
import           Text.Parsec                    ( sepBy
                                                , many
                                                , endBy
                                                , ParseError
                                                , parse
                                                , string
                                                , char
                                                )
import           Text.Parsec.String             ( Parser )
import           Control.Monad

getAnswer :: String -> String
getAnswer a = captureText [cp|1|] $ a ?=~ [re|s*-.*- $(.*).*|]
type Hint = String
type Answer = String
type Guess = String
type Flashcard = (Hint, Answer)

-- swap :: Hint -> Answer -> Answer -> Hint
swap h a = a h
-- swap h a = a h

-- Helper functions
-- Yanked from https://jakewheat.github.io/intro_to_parsing/#_whitespace
whitespace :: Parser ()
whitespace = void $ many $ oneOf " \n\t"

lexeme :: Parser a -> Parser a
lexeme p = do
  x <- p
  whitespace
  return x

-- | Return a tuple of hint and answer
flashcard :: Parser Flashcard
flashcard = do
  lexeme $ char '-'
  -- FIXME trailing whitespace "hint 1 "
  h <- many $ noneOf "-"
  lexeme $ char '-'
  a <- many $ noneOf "\n"
  return (h, a)

-- | Separate each line
flashcardFile :: Parser [Flashcard]
flashcardFile = endBy flashcard endOfLine

parseFlashcard :: String -> Either ParseError [Flashcard]
parseFlashcard = parse flashcardFile ""

M src/Flaskell/Ui.hs => src/Flaskell/Ui.hs +7 -26
@@ 2,34 2,15 @@ module Flaskell.Ui where

import           Flaskell.Parser

-- import           System.Console.ANSI (clearScreen)

-- Types
type Hint = String
type Answer = String
type Guess = String

type Flashcard = (Hint, Answer)


-- Feed the cards until they get fat
-- | Feed the cards to @display@
feedCards :: [Flashcard] -> IO ()
feedCards [] = return ()
feedCards ((h, a):cs) =
  display h a >>
  feedCards cs

feedCards []            = return ()
feedCards ((h, a) : cs) = display h a >> feedCards cs

-- Display hint
-- | Display hint
display :: Hint -> Answer -> IO ()
display h a =
  putStrLn h >>
  getLine >>= checkAns h a
  -- TODO Add option to clearScreen

display h a = putStrLn h >> getLine >>= checkAns h a

-- Check if guess is correct
-- | Check if guess is correct
checkAns :: Hint -> Answer -> Guess -> IO ()
checkAns h a guess = if guess == a
                        then return ()
                        else display h a
checkAns h a guess = if guess == a then return () else display h a