turtle-options (empty) → 0.1.0.0

raw patch · 10 files changed

+415/−0 lines, 10 filesdep +basedep +optional-argsdep +parsecsetup-changed

Dependencies added: base, optional-args, parsec, text, turtle, turtle-options

Files

LICENSE +30/−0
Setup.hs +2/−0
app/Main.hs +23/−0
src/Turtle/Options/Parsers.hs +45/−0
src/Turtle/Options/Percentage.hs +29/−0
src/Turtle/Options/Quality.hs +50/−0
src/Turtle/Options/Scale.hs +63/−0
src/Turtle/Options/Timecode.hs +121/−0
test/Spec.hs +2/−0
turtle-options.cabal +50/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Turtle+import Turtle.Options.Scale (Scale, optScale, defScaleHelp)+import Turtle.Options.Percentage (optPercentage, defPercentageHelp)+import Turtle.Options.Quality (optQuality, defQualityHelp)+import Turtle.Options.Timecode (Timecode, optTimecode, defTimecodeHelp)++parser :: Parser (Scale, Float, Float, Timecode)+parser = (,,,) <$> optScale "scale" 's' defScaleHelp+            <*> optPercentage "percentage" 'p' defPercentageHelp+            <*> optQuality "quality" 'q' defQualityHelp+            <*> optTimecode "timecode" 't' defTimecodeHelp ++main :: IO ()+main = do+  (scale, percent, quality, timecode) <- options "Turtle options example" parser+  putStrLn $ "Scale " ++ (show scale)+  putStrLn $ "Percent " ++ (show percent)+  putStrLn $ "Quality " ++ (show quality)+  putStrLn $ "Timecode " ++ (show timecode)

+ src/Turtle/Options/Parsers.hs view

@@ -0,0 +1,45 @@+module Turtle.Options.Parsers+( number+, plus+, minus+, float+, percent+, Parser+, (<:>)+) where++import Control.Applicative ((<$>), (<*>), (<*), (*>))++import Text.Parsec (Parsec, many1, digit, char, option, oneOf, (<|>))++type Parser a = Parsec String () a++infixr 5 <++>+(<++>) :: Applicative f => f [a] -> f [a] -> f [a]+a <++> b = (++) <$> a <*> b++infixr 5 <:>+(<:>) :: Applicative f => f a -> f [a] -> f [a]+a <:>  b = (:) <$> a <*> b++number :: Parser String+number = many1 digit++plus :: Parser String+plus = char '+' *> number++minus :: Parser String+minus = char '-' <:> number++integer :: Parser String+integer = plus <|> minus <|> number++-- | Shamelessly taken from http://stackoverflow.com/a/31358854/2287402+float :: Parser Float+float = fmap rd $ integer <++> decimal <++> exponent+    where rd       = read :: String -> Float+          decimal  = option "" $ char '.' <:> number+          exponent = option "" $ oneOf "eE" <:> integer++percent :: Parser Float+percent = float <* char '%'

+ src/Turtle/Options/Percentage.hs view

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module Turtle.Options.Percentage+( optPercentage+, defPercentageHelp+) where++import Turtle (ArgName, ShortName, HelpMessage, opt)+import Data.Optional (Optional)+import qualified Turtle+import qualified Data.Text as Text++import Text.Parsec++import Turtle.Options.Parsers (Parser, percent, float)++defPercentageHelp :: Optional HelpMessage+defPercentageHelp = "Percentage: can be a positive or negative percentage (-43%), represented with a float." ++percentage :: Parser Float+percentage = try ((/100) <$> percent)++readPercentage :: String -> Maybe Float+readPercentage str = case (parse percentage "Percentage (Float)" str) of+  Left err -> error $ "Error parsing percentage: " ++ (show err)+  Right s -> Just s++optPercentage :: ArgName -> ShortName -> Optional HelpMessage -> Turtle.Parser Float+optPercentage = opt (readPercentage . Text.unpack)

+ src/Turtle/Options/Quality.hs view

@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++module Turtle.Options.Quality+( optQuality+, defQualityHelp+) where++import Turtle (ArgName, ShortName, HelpMessage, opt)+import Data.Optional (Optional)+import qualified Turtle+import qualified Data.Text as Text++import Text.Parsec+import Text.ParserCombinators.Parsec.Error (Message(..), newErrorMessage)+import Text.Parsec.Pos (initialPos)++import Turtle.Options.Parsers (Parser, percent, float)++defQualityHelp :: Optional HelpMessage+defQualityHelp = "Quality option. QUALITY can be a percentage (20%) or a keyword: verylow / low / mediumlow / medium / mediumhigh / high / best."++qualitySettings = +  [ ("verylow", 0.1)+  , ("low", 0.2)+  , ("mediumlow", 0.35)+  , ("medium", 0.5)+  , ("mediumhigh", 0.65)+  , ("high", 0.8)+  , ("veryhigh", 0.9)+  , ("best", 1)+  ]++keyword :: Parser Float+keyword = do+  key <- many1 lower+  let q = lookup key qualitySettings+  case q of+    Nothing -> error ("The keyword '" ++ key ++ "' is not a valid quality setting")+    Just v -> return v++quality :: Parser Float+quality = try keyword <|> percent++readQuality :: String -> Maybe Float+readQuality str = case (parse quality "Quality" str) of+  Left err -> error $ "Error parsing quality: " ++ (show err)+  Right s -> Just s++optQuality :: ArgName -> ShortName -> Optional HelpMessage -> Turtle.Parser Float+optQuality = opt (readQuality . Text.unpack)

+ src/Turtle/Options/Scale.hs view

@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}++module Turtle.Options.Scale+( Scale+, optScale+, defScaleHelp+) where++import Turtle (ArgName, ShortName, HelpMessage, opt)+import Data.Optional (Optional)+import qualified Turtle+import qualified Data.Text as Text++import Text.Parsec++import Turtle.Options.Parsers (Parser, percent, float)++data Scale =+  Percentage Float+  | Size (Int, Int)+  | Width Int+  | Height Int+  deriving (Eq, Show)++defScaleHelp :: Optional HelpMessage+defScaleHelp = "Scale option. SCALE can be a percentage (20%), a size (480x320), a width (480x) or a height (x320)"++width :: Parser Scale+width = Width . read <$> try (many1 digit <* char 'x')++height :: Parser Scale+height = Height . read <$> try (char 'x' *> many1 digit)++size :: Parser Scale+size = Size <$> try (do+  w <- read <$> many1 digit <* char 'x'+  h <- read <$> many1 digit+  return (w, h))++percentage :: Parser Scale+percentage = choice [try p, f]+  where +    f = do+      v <- float +      case v < 0 of+        True -> error "Error parsing scale: can't have a negative scale"+        False -> return $ Percentage v+    p = do+      v <- percent+      case v < 0 of+        True -> error "Error parsing scale percentage: can't have a negative value"+        False -> return $ Percentage (v / 100)++scale :: Parser Scale+scale = choice [size, percentage, width, height]++readScale :: String -> Maybe Scale+readScale str = case (parse scale "Scale" str) of+  Left err -> error $ "Error parsing scale: " ++ (show err)+  Right s -> Just s++optScale :: ArgName -> ShortName -> Optional HelpMessage -> Turtle.Parser Scale+optScale = opt (readScale . Text.unpack)

+ src/Turtle/Options/Timecode.hs view

@@ -0,0 +1,121 @@+{-# LANGUAGE OverloadedStrings #-}++module Turtle.Options.Timecode+( Timecode(..)+, RelTimecode(..)+, optTimecode+, defTimecodeHelp+, msToTimecode+, sToTimecode+, mToTimecode+, hToTimecode+, (<+>)+) where++import Turtle (ArgName, ShortName, HelpMessage, opt)+import Data.Optional (Optional)+import qualified Turtle+import qualified Data.Text as Text++--import Data.Monoid (Sum, (<>))+import Data.Monoid (Monoid, mappend)++import Text.Parsec+import Text.ParserCombinators.Parsec.Error (Message(..), newErrorMessage)+import Text.Parsec.Pos (initialPos)++import Turtle.Options.Parsers (Parser, percent, float, number, plus, minus)++import Debug.Trace (traceShow)++defTimecodeHelp :: Optional HelpMessage+defTimecodeHelp = "Timecode option. TIMECODE can be in the following formats: "++type Hour = Int+type Minute = Int+type Second = Int+type Millisecond = Int++data Timecode = Timecode Hour Minute Second Millisecond deriving (Eq)++data RelTimecode = +  PosTimecode Timecode+  | NegTimecode Timecode+  deriving (Eq)++instance Show Timecode where+  show (Timecode h m s ms) = (show h) ++ ":" ++ (show m) ++ ":" ++ (show s) ++ "." ++ (show ms)++instance Show NegativeTimecode where+  show (PosTimecode t) = show t+  show (NegTimecode t) = "-" ++ (show t)++instance Monoid Timecode where+  mappend (Timecode ha ma sa msa) (Timecode hb mb sb msb) = normalizeTimecode (Timecode (ha + hb) (ma + mb) (sa + sb) (msa + msb))+  mempty = Timecode 0 0 0 0++infixr 5 <+>+(<+>) :: Timecode -> Timecode -> Timecode+a <+> b = mappend a b++normalizeTimecode :: Timecode -> Timecode+normalizeTimecode (Timecode h m s ms) = Timecode newH newM newS newMs+  where+    msTotal = ms + 1000 * (s + 60 * (m + 60 * h))  +    newMs = msTotal `mod` 1000+    sLeft = (msTotal - newMs) `div` 1000+    --newS = ((msTotal - newMs) `div` 1000) `mod` 60 +    newS = sLeft `mod` 60 +    --newM = ((((msTotal - newMs) `div` 1000) - newS) `div` 60) `mod` 60+    mLeft = (sLeft - newS) `div` 60+    newM = mLeft `mod` 60+    --newH = (((((msTotal - newMs) `div` 1000) - newS) `div` 60) - newM) `div` 60+    newH = (mLeft - newM) `div` 60++normalTimecode :: Parser Timecode+normalTimecode = do+  --plus <|> minus+  ts <- number `sepBy1` char ':'+  ms <- read <$> (option "0" $ char '.' *> number)+  return $ case (fmap read ts) of+    (h:m:s:[]) -> toTimecode h m s ms+    (m:s:[]) -> toTimecode 0 m s ms+    (s:[]) -> toTimecode 0 0 s ms++toTimecode :: Int -> Int -> Int -> Int -> Timecode+toTimecode h m s ms = normalizeTimecode (Timecode h m s ms)++msToTimecode :: Int -> Timecode+msToTimecode ms = Timecode h m s (traceShow newMs newMs)+  where+    newMs = ms `mod` 1000+    s = ((ms - newMs) `div` 1000) `mod` 60+    m = ((ms - newMs) `div` (60 * 1000)) `mod` 60 +    h = ((ms - newMs) `div` (60 * 60 * 1000)) `mod` 60++sToTimecode :: Int -> Timecode+sToTimecode s = Timecode h m (traceShow newS newS) 0+  where+    newS = s `mod` 60+    m = (s - newS) `div` 60 +    h = m `mod` 60++mToTimecode :: Int -> Timecode+mToTimecode m = Timecode h newM 0 0+  where+    newM = m `mod` 60+    h = ((m - newM) `div` 60) `mod` 60++hToTimecode :: Int -> Timecode+hToTimecode h = Timecode h 0 0 0++timecode :: Parser Timecode+timecode = normalTimecode++readTimecode :: String -> Maybe Timecode+readTimecode str = case (parse timecode "Timecode" str) of+  Left err -> error $ "Error parsing timecode: " ++ (show err)+  Right s -> Just s++optTimecode :: ArgName -> ShortName -> Optional HelpMessage -> Turtle.Parser Timecode+optTimecode = opt (readTimecode . Text.unpack)

+ test/Spec.hs view

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"

+ turtle-options.cabal view

@@ -0,0 +1,50 @@+name:                turtle-options+version:             0.1.0.0+synopsis:            Collection of command line options and parsers for these options+description:         Please see README.md+homepage:            http://github.com/githubuser/turtle-options#readme+license:             BSD3+license-file:        LICENSE+author:              Elie Genard+maintainer:          elaye@users.noreply.github.com+copyright:           2016 Elie Genard+category:            Utils+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Turtle.Options.Scale+                     , Turtle.Options.Percentage+                     , Turtle.Options.Quality+                     , Turtle.Options.Timecode+                     , Turtle.Options.Parsers+  build-depends:       base >= 4.7 && < 5+                     , parsec+                     , text+                     , optional-args+                     , turtle+  default-language:    Haskell2010++executable example+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , turtle+                     , turtle-options+  default-language:    Haskell2010++test-suite turtle-options-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , turtle-options+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/githubuser/turtle-options