Now uses the new datatypes

This commit is contained in:
Pingu 2022-10-28 13:29:21 +02:00
parent c0f058dd42
commit 71bbe0f388

View File

@ -4,11 +4,9 @@ import Control.Applicative hiding (some)
import Control.Monad import Control.Monad
import Data.Functor import Data.Functor
import Data.Void import Data.Void
import GHC.Stack.CCS (whereFrom)
import GHC.StaticPtr (StaticPtrInfo)
import System.Environment import System.Environment
import System.Exit import System.Exit
import Text.Megaparsec hiding (satisfy) import Text.Megaparsec
import Text.Megaparsec.Char import Text.Megaparsec.Char
type Parser = Parsec Void String type Parser = Parsec Void String
@ -30,7 +28,7 @@ instance Show Info where
show :: Info -> String show :: Info -> String
show info = case info of show info = case info of
Bread text -> text Bread text -> text
List texts -> "[LIST]" ++ concatMap show texts ++ "[/LIST]" List texts -> "[LIST]" ++ concatMap ((++) "[*] " . show) texts ++ "[/LIST]"
Header text -> "[TITLE]" ++ text ++ "[/TITLE]" Header text -> "[TITLE]" ++ text ++ "[/TITLE]"
Subheader text -> "[SIZE=4]" ++ text ++ "[/SIZE]" Subheader text -> "[SIZE=4]" ++ text ++ "[/SIZE]"
Subsubheader text -> "[SIZE=2]" ++ text ++ "[/SIZE]" Subsubheader text -> "[SIZE=2]" ++ text ++ "[/SIZE]"
@ -41,21 +39,31 @@ instance Show Info where
newtype Post = Post [Info] newtype Post = Post [Info]
parseHelper :: Parser String -> String -> String instance Show Post where
show :: Post -> String
show (Post a) = concatMap show a
parseHelper :: Parser a -> String -> a
parseHelper parser x = case parse parser "" x of parseHelper parser x = case parse parser "" x of
Left bundle -> error $ errorBundlePretty bundle Left bundle -> error $ errorBundlePretty bundle
Right text -> text Right text -> text
parseFile :: String -> String parseFile :: String -> Post
parseFile = unlines . map (parseHelper fileParser) . lines parseFile = Post . map (parseHelper fileParser) . lines
fileParser :: Parser String fileParser :: Parser Info
fileParser = try $ fileParser = undefined
string "* " <|> -- try $
string "** " -- string' "* " <|>
-- string' "** " <|>
-- string' "*** " <|>
-- string' "- " <|>
-- string' "[[" <|>
-- string' "#+BEGIN" <|>
-- string' "#+END"
parseCli :: [String] -> IO String parseCli :: [String] -> IO Post
parseCli [] = return usage parseCli [] = return $ Post [usage]
parseCli [x] = parseCli [x] =
if head x /= '-' if head x /= '-'
then parseFile <$> readFile x then parseFile <$> readFile x
@ -66,17 +74,17 @@ parseCli _ = fail "Too many arugemnts"
argParse :: Parser String argParse :: Parser String
argParse = string "-" >> some alphaNumChar argParse = string "-" >> some alphaNumChar
useArgs :: String -> String useArgs :: String -> Post
useArgs [] = "" useArgs [] = Post [Bread ""]
useArgs ('h' : _) = usage useArgs ('h' : _) = Post [usage]
useArgs ('v' : _) = version useArgs ('v' : _) = Post [version]
useArgs (_ : xs) = useArgs xs useArgs (_ : xs) = useArgs xs
usage :: String usage :: Info
usage = "Usage: otm [-hv] [file]" usage = Bread "Usage: otm [-hv] [file]"
version :: String version :: Info
version = "otm 0.1" version = Bread "otm 0.1"
main :: IO () main :: IO ()
main = putStr =<< parseCli =<< getArgs main = putStr . show =<< parseCli =<< getArgs