, Options.Primer
        , Options.Parsers

{-# LANGUAGE TypeApplications #-}

import           Data.Attoparsec.Text (anyChar, endOfInput, parseOnly)
import qualified Data.Attoparsec.Text as Atto
import           Data.Bifunctor       (bimap, first)
import           Data.Either.Extra
import qualified Data.Text            as Text

import           Options.Primer      (PrimerCommand)
import qualified Options.Primer      as PrimerOptions

import           Control.Monad
import           Text.Read            (readEither)
import           AlBhed               (Primer, Volume)
import qualified AlBhed
import           Location             (Location)
import qualified Location
import           Data.PrintableText   (PrintableText)
import qualified Data.PrintableText   as PrintableText

data PrimerCommand =
    Add Volume Location
    | New Volume Char Char Location
    | List
    deriving (Show)

    ( command "primer" (info (Primer <$> commandPrimer) (progDesc "Work with AlBhed Primers")))

    ( command "primer" (info (Primer <$> PrimerOptions.commands) (progDesc "Work with AlBhed Primers")))

commandPrimer :: Parser PrimerCommand
commandPrimer = hsubparser
    ( command "add" (info parsePrimerAdd (progDesc "Add a primer location to the index"))
    <> command "new" (info parsePrimerNew (progDesc "Add a new AlBhed Primer to the index"))
    <> command "ls" (info (pure List) (progDesc "List all AlBhed Primers in the index"))
    )
parsePrimerNew :: Parser PrimerCommand
parsePrimerNew = New <$> volume <*> char "FROM" <*> char "TO" <*> location
    where
        char = argument singleChar . metavar
singleChar :: ReadM Char
singleChar = eitherReader $
    first parseError . (parseOnly oneChar . Text.pack)
    where
        parseError = const "Expecting a single character"
        oneChar = anyChar <* endOfInput
parsePrimerAdd :: Parser PrimerCommand
parsePrimerAdd = Add <$> volume <*> location
volume :: Parser Volume
volume = argument parseVolume (metavar "VOLUME")
location :: Parser Location
location = Location.Location
    <$> argument parsePrintableText (metavar "AREA")
    <*> optional (argument parsePrintableText (metavar "SECTION"))
parseVolume :: ReadM Volume
parseVolume = eitherReader $
    (first parseError . input) >=> volume
    where
        parseError = const "Failed to parse volume number"
        input = readEither @Int
        volume = maybeToEither "Volume must be 1 to 26" . AlBhed.toVolume
parsePrintableText :: ReadM PrintableText
parsePrintableText = eitherReader $
    input >=> location
    where
        input = Right
        location = maybeToEither "Location can't contain only whitespace" . PrintableText.fromText . Text.pack

{-# LANGUAGE TypeApplications #-}
module Options.Primer
    ( PrimerCommand (..)
    , commands
    ) where
import           Options.Applicative
import qualified Options.Parsers     as Parser
import           Data.Bifunctor      (bimap, first)
import           Data.Either.Extra   (maybeToEither)
import           Control.Monad
import           Text.Read           (readEither)
import           AlBhed              (Primer, Volume)
import qualified AlBhed
import           Location            (Location)
import qualified Location
data PrimerCommand =
    Add Volume Location
    | New Volume Char Char Location
    | List
    deriving (Show)
commands :: Parser PrimerCommand
commands = hsubparser
    ( command "add" (info addCommand (progDesc "Add a primer location to the index"))
    <> command "new" (info newCommand (progDesc "Add a new AlBhed Primer to the index"))
    <> command "ls" (info (pure List) (progDesc "List all AlBhed Primers in the index"))
    )
newCommand :: Parser PrimerCommand
newCommand = New <$> volume <*> char "FROM" <*> char "TO" <*> location
    where
        char = argument Parser.singleChar . metavar
addCommand :: Parser PrimerCommand
addCommand = Add <$> volume <*> location
volume :: Parser Volume
volume = argument parseVolume (metavar "VOLUME")
location :: Parser Location
location = Location.Location
    <$> argument Parser.printableText (metavar "AREA")
    <*> optional (argument Parser.printableText (metavar "SECTION"))
parseVolume :: ReadM Volume
parseVolume = eitherReader $
    (first parseError . input) >=> volume
    where
        parseError = const "Failed to parse volume number"
        input = readEither @Int
        volume = maybeToEither "Volume must be 1 to 26" . AlBhed.toVolume

module Options.Parsers
    ( printableText
    , singleChar
    ) where
import           Options.Applicative
import           Data.Attoparsec.Text (anyChar, endOfInput, parseOnly)
import qualified Data.Attoparsec.Text as Atto
import           Data.Bifunctor       (bimap, first)
import           Data.Either.Extra    (maybeToEither)
import qualified Data.Text            as Text
import           Control.Monad
import           Data.PrintableText   (PrintableText)
import qualified Data.PrintableText   as PrintableText
singleChar :: ReadM Char
singleChar = eitherReader $
    first parseError . (parseOnly oneChar . Text.pack)
    where
        parseError = const "Expecting a single character"
        oneChar = anyChar <* endOfInput
printableText :: ReadM PrintableText
printableText = eitherReader $
    input >=> location
    where
        input = Right
        location = maybeToEither "Location can't contain only whitespace" . PrintableText.fromText . Text.pack