-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
5bcea49
commit 3919605
Showing
4 changed files
with
230 additions
and
7 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 {} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters