diff --git a/backend/team-proj-abbr/data/test_file.txt b/backend/team-proj-abbr/data/test_file.txt new file mode 100644 index 00000000..e23ff85f --- /dev/null +++ b/backend/team-proj-abbr/data/test_file.txt @@ -0,0 +1 @@ +Hello world. This file is written to test the expansions of kb_example.csv. We should see that @@hl is expanded to hello. This is a @@thm, which we cannot @@prf. No @@lmm or @@ax can be used, because this is not a scientific theorem. \ No newline at end of file diff --git a/backend/team-proj-abbr/data/test_file_target.txt b/backend/team-proj-abbr/data/test_file_target.txt new file mode 100644 index 00000000..9507e9d3 --- /dev/null +++ b/backend/team-proj-abbr/data/test_file_target.txt @@ -0,0 +1 @@ +Hello world. This file is written to test the expansions of kb_example.csv. We should see that hello is expanded to hello. This is a theorem, which we cannot proof. No lemma or axiom can be used, because this is not a scientific theorem. \ No newline at end of file diff --git a/backend/team-proj-abbr/lib-cli/LibCli/Main.hs b/backend/team-proj-abbr/lib-cli/LibCli/Main.hs index 2528c82a..c4173c80 100644 --- a/backend/team-proj-abbr/lib-cli/LibCli/Main.hs +++ b/backend/team-proj-abbr/lib-cli/LibCli/Main.hs @@ -9,22 +9,40 @@ Stability : experimental module LibCli.Main where -import qualified LibCli.Spec as CS (ShortHndr (..), cliModes) -import qualified System.Console.CmdArgs as CMD +import LibCli.Spec +import LibCore.Decoder (decode) +import LibCore.KnowledgeBase (getKnowledgeBase) +import LibCore.Mapper (mapParseStructure) +import LibCore.OutputInterface (returnOutput) +import LibCore.Parser (doParse) +import System.Console.CmdArgs.Explicit + ( HelpFormat (HelpFormatAll) + , helpText + , processArgs + ) ----------------------- -- Command Handlers: -- ----------------------- --- TODO(tech-debt): define a typeclass for the modes instead of the pattern matching -- TODO: (future task) implement the actual handlers with the business logic. -mockCliHandler :: CS.ShortHndr -> IO () -mockCliHandler c@CS.Replace{} = print $ "replacing! --> " ++ show c -mockCliHandler c@CS.Expand{} = print $ "expanding! --> " ++ show c -mockCliHandler c@CS.List{} = print $ "listing! --> " ++ show c -mockCliHandler c@CS.Add{} = print $ "adding! --> " ++ show c -mockCliHandler c@CS.Update{} = print $ "updating! --> " ++ show c -mockCliHandler c@CS.Delete{} = print $ "deleting! --> " ++ show c +handleExpMode :: Expansion -> IO () +handleExpMode (Re r) = replaceMode r +handleExpMode (Ex c) = print $ "expanding! --> " ++ show c + +handleKbtMode :: KnowledgeBaseTypes -> IO () +handleKbtMode (Lst c) = print $ "listing! --> " ++ show c +handleKbtMode (Ad c) = print $ "adding! --> " ++ show c +handleKbtMode (Up c) = print $ "updating! --> " ++ show c +handleKbtMode (Del c) = print $ "deleting! --> " ++ show c + +replaceMode :: Replace -> IO () +replaceMode c = do + case input c of + Nothing -> error "No input file was found" + Just f -> do + s <- readFile f + returnOutput (out c) (decode $ mapParseStructure getKnowledgeBase $ doParse s) ---------------------------- -- Executable entrypoiny: -- @@ -50,4 +68,9 @@ mockCliHandler c@CS.Delete{} = print $ "deleting! --> " ++ show c -- -- * See 'LibCli.Spec' for more information about the CLI endpoints. cliMain :: IO () -cliMain = mockCliHandler =<< CMD.cmdArgs (CMD.modes CS.cliModes) +cliMain = do + xs <- processArgs arguments + case xs of + Exp ex -> handleExpMode ex + Kbt kbt -> handleKbtMode kbt + Hlp -> print $ helpText [] HelpFormatAll arguments diff --git a/backend/team-proj-abbr/lib-cli/LibCli/Spec.hs b/backend/team-proj-abbr/lib-cli/LibCli/Spec.hs index 33177d7e..a6160678 100644 --- a/backend/team-proj-abbr/lib-cli/LibCli/Spec.hs +++ b/backend/team-proj-abbr/lib-cli/LibCli/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GADTs #-} {-| Description : Command Line Interface - Specification @@ -8,131 +8,191 @@ Maintainer : p.c.cadoppi@students.uu.nl; d.orlov@student.tue.nl; w.j.zwietering Stability : experimental -} -module LibCli.Spec - ( cliModes - , ShortHndr(..) - ) where +module LibCli.Spec where -import qualified System.Console.CmdArgs as CMD +import System.Console.CmdArgs.Explicit + ( Mode + , flagArg + , flagHelpSimple + , flagNone + , flagReq + , mode + , modes + ) ----------------------------------- -- CLI interface specificaitons: -- ----------------------------------- +data Expansion where + Re :: Replace -> Expansion + Ex :: Expand -> Expansion + deriving (Show) + +data KnowledgeBaseTypes where + Lst :: List -> KnowledgeBaseTypes + Ad :: Add -> KnowledgeBaseTypes + Up :: Update -> KnowledgeBaseTypes + Del :: Delete -> KnowledgeBaseTypes + deriving (Show) + +data ShortHndrModes where + Exp :: Expansion -> ShortHndrModes + Kbt :: KnowledgeBaseTypes -> ShortHndrModes + Hlp :: ShortHndrModes + deriving (Show) + + -- |ShortHndr CLI interface specification. -data ShortHndr - -- |Defines the arguments for the replace command +-- |Defines the arguments for the replace command +data Replace = Replace - { input :: Maybe FilePath - , out :: Maybe FilePath - , inplace :: Maybe Bool - , kb :: Maybe FilePath + { input :: Maybe FilePath + , out :: Maybe FilePath + , inplace :: Maybe Bool + , replace_kb :: Maybe FilePath } - -- |Defines the arguments for the expand command - | Expand - { abbreviation :: String - , kb :: Maybe FilePath - } - -- |Defines the arguments for the list command - | List - { kb :: Maybe FilePath + deriving (Show) + +-- |Defines the arguments for the expand command +data Expand + = Expand + { expand_abbr :: String + , expand_kb :: Maybe FilePath } - -- |Defines the arguments for the add command - | Add - { abbreviation :: String - , expansion :: String - , kb :: Maybe FilePath + deriving (Show) + +-- |Defines the arguments for the list command +newtype List + = List { list_kb :: Maybe FilePath } + deriving (Show) + +-- |Defines the arguments for the add command +data Add + = Add + { add_abbr :: String + , add_expansion :: String + , add_kb :: Maybe FilePath } - -- |Defines the arguments for the update command - | Update - { abbreviation :: String - , expansion :: String - , kb :: Maybe FilePath + deriving (Show) + +-- |Defines the arguments for the update command +data Update + = Update + { update_abbr :: String + , update_expansion :: String + , update_kb :: Maybe FilePath } - -- |Defines the arguments for the delete command - | Delete - { abbreviation :: String - , kb :: Maybe FilePath + deriving (Show) + +-- |Defines the arguments for the delete command +data Delete + = Delete + { delete_abbr :: String + , delete_kb :: Maybe FilePath } - deriving (CMD.Data, CMD.Typeable, Show) - --- |Utility function to provide help for the file type arguments. -fileFlags :: String -> Maybe FilePath -> Maybe FilePath -fileFlags h f = f CMD.&= CMD.help h CMD.&= CMD.typFile - -------------------------- --- Expansion commands: -- -------------------------- - -replace :: ShortHndr -replace = - Replace - { input = fileFlags "Source file" (pure "shorthndr-input.txt") - , out = fileFlags "Output file" (pure "shorthndr--out.txt") - , kb = fileFlags "Knowledge Base source file" - (pure "shorthndr-kb.csv") - , inplace = CMD.def - } - CMD.&= CMD.help - "Replace all abreviations in the provided file with their expansions" - -expand :: ShortHndr -expand = - Expand - { abbreviation = CMD.def - , kb = fileFlags "Knowledge Base source file" - (pure "shorthndr-kb.csv") - } - CMD.&= CMD.help - "Expand a provided abbreviation abbreviation if one is found" - -expansionModes :: [ShortHndr] -expansionModes = [replace, expand] - ------------------------------- --- Knowledge Base commands: -- ------------------------------- - -list :: ShortHndr -list = - List { kb = fileFlags "Knowledge Base source file" (pure "shorthndr-kb.csv") - } - CMD.&= CMD.help "List all records of the Knowledge Base" - -add :: ShortHndr -add = - Add { abbreviation = CMD.def - , expansion = CMD.def - , kb = fileFlags "Knowledge Base source file" (pure "shorthndr-kb.csv") - } - CMD.&= CMD.help "Add a new abbreviation record to the Knowledge Base" - -update :: ShortHndr -update = - Update - { abbreviation = CMD.def - , expansion = CMD.def - , kb = fileFlags "Knowledge Base source file" - (pure "shorthndr-kb.csv") - } - CMD.&= CMD.help - "Update an existing abbreviation record in the Knowledge Base" - -delete :: ShortHndr -delete = - Delete - { abbreviation = CMD.def - , kb = fileFlags "Knowledge Base source file" - (pure "shorthndr-kb.csv") - } - CMD.&= CMD.help "Delete an abbreviation record from the Knowledge Base" - -kbModes :: [ShortHndr] -kbModes = [list, add, update, delete] + deriving (Show) + ----------------------------- -- All exported CLI modes: -- ----------------------------- -cliModes :: [ShortHndr] -cliModes = expansionModes ++ kbModes +defaultMode :: ShortHndrModes +defaultMode = Hlp + +helpMode :: ShortHndrModes -> ShortHndrModes +helpMode _ = Hlp + +-- Explicit arguments +arguments :: Mode ShortHndrModes +arguments = modes "ShortHandr" defaultMode "Use 'replace' to enter replace mode" [replaceArgs, expandArgs, listArgs, addArgs, updateArgs, deleteArgs] + +replaceArgs :: Mode ShortHndrModes +replaceArgs = mode "replace" initial + "Replace all abreviations in the provided file with their expansions" + (flagArg (updateMode "") "replace") + [ + flagReq ["input", "i"] (updateMode "input") "FILENAME" "Input filename" + ,flagReq ["out", "o"] (updateMode "out") "FILENAME" "Output filename" + ,flagReq ["k"] (updateMode "replace_kb") "FILENAME" "Knowledgebase filename" + ,flagNone ["inplace"] (setInplace True) "inplace" + ,flagHelpSimple helpMode + ] + where initial = Exp $ Re $ Replace { input = Just "", out = Just "", replace_kb = Just "", inplace = Just False } + +setInplace :: Bool -> ShortHndrModes -> ShortHndrModes +setInplace b (Exp (Re r)) = Exp $ Re $ r {inplace = Just b} +setInplace _ r = r + +expandArgs :: Mode ShortHndrModes +expandArgs = mode "expand" initial + "Expand a provided abbreviation abbreviation if one is found" + (flagArg (updateMode "abbr") "abbreviation") + [ + flagReq ["k"] (updateMode "expand_kb") "FILENAME" "Knowledgebase filename" + ,flagHelpSimple helpMode + ] + where initial = Exp $ Ex $ Expand { expand_abbr = "", expand_kb = Just "" } + +listArgs :: Mode ShortHndrModes +listArgs = mode "list" initial + "List all records of the Knowledge Base" + (flagArg (updateMode "") "list") + [ + flagReq ["k"] (updateMode "list_kb") "FILENAME" "Knowledgebase filename" + ,flagHelpSimple helpMode + ] + where initial = Kbt $ Lst $ List { list_kb = Just "" } + +addArgs :: Mode ShortHndrModes +addArgs = mode "add" initial + "Add a new abbreviation record to the Knowledge Base" + (flagArg (updateMode "") "add") + [ + flagReq ["k"] (updateMode "add_kb") "FILENAME" "Knowledgebase filename" + ,flagReq ["ex"] (updateMode "add_ex") "expansion" "Abbreviation expansion" + ,flagReq ["abbr"] (updateMode "add_abbr") "abbreviation" "Abbreviation" + ,flagHelpSimple helpMode + ] + where initial = Kbt $ Ad $ Add { add_abbr = "", add_expansion = "", add_kb = Just "" } + +updateArgs :: Mode ShortHndrModes +updateArgs = mode "update" initial + "Update an existing abbreviation record in the Knowledge Base" + (flagArg (updateMode "") "update") + [ + flagReq ["k"] (updateMode "update_kb") "FILENAME" "Knowledgebase filename" + ,flagReq ["ex"] (updateMode "update_ex") "expansion" "Abbreviation expansion" + ,flagReq ["abbr"] (updateMode "update_abbr") "abbreviation" "Abbreviation" + ,flagHelpSimple helpMode + ] + where initial = Kbt $ Up $ Update { update_abbr = "", update_expansion = "", update_kb = Just "" } + +deleteArgs :: Mode ShortHndrModes +deleteArgs = mode "delete" initial + "Delete an abbreviation record from the Knowledge Base" + (flagArg (updateMode "") "delete") + [ + flagReq ["k"] (updateMode "delete_kb") "FILENAME" "Knowledgebase filename" + ,flagReq ["abbr"] (updateMode "delete_abbr") "abbreviation" "Abbreviation" + ,flagHelpSimple helpMode + ] + where initial = Kbt $ Del $ Delete { delete_abbr = "", delete_kb = Just "" } + +updateMode :: String -> String -> ShortHndrModes -> Either String ShortHndrModes +updateMode "input" s (Exp (Re r)) = Right $ Exp $ Re $ r {input = Just s} +updateMode "out" s (Exp (Re r)) = Right $ Exp $ Re $ r {out = Just s} +updateMode "replace_kb" s (Exp (Re r)) = Right $ Exp $ Re $ r {replace_kb = Just s} +updateMode "expand_kb" s (Exp (Ex r)) = Right $ Exp $ Ex $ r { expand_kb = Just s} +updateMode "abbr" s (Exp (Ex r)) = Right $ Exp $ Ex $ r { expand_abbr = s } +updateMode "list_kb" s (Kbt (Lst r)) = Right $ Kbt $ Lst $ r { list_kb = Just s} +updateMode "add_kb" s (Kbt (Ad r)) = Right $ Kbt $ Ad $ r { add_kb = Just s} +updateMode "add_ex" s (Kbt (Ad r)) = Right $ Kbt $ Ad $ r { add_expansion = s} +updateMode "add_abbr" s (Kbt (Ad r)) = Right $ Kbt $ Ad $ r { add_abbr = s} +updateMode "update_kb" s (Kbt (Up r)) = Right $ Kbt $ Up $ r { update_kb = Just s} +updateMode "update_ex" s (Kbt (Up r)) = Right $ Kbt $ Up $ r { update_expansion = s} +updateMode "update_abbr" s (Kbt (Up r)) = Right $ Kbt $ Up $ r { update_abbr = s} +updateMode "delete_kb" s (Kbt (Del r)) = Right $ Kbt $ Del $ r { delete_kb = Just s} +updateMode "delete_abbr" s (Kbt (Del r)) = Right $ Kbt $ Del $ r { delete_abbr = s} +updateMode _ _ e = Right e diff --git a/backend/team-proj-abbr/lib-core/LibCore/Decoder.hs b/backend/team-proj-abbr/lib-core/LibCore/Decoder.hs index 41270eb2..7ceeb6c4 100644 --- a/backend/team-proj-abbr/lib-core/LibCore/Decoder.hs +++ b/backend/team-proj-abbr/lib-core/LibCore/Decoder.hs @@ -8,7 +8,12 @@ Stability : experimental module LibCore.Decoder where +import LibCore.Models (Keyword (Keyword), Token (DoMap, NoToken)) import LibCore.Parser (ParseStructure) decode :: ParseStructure -> String -decode = undefined +decode s = unwords $ map tokenToString s + +tokenToString :: Token -> String +tokenToString (NoToken s) = s +tokenToString (DoMap (Keyword k _)) = k diff --git a/backend/team-proj-abbr/lib-core/LibCore/KnowledgeBase.hs b/backend/team-proj-abbr/lib-core/LibCore/KnowledgeBase.hs index 7494fcb2..da180a9f 100644 --- a/backend/team-proj-abbr/lib-core/LibCore/KnowledgeBase.hs +++ b/backend/team-proj-abbr/lib-core/LibCore/KnowledgeBase.hs @@ -8,10 +8,10 @@ Stability : experimental module LibCore.KnowledgeBase where -import Data.Map (Map) +import Data.Map (Map, empty) import LibCore.Models (Keyword) type KnowledgeBaseStructure = Map Keyword Keyword getKnowledgeBase :: KnowledgeBaseStructure -getKnowledgeBase = undefined +getKnowledgeBase = empty diff --git a/backend/team-proj-abbr/lib-core/LibCore/OutputInterface.hs b/backend/team-proj-abbr/lib-core/LibCore/OutputInterface.hs index 6632fd21..26e94a67 100644 --- a/backend/team-proj-abbr/lib-core/LibCore/OutputInterface.hs +++ b/backend/team-proj-abbr/lib-core/LibCore/OutputInterface.hs @@ -8,5 +8,7 @@ Stability : experimental module LibCore.OutputInterface where -returnOutput :: String -> IO () -returnOutput = undefined +returnOutput :: Maybe FilePath -> String -> IO () +returnOutput f = case f of + Nothing -> error "No output file found" + Just s -> writeFile s