Fix name of sway config

[xdg-ninja.git] / lib / Program.hs

diff --git a/lib/Program.hs b/lib/Program.hs
index 06adaa2d39024c31965c96ea1aa20e66121206ce..98261524212b137c81ae53c4c2ed33f7477c82c6 100644 (file)
--- a/lib/Program.hs
+++ b/lib/Program.hs
@@ -8,16 +8,13 @@ import           Data.Aeson.Encode.Pretty
 import qualified Data.ByteString.Lazy     as B
 import qualified Data.Text                as T
 import           GHC.Generics
 import qualified Data.ByteString.Lazy     as B
 import qualified Data.Text                as T
 import           GHC.Generics

+import           System.Directory

 
 

-data File = File
-  { path         :: String,
-    supportLevel :: SupportLevel,
-    help         :: String
-  }
-  deriving (Generic, Show)
-
-instance ToJSON File where
-  toEncoding (File path supportLevel help) = pairs ("path" .= path <> "movable" .= supportLevel <> "help" .= help)
+instance FromJSON File where
+  parseJSON (Object v) = File
+    <$> v .: "path"
+    <*> v .: "movable"
+    <*> v .: "help"

 
 data Program = Program
   { name  :: T.Text,
 
 data Program = Program
   { name  :: T.Text,


@@ -26,17 +23,42 @@ data Program = Program
   deriving (Generic, Show)
 
 instance ToJSON Program where
   deriving (Generic, Show)
 
 instance ToJSON Program where

-  toEncoding = genericToEncoding defaultOptions
+  toJSON (Program name files) = object [ "name" .= name, "files" .= files ]
+  toEncoding (Program name files) = pairs ("name" .= name <> "files" .= files)
+instance FromJSON Program
+
+data File = File
+  { path         :: String,
+    supportLevel :: SupportLevel,
+    help         :: String
+  }
+  deriving (Generic, Show)

 
 

-save :: Program -> IO ()
-save program = do
-  let path = ("./programs/" ++ (T.unpack (name program)) ++ ".json")
-  B.writeFile path (encodePretty program)
+instance ToJSON File where
+  toJSON (File path supportLevel help) = object [ "path" .= path, "movable" .= supportLevel, "help" .= help ]
+  toEncoding (File path supportLevel help) = pairs ("path" .= path <> "movable" .= supportLevel <> "help" .= help)

 
 data SupportLevel = Unsupported | Alias | EnvVars | Supported
   deriving (Generic, Show)
 
 instance ToJSON SupportLevel where
 
 data SupportLevel = Unsupported | Alias | EnvVars | Supported
   deriving (Generic, Show)
 
 instance ToJSON SupportLevel where

+  toJSON Unsupported = toJSON (Bool False)
+  toJSON _           = toJSON (Bool True)

   toEncoding Unsupported = toEncoding ( Bool False )
   toEncoding _           = toEncoding ( Bool True )
   toEncoding Unsupported = toEncoding ( Bool False )
   toEncoding _           = toEncoding ( Bool True )

+instance FromJSON SupportLevel where
+  parseJSON (Bool False) = return Unsupported
+  parseJSON (Bool True)  = return EnvVars
+
+makeFilename :: T.Text -> T.Text
+makeFilename s = T.pack ( "./programs/" ++ T.unpack s ++ ".json" )
+
+save :: T.Text -> Program -> IO ()
+save filename program = do
+  createDirectoryIfMissing False "./programs/"
+  B.writeFile (T.unpack filename) (encodePretty program)

 
 

+readProgram :: String -> IO ( Maybe Program )
+readProgram filename = do
+    json_data <- B.readFile filename
+    return (decode json_data)