clac 0.3.0 → 0.4.0
raw patch · 2 files changed
+78/−56 lines, 2 filesdep ~plailude
Dependency ranges changed: plailude
Files
- clac.cabal +2/−2
- src-exec/clac.hs +76/−54
clac.cabal view
@@ -1,5 +1,5 @@ name: clac-version: 0.3.0+version: 0.4.0 synopsis: Simple CLI RPN calculator description: Simple CLI RPN calculator. license: GPL-3@@ -19,7 +19,7 @@ build-depends: base >=4.7 && <4.8, containers >=0.5 && <0.6, optparse-applicative >=0.11 && <0.12,- plailude >=0.3 && <0.5,+ plailude >=0.5 && <0.6, pretty-tree >=0.1 && <0.2, safe >=0.3 && <0.4, split >=0.2 && <0.3
src-exec/clac.hs view
@@ -41,6 +41,7 @@ import Data.Tree ( Tree (Node),+ Forest, ) import Data.Tree.Pretty (@@ -66,8 +67,15 @@ ( readMay, )+import System.IO+ (+ hFlush,+ stdout,+ ) +import Plailude + data Opt = MkOpt {h :: Bool ,v :: Bool ,e :: [String]@@ -85,38 +93,41 @@ show (Dop _ a) = a data Op where- Bop :: (forall a. Fractional a => a -> a -> a) -> Op+ Bop :: (forall a. Floating a => a -> a -> a) -> Op Uop :: (forall a. Floating a => a -> a) -> Op C :: (forall a. Floating a => a) -> Op Neq :: Op ops :: Parser Opt-ops = MkOpt- <$> switch- ( long "operations"- <> short 'o'- <> help "Print all operations" )- <*> switch- ( long "verbose"- <> short 'v'- <> help "Verbose output" )- <*> many (strArgument mempty)+ops = MkOpt <$> switch ( long "operations"+ <> short 'o'+ <> help "Print all operations" )+ <*> switch ( long "verbose"+ <> short 'v'+ <> help "Verbose output" )+ <*> many (strArgument mempty) os :: [(OpDesc, String)]-os = [( Dop (Bop (+)) "+", "+:\t\taddition" )- ,( Dop (Bop (-)) "-", "-:\t\tsubtraction" )- ,( Dop (Bop (*)) "*", "*:\t\tmultiplication" )- ,( Dop (Bop (*)) "x", "*:\t\tmultiplication" )- ,( Dop (Bop (/)) "/", "/:\t\tdivision" )- ,( Dop (Uop negate) "neg", "neg:\t\tnegation" )- ,( Dop (Uop sin) "sin", "sin:\t\tsine function" )- ,( Dop (Uop cos) "cos", "cos:\t\tcosine function" )- ,( Dop (Uop tan) "tan", "tan:\t\ttangent function" )- ,( Dop (Uop asin) "asin","asine:\t\tarcsine function" )- ,( Dop (Uop acos) "acos","acosine:\tarccosine function" )- ,( Dop (Uop atan) "atan","arctan:\t\tarctangent function" )- ,( Dop (C pi) "pi", "pi:\t\tpi constant" )- ,( Dop Neq ",", ",:\t\tstart a new equation" )+os = [( Dop (Bop (+)) "+", "+:\t\taddition" )+ ,( Dop (Bop (-)) "-", "-:\t\tsubtraction" )+ ,( Dop (Bop (*)) "*", "*:\t\tmultiplication" )+ ,( Dop (Bop (*)) "x", "*:\t\tmultiplication" )+ ,( Dop (Bop (/)) "/", "/:\t\tdivision" )+ ,( Dop (Bop (**)) "^", "^:\t\tpower of" )+ ,( Dop (Bop logBase) "log-n", "log-n:\t\tlog-n: log rhs / log lhs" )+ ,( Dop (Uop negate) "neg", "neg:\t\tnegation" )+ ,( Dop (Uop abs) "abs", "abs:\t\tabsolute value" )+ ,( Dop (Uop log) "ln", "ln:\t\tnatural logarithm" )+ ,( Dop (Uop $ logBase 10) "lg", "ln:\t\tcommon logarithm" )+ ,( Dop (Uop sin) "sin", "sin:\t\tsine function" )+ ,( Dop (Uop cos) "cos", "cos:\t\tcosine function" )+ ,( Dop (Uop tan) "tan", "tan:\t\ttangent function" )+ ,( Dop (Uop asin) "asin", "asine:\t\tarcsine function" )+ ,( Dop (Uop acos) "acos", "acosine:\tarccosine function" )+ ,( Dop (Uop atan) "atan", "arctan:\t\tarctangent function" )+ ,( Dop (Uop sqrt) "sqrt", "sqrt:\t\tsquare root function" )+ ,( Dop (C pi) "pi", "pi:\t\tpi constant" )+ ,( Dop Neq ",", ",:\t\tstart a new equation" ) ] b :: String -> [StackItem Double] -> [StackItem Double]@@ -125,17 +136,18 @@ Nothing -> ac p :: String -> Maybe (StackItem Double)-p m = (Sop <$> find ((== m) . desc) (fst <$> os))- <|> Snum <$> (readMay m :: Maybe Double)+p i = (Sop <$> find ((== i) . desc) (fst <$> os))+ <|> Snum <$> (readMay i :: Maybe Double) -t :: [StackItem Double] -> Tree String-t (Sop (Dop (Bop _) i):j:k) = Node i [t k, t [j]]-t (Sop (Dop (Uop _) i):j) = Node i [t j]-t (Sop (Dop (C _ ) i):_) = Node i []-t (Snum i:_) = Node (show i) []-t _ = Node "¯\\_(ツ)_/¯" []+t :: Show a => [StackItem a] -> Forest String -> Tree String+t (Sop (Dop (Bop _) o):ss) (n:m:ts) = t ss (Node o [m, n]:ts)+t (Sop (Dop (Uop _) o):ss) (m:ts) = t ss (Node o [m]:ts)+t (Sop (Dop (C _) c):ss) ts = t ss (Node c []:ts)+t (Snum n:ss) ts = t ss (Node (show n) []:ts)+t [] (n:_) = n+t _ _ = Node "¯\\_(ツ)_/¯" [] -s :: [StackItem Double] -> [StackItem Double] -> Maybe Double+s :: Floating a => [StackItem a] -> [StackItem a] -> Maybe a s (Sop (Dop (Bop o) _):ss) (Snum n:Snum m:ts) = s ss (Snum (m `o` n):ts) s (Sop (Dop (Uop o) _):ss) (Snum m:ts) = s ss (Snum (o m):ts) s (Sop (Dop (C c) _):ss) ts = s ss (Snum c:ts)@@ -144,27 +156,37 @@ s _ _ = Nothing sa :: [[String]] -> [(Maybe Double, String)]-sa = map $ (second drawVerticalTree . (((,) . flip s [])- <*> (t . reverse))) . foldr b []+sa = map $ (second drawVerticalTree . (((,) . (`s` []))+ <*> (`t` []))) . foldr b [] +f :: Show a => Opt -> [(a, String)] -> IO ()+f o = mapM_ (\(solution, tree) -> do+ when (v o) $ putStrLn $ "\n\n" ++ tree+ print solution+ putStrLn $ replicate (length $ show solution) '=')++repl :: Opt -> IO a+repl o = do+ putStr ">"+ hFlush stdout+ l <- getLine+ f o . sa . splitOn [","] . words $ l+ repl o++clac :: Opt -> [[String]] -> IO ()+clac o [[]] = repl o+ ~+~ (getContents >>= \cs -> clac o (splitOn [","] . words $ cs))+clac o es = f o . sa $ es+ calc :: Opt -> IO ()-calc o = do- cs <- if null (e o) then getContents else return []- let es = splitOn [","] $ words cs ++ case e o of- [a] -> words a- _ -> e o- if h o- then mapM_ putStrLn $ "OPERATORS":"=========":map snd os- else- mapM_ (\(solution, tree) -> do- when (v o) $ putStrLn $ "\n\n" ++ tree- print solution- putStrLn $ replicate (length $ show solution) '=') $ sa es+calc o = if h o+ then mapM_ putStrLn $ "OPERATORS":"=========":map snd os+ else clac o $ splitOn [","] $ case e o of+ [a] -> words a+ _ -> e o main :: IO ()-main = execParser o >>= calc- where o =- info (helper <*> ops)- ( fullDesc- <> progDesc "simple CLI RPN calculator"- <> header "clac" )+main = execParser o >>= calc where o = info (helper <*> ops)+ ( fullDesc+ <> progDesc "simple CLI RPN calculator"+ <> header "clac" )