diff --git a/clac.cabal b/clac.cabal --- a/clac.cabal +++ b/clac.cabal @@ -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 diff --git a/src-exec/clac.hs b/src-exec/clac.hs --- a/src-exec/clac.hs +++ b/src-exec/clac.hs @@ -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" )