mirror of
https://github.com/The1Penguin/org-to-mafiauniverse.git
synced 2024-11-25 03:08:12 +00:00
Now uses the new datatypes
This commit is contained in:
parent
c0f058dd42
commit
71bbe0f388
52
app/Main.hs
52
app/Main.hs
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user