feature: adapt dhall inputs

app/Convert.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Convert (convert) where
+
+import qualified Data.Fix as Fix
+import qualified Data.Functor.Foldable as Foldable
+import Data.Time (UTCTime)
+import qualified DhallTypes as S
+import qualified Librarian as T
+
+convert :: S.Rule -> T.Rule
+convert x =
+  T.Rule
+    { name = T.RuleName x.name.getRuleName,
+      match = T.Matcher x.match.matchPattern,
+      grouping = convertGrouping x.grouping,
+      filtering = convertFiltering x.filtering,
+      actions = convertAction <$> x.actions
+    }
+
+convertGrouping :: S.Grouping -> T.Grouping
+convertGrouping =
+  \case
+    S.FileGroup -> T.FileGroup
+    S.GroupTemporally source bucket selection ->
+      T.Group
+        { groupSource = convertSourceTemporal source,
+          groupBucket = convertGroupingBucketTemporal bucket,
+          groupSelection = convertGroupSelectionTemporal selection
+        }
+
+convertFiltering :: Fix.Fix S.FilteringF -> T.Filtering
+convertFiltering = go . Fix.foldFix Foldable.embed
+  where
+    go =
+      \case
+        S.AllF -> T.AllF
+        S.AndF x y -> T.AndF (go x) (go y)
+        S.OrF x y -> T.OrF (go x) (go y)
+        S.GtFTemporal x y -> T.GtF (convertSourceTemporal x) (convertSourceTemporal y)
+        S.LtFTemporal x y -> T.LtF (convertSourceTemporal x) (convertSourceTemporal y)
+
+convertAction :: S.Action -> T.Action
+convertAction =
+  \case
+    S.Move {..} -> T.Move {inputPattern = inputPattern, newName = newName}
+    S.Copy {..} -> T.Copy {inputPattern = inputPattern, newName = newName}
+    S.Remove {..} -> T.Remove {inputPattern = inputPattern}
+
+convertSourceTemporal :: S.SourceTemporal -> T.Source UTCTime
+convertSourceTemporal =
+  \case
+    S.SourceDate x -> T.SourceDate $ convertSourceDate x
+    S.SourceTime x -> T.SourceTime $ convertTimeSpec x
+
+convertGroupingBucketTemporal :: S.GroupingBucketTemporal -> T.GroupingBucket UTCTime
+convertGroupingBucketTemporal =
+  \case
+    S.Daily -> T.Daily
+    S.Weekly -> T.Weekly
+    S.Monthly -> T.Monthly
+
+convertGroupSelectionTemporal :: S.GroupSelectionTemporal -> T.GroupSelection UTCTime
+convertGroupSelectionTemporal =
+  \case
+    S.AfterTemporal index sortingOrder source ->
+      T.After index (convertSortingOrder sortingOrder) (convertSourceTemporal source)
+    S.BeforeTemporal index sortingOrder source ->
+      T.Before index (convertSortingOrder sortingOrder) (convertSourceTemporal source)
+  where
+    convertSortingOrder =
+      \case
+        S.SortingAsc -> T.SortingAsc
+        S.SortingDesc -> T.SortingDesc
+
+convertSourceDate :: S.SourceDate -> T.SourceDate
+convertSourceDate =
+  \case
+    S.ModificationTime -> T.ModificationTime
+    S.AccessTime -> T.AccessTime
+
+convertTimeSpec :: S.TimeSpec -> T.TimeSpec
+convertTimeSpec =
+  \case
+    S.HoursAgo x -> T.HoursAgo x
+    S.DaysAgo x -> T.DaysAgo x
+    S.AbsoluteTime x -> T.AbsoluteTime x
+
+-- convertXX :: S.XX -> T.XX
+-- convertXX =
+--   \case {}

app/DhallTypes.hs

@@ -0,0 +1,123 @@
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-partial-fields #-}
+
+module DhallTypes
+  ( Rule (..),
+    RuleName (..),
+    Grouping (..),
+    Filtering (..),
+    FilteringF (..),
+    SourceTemporal (..),
+    SourceDate (..),
+    TimeSpec (..),
+    SortingOrder (..),
+    GroupSelectionTemporal (..),
+    GroupingBucketTemporal (..),
+
+    -- * Collecting
+    Matcher (..),
+    Action (..),
+  )
+where
+
+import Data.Fix (Fix (..))
+import qualified Data.Functor.Foldable.TH as TH
+import Data.String (IsString)
+import Data.Time (UTCTime)
+import Dhall
+
+newtype RuleName = RuleName {getRuleName :: String}
+  deriving stock (Generic)
+  deriving newtype (Eq, Ord, Show, IsString, FromDhall)
+
+newtype Matcher = Matcher {matchPattern :: String}
+  deriving stock (Generic)
+  deriving newtype (Eq, Ord, Show, IsString, FromDhall)
+
+data Action
+  = Move {inputPattern :: String, newName :: String}
+  | Copy {inputPattern :: String, newName :: String}
+  | Remove {inputPattern :: String}
+  deriving stock (Eq, Show, Generic)
+
+deriving anyclass instance FromDhall Action
+
+data Grouping
+  = FileGroup
+  | GroupTemporally SourceTemporal GroupingBucketTemporal GroupSelectionTemporal
+  deriving stock (Eq, Show, Generic)
+
+deriving anyclass instance FromDhall Grouping
+
+data SourceTemporal
+  = SourceDate SourceDate
+  | SourceTime TimeSpec
+  deriving stock (Eq, Show, Generic)
+
+deriving anyclass instance FromDhall SourceTemporal
+
+data SourceDate
+  = ModificationTime
+  | AccessTime
+  deriving stock (Eq, Show, Generic)
+
+deriving anyclass instance FromDhall SourceDate
+
+data TimeSpec
+  = HoursAgo Integer
+  | DaysAgo Integer
+  | AbsoluteTime UTCTime
+  deriving stock (Eq, Show, Generic)
+
+deriving anyclass instance FromDhall TimeSpec
+
+data SortingOrder
+  = SortingAsc
+  | SortingDesc
+  deriving stock (Eq, Show, Generic)
+
+deriving anyclass instance FromDhall SortingOrder
+
+data GroupSelectionTemporal
+  = AfterTemporal Int SortingOrder SourceTemporal
+  | BeforeTemporal Int SortingOrder SourceTemporal
+  deriving stock (Eq, Show, Generic)
+
+deriving anyclass instance FromDhall GroupSelectionTemporal
+
+data GroupingBucketTemporal
+  = Daily
+  | Weekly
+  | Monthly
+  deriving stock (Eq, Show, Generic)
+
+deriving anyclass instance FromDhall GroupingBucketTemporal
+
+data Filtering
+  = AllF
+  | AndF Filtering Filtering
+  | OrF Filtering Filtering
+  | GtFTemporal SourceTemporal SourceTemporal
+  | LtFTemporal SourceTemporal SourceTemporal
+  deriving stock (Eq, Show)
+
+TH.makeBaseFunctor ''Filtering
+
+deriving stock instance Generic (FilteringF a)
+
+deriving anyclass instance FromDhall a => FromDhall (FilteringF a)
+
+data Rule = Rule
+  { name :: RuleName,
+    match :: Matcher,
+    grouping :: Grouping,
+    filtering :: Fix FilteringF,
+    actions :: [Action]
+  }
+  deriving stock (Generic)
+
+deriving anyclass instance FromDhall Rule

app/Main.hs

@@ -1,14 +1,16 @@
-module Main where
+module Main (main) where
 
+import Convert (convert)
 import qualified Dhall as Dhall
+import DhallTypes as DhallTypes
 import Librarian
 import Options.Applicative as Options
 
 main :: IO ()
 main = do
   args <- parseArgs
-  rules <- Dhall.inputFile (Dhall.auto @[Rule]) $ rulesFile args
-  plan <- planMoves <$> fetchRulesOn "." rules
+  rules <- map convert <$> Dhall.inputFile (Dhall.auto @[DhallTypes.Rule]) (rulesFile args)
+  plan <- planActions <$> fetchRulesOn "." rules
   displayPlan plan
   putStrLn "Move? (y/n)"
   response <- getChar

librarian.cabal

@@ -17,12 +17,12 @@ library
   build-depends:
       base == 4.*
     , containers
-    , dhall
     , directory
     , easy-file
     , Glob
     , pretty-show
     , regexpr
+    , time
   hs-source-dirs: src
   exposed-modules:
       Librarian
@@ -83,7 +83,7 @@ test-suite librarian-test
       TypeApplications
       TypeFamilies
       TypeOperators
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
+  ghc-options: -Werror -threaded -rtsopts -with-rtsopts=-N -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
   build-depends:
       base
     , librarian
@@ -95,12 +95,16 @@ test-suite librarian-test
     , hspec-core
     , hspec-discover
     , temporary
+    , time
   default-language: Haskell2010
 
-executable librarian
+executable librarian-exe
   -- type: exitcode-stdio-1.0
   main-is: Main.hs
   hs-source-dirs: app
+  other-modules:
+    Convert
+    DhallTypes
   default-extensions:
       DataKinds
       DefaultSignatures
@@ -127,6 +131,9 @@ executable librarian
   build-depends:
       base
     , librarian
-    , dhall
+    , data-fix >= 0.3 && < 1
+    , dhall == 1.*
     , optparse-applicative
+    , recursion-schemes == 5.*
+    , time
   default-language: Haskell2010