Browse Source

Basic TeLML HK generator parsers

Getty Ritter 6 years ago
commit
da621a9af4
3 changed files with 126 additions and 0 deletions
  1. 5 0
      .gitignore
  2. 23 0
      hk-generator.cabal
  3. 98 0
      src/Main.hs

+ 5 - 0
.gitignore

@@ -0,0 +1,5 @@
+*~
+.dante-dist
+dist-newstyle
+.ghc.environment*
+cabal.project.local

+ 23 - 0
hk-generator.cabal

@@ -0,0 +1,23 @@
+name:             hk-generator
+version:          0.1.0.0
+-- synopsis:
+-- description:
+license:          BSD3
+license-file:     LICENSE
+author:           Getty Ritter <samothes@infinitenegativeutility.com>
+maintainer:       Getty Ritter <samothes@infinitenegativeutility.com>
+copyright:        ©2018 Getty Ritter
+-- category:
+build-type:       Simple
+cabal-version:    >= 1.14
+
+executable hk-generator
+  hs-source-dirs:      src
+  main-is:             Main.hs
+  default-extensions:  OverloadedStrings,
+                       ScopedTypeVariables
+  ghc-options:         -Wall
+  build-depends:       base >=4.7 && <5
+                     , telml-parse
+                     , text
+  default-language:    Haskell2010

+ 98 - 0
src/Main.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Main where
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+import Data.TeLML.Parse
+
+data Weapon = Weapon
+  { weaponType    :: T.Text
+  , weaponName    :: T.Text
+  , weaponAbility :: T.Text
+  , weaponEffect  :: T.Text
+  } deriving (Eq, Show)
+
+data Equipment = Equipment
+  { equipmentName    :: T.Text
+  , equipmentAbility :: T.Text
+  , equipmentEffect  :: T.Text
+  } deriving (Eq, Show)
+
+data Item = Item
+  { itemName    :: T.Text
+  , itemAbility :: T.Text
+  , itemEffect  :: T.Text
+  } deriving (Eq, Show)
+
+pWeapon :: Parse Document [Weapon]
+pWeapon = select "weapon" $ arg $ do
+  weaponType <- field "type" (arg text)
+  weaponName <- field "name" (arg text)
+  weaponAbility <- field "ability" (arg text)
+  weaponEffect  <- field "effect" (arg text)
+  return Weapon { .. }
+
+prettyWeapon :: Weapon -> IO ()
+prettyWeapon Weapon { .. } = do
+  case weaponType of
+    "melee" -> putStr "\x1b[31m"
+    "ranged" -> putStr "\x1b[34m"
+    "magic" -> putStr "\x1b[33m"
+    _ -> return ()
+  T.putStr weaponName
+  putStr " ("
+  T.putStr weaponType
+  putStrLn " weapon)\x1b[39m"
+  putStr "  "
+  T.putStr weaponAbility
+  putStr ": "
+  T.putStrLn (T.unwords (T.words weaponEffect))
+
+pEquipment :: Parse Document [Equipment]
+pEquipment = select "equipment" $ arg $ do
+  equipmentName <- field "name" (arg text)
+  equipmentAbility <- field "ability" (arg text)
+  equipmentEffect  <- field "effect" (arg text)
+  return Equipment { .. }
+
+prettyEquipment :: Equipment -> IO ()
+prettyEquipment Equipment { .. } = do
+  putStr "\x1b[32m"
+  T.putStr equipmentName
+  putStrLn " (equipment)\x1b[39m"
+  putStr "  "
+  T.putStr equipmentAbility
+  putStr ": "
+  T.putStrLn (T.unwords (T.words equipmentEffect))
+
+pItem :: Parse Document [Item]
+pItem = select "item" $ arg $ do
+  itemName <- field "name" (arg text)
+  itemAbility <- field "ability" (arg text)
+  itemEffect  <- field "effect" (arg text)
+  return Item { .. }
+
+prettyItem :: Item -> IO ()
+prettyItem Item { .. } = do
+  putStr "\x1b[35m"
+  T.putStr itemName
+  putStrLn " (item)\x1b[39m"
+  putStr "  "
+  T.putStr itemAbility
+  putStr ": "
+  T.putStrLn (T.unwords (T.words itemEffect))
+
+main :: IO ()
+main = do
+  rs <- getContents
+  case decode rs pWeapon of
+    Left err -> putStrLn err
+    Right x  -> mapM_ prettyWeapon x
+  case decode rs pEquipment of
+    Left err -> putStrLn err
+    Right x  -> mapM_ prettyEquipment x
+  case decode rs pItem of
+    Left err -> putStrLn err
+    Right x  -> mapM_ prettyItem x