clac 0.2.0 → 0.3.0
raw patch · 2 files changed
+145/−41 lines, 2 filesdep +containersdep +optparse-applicativedep +pretty-tree
Dependencies added: containers, optparse-applicative, pretty-tree, split
Files
- clac.cabal +9/−4
- src-exec/clac.hs +136/−37
clac.cabal view
@@ -1,5 +1,5 @@ name: clac-version: 0.2.0+version: 0.3.0 synopsis: Simple CLI RPN calculator description: Simple CLI RPN calculator. license: GPL-3@@ -15,8 +15,13 @@ main-is: clac.hs other-extensions: GADTs RankNTypes- build-depends: base >=4.7 && <4.8,- plailude >=0.3 && <0.5,- safe >=0.3 && <0.4+ StandaloneDeriving+ build-depends: base >=4.7 && <4.8,+ containers >=0.5 && <0.6,+ optparse-applicative >=0.11 && <0.12,+ plailude >=0.3 && <0.5,+ pretty-tree >=0.1 && <0.2,+ safe >=0.3 && <0.4,+ split >=0.2 && <0.3 hs-source-dirs: src-exec default-language: Haskell2010
src-exec/clac.hs view
@@ -1,71 +1,170 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-} {- |-Module : $Header$-Description : clac.-Copyright : (c) Alexander Berntsen 2015-License : GPL-3+Module : $Header$+Description: clac.+Copyright : (c) Alexander Berntsen 2015+License : GPL-3 -Maintainer : alexander@plaimi.net+Maintainer : alexander@plaimi.net -} module Main where import Control.Applicative (- (<|>), (<$>),+ (<|>),+ (<*>), )-import Safe+import Control.Arrow (- readMay,+ second, )-import System.Environment+import Control.Monad (- getArgs,+ when, )+import Data.List+ (+ find,+ )+import Data.List.Split+ (+ splitOn,+ )+import Data.Monoid+ (+ (<>),+ mempty,+ )+import Data.Tree+ (+ Tree (Node),+ )+import Data.Tree.Pretty+ (+ drawVerticalTree,+ )+import Options.Applicative+ (+ Parser,+ execParser,+ fullDesc,+ header,+ help,+ helper,+ info,+ long,+ many,+ progDesc,+ short,+ strArgument,+ switch,+ )+import Safe+ (+ readMay,+ ) -import Plailude +data Opt = MkOpt {h :: Bool+ ,v :: Bool+ ,e :: [String]+ } data StackItem a where Snum :: forall a. Fractional a => a -> StackItem a- Sop :: Op -> StackItem a+ Sop :: OpDesc -> StackItem a+deriving instance Show a => Show (StackItem a) +data OpDesc = Dop {op :: Op+ ,desc :: String+ }+instance Show OpDesc where+ show (Dop _ a) = a+ data Op where Bop :: (forall a. Fractional a => a -> a -> a) -> Op Uop :: (forall a. Floating a => a -> a) -> Op+ C :: (forall a. Floating a => a) -> Op+ Neq :: Op -os :: [(String, (StackItem Double, String))]-os = [ ( "+", ( Sop (Bop (+)), "+:\t\taddition" ))- , ( "-", ( Sop (Bop (-)), "-:\t\tsubtraction" ))- , ( "*", ( Sop (Bop (*)), "*:\t\tmultiplication" ))- , ( "/", ( Sop (Bop (/)), "/:\t\tdivision" ))- , ( "neg", ( Sop (Uop negate), "neg:\t\tnegation" ))- , ( "sin", ( Sop (Uop sin), "sin:\t\tsine function" ))- , ( "cos", ( Sop (Uop cos), "cos:\t\tcosine function" ))- , ( "tan", ( Sop (Uop tan), "tan:\t\ttangent function" ))- , ( "atan", ( Sop (Uop atan), "arctan:\t\tarctangent function" ))+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)++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" ) ] b :: String -> [StackItem Double] -> [StackItem Double] b x ac = case p x of- Just q -> q : ac+ Just q -> q:ac Nothing -> ac p :: String -> Maybe (StackItem Double)-p m = (fmap fst .: lookup) m os <|> Snum <$> (readMay m :: Maybe Double)+p m = (Sop <$> find ((== m) . desc) (fst <$> os))+ <|> Snum <$> (readMay m :: 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 "¯\\_(ツ)_/¯" []+ s :: [StackItem Double] -> [StackItem Double] -> Maybe Double-s (Sop (Bop o) : ss) (Snum n : Snum m : ts) = s ss (Snum (m `o` n) : ts)-s (Sop (Uop o) : ss) (Snum m : ts) = s ss (Snum (o m) : ts)-s (n:ss) ts = s ss (n : ts)-s [] (Snum n:_) = Just n-s _ _ = Nothing+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)+s (n:ss) ts = s ss (n:ts)+s [] (Snum n:_) = Just n+s _ _ = Nothing +sa :: [[String]] -> [(Maybe Double, String)]+sa = map $ (second drawVerticalTree . (((,) . flip s [])+ <*> (t . reverse))) . foldr b []++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+ main :: IO ()-main = do- as <- getArgs- bs <- if null as then getContents else return []- if "help" `elem` as- then mapM_ putStrLn $ "OPERATORS" : "=========" : [h | (_, (_, h)) <- os]- else print . flip s [] . foldr b [] $ as ++ words bs+main = execParser o >>= calc+ where o =+ info (helper <*> ops)+ ( fullDesc+ <> progDesc "simple CLI RPN calculator"+ <> header "clac" )